From 30ecbebd71625e031af66291b1037437475bacf3 Mon Sep 17 00:00:00 2001 From: craddm Date: Sun, 29 Jul 2018 22:01:25 +0100 Subject: [PATCH] new implementation of timecourse plots testing --- R/erp_scalp.R | 128 +++++++++++++++------- R/plot_timecourse.R | 257 +++++++++++++++++++++++++++++++++++++------- 2 files changed, 307 insertions(+), 78 deletions(-) diff --git a/R/erp_scalp.R b/R/erp_scalp.R index bee8fd5e..90fddc96 100644 --- a/R/erp_scalp.R +++ b/R/erp_scalp.R @@ -19,7 +19,7 @@ #' @details The function uses default electrode names and locations contained #' in the package. #' -#' @author Matti Vuorre, \email{mv2521@columbia.edu} +#' @author Matti Vuorre, \email{mv2521@@columbia.edu} #' @importFrom purrr map #' @import dplyr #' @import ggplot2 @@ -39,15 +39,23 @@ erp_scalp <- function(data, montage = NULL) { if (is.eeg_epochs(data)) { - data <- as.data.frame(data, long = TRUE) + data <- as.data.frame(data, + long = TRUE) } if (is.null(color)) { - data <- dplyr::group_by(data, electrode, time) - data <- dplyr::summarise(data, amplitude = mean(amplitude)) + data <- dplyr::group_by(data, + electrode, + time) + data <- dplyr::summarise(data, + amplitude = mean(amplitude)) } else { - data <- dplyr::group_by_(data, electrode, time, as.name(color)) - data <- dplyr::summarise(data, amplitude = mean(amplitude)) + data <- dplyr::group_by_(data, + electrode, + time, + as.name(color)) + data <- dplyr::summarise(data, + amplitude = mean(amplitude)) } data <- as.data.frame(data) @@ -96,37 +104,54 @@ erp_scalp <- function(data, data <- dplyr::select(data, -data) # Get default electrode locations from pkg internal data - data <- electrode_locations(data, drop = T, montage = montage) + data <- electrode_locations(data, + drop = T, + montage = montage) - p <- ggplot(data, aes(x, y)) + + p <- ggplot(data, + aes(x, y)) + geom_blank() + theme_void() + theme(plot.margin = unit(c(8, 8, 8, 8), "pt")) - guide <- ggplot(data, aes(x = time, y = amplitude)) + - coord_cartesian(ylim = c(minAmp, maxAmp), - xlim = c(minTime, maxTime)) + + guide <- ggplot(data, + aes(x = time, + y = amplitude)) + + coord_cartesian(ylim = c(minAmp, + maxAmp), + xlim = c(minTime, + maxTime)) + scale_x_continuous(breaks = scales::pretty_breaks(n = 3)) + scale_y_continuous(breaks = scales::pretty_breaks(n = 3)) + - geom_vline(xintercept = 0, size = .4) + - geom_hline(yintercept = 0, size = .4) + - labs(y = expression(paste("Amplitude (", mu, "V)")), + geom_vline(xintercept = 0, + size = .4) + + geom_hline(yintercept = 0, + size = .4) + + labs(y = expression(paste("Amplitude (", + mu, + "V)")), x = "Time (s)") + theme_minimal(base_size = 8) + theme(panel.grid = element_blank(), axis.ticks = element_line(size = .3), plot.margin = unit(c(8, 8, 8, 8), "pt")) + if (show_guide) { p <- p + annotation_custom(grob = ggplotGrob(guide), - xmin = min(data$x) - .07, xmax = min(data$x) + .09, - ymin = min(data$y) - .09, ymax = min(data$y) + .09) + xmin = min(data$x) - .07, + xmax = min(data$x) + .09, + ymin = min(data$y) - .09, + ymax = min(data$y) + .09) } + for (i in 1:nrow(data)) { p <- p + annotation_custom(grob = ggplotGrob(data$plot[[i]]), - xmin = data$x[i] - .05, xmax = data$x[i] + .05, - ymin = data$y[i] - .07, ymax = data$y[i] + .07) + xmin = data$x[i] - .05, + xmax = data$x[i] + .05, + ymin = data$y[i] - .07, + ymax = data$y[i] + .07) } return(p) @@ -142,26 +167,28 @@ erp_scalp <- function(data, #' @param data An EEG dataset. #' @param colour Variable to colour lines by. If no variable is passed, only one #' line is drawn for each electrode. -#' @param baseline Character vector of times to subtract for baseline correct. +#' @param baseline Character vector of times to subtract for baseline correction. #' @param montage Name of an existing montage set. Defaults to NULL; (currently #' only 'biosemi64alpha' available other than default 10/20 system) #' -#' @author Matt Craddock, \email{matt@mattcraddock.com} +#' @author Matt Craddock, \email{matt@@mattcraddock.com} #' #' @import shiny #' @import miniUI #' @export -interactive_scalp <- function(data, colour = NULL, - baseline = NULL, montage = NULL) { +interactive_scalp <- function(data, + colour = NULL, + baseline = NULL, + montage = NULL) { if (is.eeg_data(data)) { data <- eeg_average(data) - data <- as.data.frame(data, long = TRUE) } if (!is.null(baseline)) { - data <- rm_baseline(data, time_lim = baseline) + data <- rm_baseline(data, + time_lim = baseline) } ui <- miniPage( @@ -192,24 +219,38 @@ interactive_scalp <- function(data, colour = NULL, ) ) - server <- function(input, output, session) { + server <- function(input, + output, + session) { - data <- electrode_locations(data, drop = TRUE, montage = montage) + tmp_data <- as.data.frame(data, + long = TRUE) + tmp_data <- electrode_locations(tmp_data, + drop = TRUE, + montage = montage) - button_reacts <- reactiveValues(sel_elecs = list(), avg = TRUE) + button_reacts <- reactiveValues(sel_elecs = list(), + avg = TRUE) output$Scalp <- renderPlot({ + if (is.null(colour)) { - erp_scalp(data, montage = montage) + erp_scalp(tmp_data, + montage = montage) } else { - erp_scalp(data, color = as.name(colour), montage = montage) + erp_scalp(tmp_data, + color = as.name(colour), + montage = montage) } + }) observeEvent(input$click_plot, { - tmp <- nearPoints(data, input$click_plot, - "x", "y", threshold = 45, + tmp <- nearPoints(tmp_data, + input$click_plot, + "x", "y", + threshold = 45, maxpoints = 1) if (nrow(tmp) > 0) { @@ -229,18 +270,29 @@ interactive_scalp <- function(data, colour = NULL, output$Selected <- renderPlot({ if (button_reacts$avg) { if (is.null(colour)) { - plot_timecourse(data[data$electrode %in% button_reacts$sel_elecs, ]) + #plot_timecourse(data[data$electrode %in% button_reacts$sel_elecs, ]) + plot_tc(select_elecs(data, + button_reacts$sel_elecs)) } else { - plot_timecourse(data[data$electrode %in% button_reacts$sel_elecs, ], - colour = as.name(colour)) + plot_tc(select_elecs(data, + button_reacts$sel_elecs), + colour = as.name(colour)) + #plot_timecourse(data[data$electrode %in% button_reacts$sel_elecs, ], + # colour = as.name(colour)) } } else { if (is.null(colour)) { - plot_timecourse(data[data$electrode %in% button_reacts$sel_elecs, ], - colour = "electrode") + plot_tc(select_elecs(data, + button_reacts$sel_elecs), + colour = "electrode") + #plot_timecourse(data[data$electrode %in% button_reacts$sel_elecs, ], + # colour = "electrode") } else{ - plot_timecourse(data[data$electrode %in% button_reacts$sel_elecs, ], - colour = as.name(colour)) + + plot_tc(select_elecs(data, + button_reacts$sel_elecs), + colour = as.name(colour)) + + # plot_timecourse(data[data$electrode %in% button_reacts$sel_elecs, ], + # colour = as.name(colour)) + facet_wrap(~electrode) } } diff --git a/R/plot_timecourse.R b/R/plot_timecourse.R index 7da5d63d..3857e318 100644 --- a/R/plot_timecourse.R +++ b/R/plot_timecourse.R @@ -40,12 +40,14 @@ plot_timecourse <- function(data, time_lim = NULL, stop("Not currently supported for continuous eeg_data objects.") } - data <- as.data.frame(data, long = TRUE) + data <- as.data.frame(data, + long = TRUE) } ## Select specified electrodes ----- if (!is.null(electrode)) { - data <- select_elecs(data, electrode = electrode) + data <- select_elecs(data, + electrode = electrode) } ## check for US spelling of colour... @@ -61,24 +63,32 @@ plot_timecourse <- function(data, time_lim = NULL, ## ----- if (!is.null(time_lim)) { - data <- select_times(data, time_lim) + data <- select_times(data, + time_lim) } ## Do baseline correction if (!is.null(baseline)) { - data <- rm_baseline(data, time_lim = baseline) + data <- rm_baseline(data, + time_lim = baseline) } ## Average over all epochs in data (respecting "conditions"). -- if (is.null(colour)) { - data <- dplyr::summarise(dplyr::group_by(data, time, electrode), + data <- dplyr::summarise(dplyr::group_by(data, + time, + electrode), amplitude = mean(amplitude)) } else { if ("electrode" %in% c(colour, color)) { - data <- dplyr::summarise(dplyr::group_by(data, time, electrode), + data <- dplyr::summarise(dplyr::group_by(data, + time, + electrode), amplitude = mean(amplitude)) } else { - data <- dplyr::summarise(dplyr::group_by(data, time, electrode, + data <- dplyr::summarise(dplyr::group_by(data, + time, + electrode, #!!tmp_col), !!colour), amplitude = mean(amplitude)) @@ -92,7 +102,9 @@ plot_timecourse <- function(data, time_lim = NULL, } ## Set up basic plot ----------- - tc_plot <- ggplot2::ggplot(data, aes(x = time, y = amplitude)) + tc_plot <- ggplot2::ggplot(data, + aes(x = time, + y = amplitude)) if (!(is.null(colour) & is.null(color))) { @@ -166,20 +178,82 @@ plot_tc <- function(data, ...) { UseMethod("plot_tc", data) } -plot_tc.eeg_epochs <- function(data, time_lim = NULL, - group = NULL, facet = NULL, - add_CI = FALSE, baseline = NULL, - colour = NULL, electrode = NULL, - color = NULL, ...) { +plot_tc.default <- function(data, ...) { + stop("plot_tc() doesn't handle objects of class ", + class(data)) +} + +plot_tc.data.frame <- function(data, + electrode = NULL, + time_lim = NULL, + group = NULL, + facet = NULL, + add_CI = FALSE, + baseline = NULL, + colour = NULL, + color = NULL, + ...) { + +} + +plot_tc.eeg_evoked <- function(data, + electrode = NULL, + time_lim = NULL, + group = NULL, + facet = NULL, + add_CI = FALSE, + baseline = NULL, + colour = NULL, + color = NULL, + ...) { + + if (add_CI) { + warning("Cannot add_CI for eeg_evoked objects.") + add_CI <- FALSE + } + + data <- parse_for_tc(data, + time_lim, + electrode, + baseline, + add_CI) + + if (is.null(colour)) { + if (!is.null(color)) { + colour <- as.name(color) + } + } else { + colour <- as.name(colour) + } + + tc_plot <- create_tc(data, + add_CI = add_CI, + colour = colour) + + tc_plot +} + +plot_tc.eeg_ICA <- function(data, + component = NULL, + time_lim = NULL, + group = NULL, + facet = NULL, + add_CI = FALSE, + baseline = NULL, + colour = NULL, + color = NULL, + ...) { # Select specifed times if (!is.null(time_lim)) { - data <- select_times(data, time_lim = time_lim) + data <- select_times(data, + time_lim = time_lim) } ## Select specified electrodes ----- - if (!is.null(electrode)) { - data <- select_elecs(data, electrode = electrode) + if (!is.null(component)) { + data <- select_elecs(data, + component = component) } ## check for US spelling of colour... @@ -193,16 +267,126 @@ plot_tc.eeg_epochs <- function(data, time_lim = NULL, ## Do baseline correction if (!is.null(baseline)) { - data <- rm_baseline(data, time_lim = baseline) + data <- rm_baseline(data, + time_lim = baseline) } if (!add_CI) { data <- eeg_average(data) } - data <- as.data.frame(data, long = T) + data <- as.data.frame(data, + long = T) + + tc_plot <- create_tc(data, + add_CI = add_CI, + colour = colour) + + tc_plot + + + } + +plot_tc.eeg_epochs <- function(data, + electrode = NULL, + time_lim = NULL, + group = NULL, + facet = NULL, + add_CI = FALSE, + baseline = NULL, + colour = NULL, + color = NULL, ...) { + + ## check for US spelling of colour... + + data <- parse_for_tc(data, + time_lim = time_lim, + electrode = electrode, + baseline = baseline, + add_CI = add_CI) + + if (is.null(colour)) { + if (!is.null(color)) { + colour <- as.name(color) + } + } else { + colour <- as.name(colour) + } + + tc_plot <- create_tc(data, + add_CI = add_CI, + colour = colour) + + tc_plot +} + + +#' @describeIn plot_tc plot_tc for eeg_stats objects. +#' @noRd +#' +plot_tc.eeg_stats <- function(data, time_lim, ...) { + +} + +#' @keywords internal +parse_for_tc <- function(data, + time_lim, + electrode, + baseline, + add_CI) { + + if (is.eeg_ICA(data) & is.null(electrode)) { + stop("Component number must be supplied for ICA.") + } + + # Select specifed times + if (!is.null(time_lim)) { + data <- select_times(data, + time_lim = time_lim) + } + + ## Select specified electrodes ----- + if (!is.null(electrode)) { + data <- select_elecs(data, + electrode) + } + + ## Do baseline correction + if (!is.null(baseline)) { + data <- rm_baseline(data, + time_lim = baseline) + } + + if (!is.eeg_evoked(data) & !add_CI) { + data <- eeg_average(data) + } + + data <- as.data.frame(data, long = TRUE) +} + +#' Internal function for creation of timecourse plots +#' +#' @param data A data frame to be plotted +#' @param add_CI whether to add confidence intervals +#' @param colour whether to use colour +#' @keywords internal +create_tc <- function(data, + add_CI, + colour) { + + if (is.null(colour)) { + tc_plot <- ggplot2::ggplot(data, + aes(x = time, + y = amplitude)) + } else { + colour <- ggplot2::enquo(colour) + tc_plot <- ggplot2::ggplot(data, + aes(x = time, + y = amplitude, + colour = !!colour)) + } + - tc_plot <- ggplot2::ggplot(data, aes(x = time, y = amplitude)) if (add_CI) { if (is.null(colour)) { @@ -214,21 +398,23 @@ plot_tc.eeg_epochs <- function(data, time_lim = NULL, colour = "black", size = 1, alpha = 0.5) - } else { - tc_plot <- tc_plot + - stat_summary(fun.data = mean_cl_normal, - geom = "ribbon", - linetype = "dashed", - aes_(colour = as.name(colour)), - fill = NA, - size = 1, - alpha = 0.5) - } + } else { + tc_plot <- tc_plot + + stat_summary(fun.data = mean_cl_normal, + geom = "ribbon", + linetype = "dashed", + aes(colour = !!colour), + fill = NA, + size = 1, + alpha = 0.5) } - tc_plot + + } + + tc_plot <- tc_plot + stat_summary(fun.y = "mean", geom = "line", - size = 1.2) + + size = 1.2) + tc_plot + labs(x = "Time (s)", y = expression(paste("Amplitude (", mu, "V)")), colour = "", fill = "") + geom_vline(xintercept = 0, linetype = "solid", size = 0.5) + @@ -241,15 +427,6 @@ plot_tc.eeg_epochs <- function(data, time_lim = NULL, theme(panel.grid = element_blank(), axis.ticks = element_line(size = .5)) + guides(colour = guide_legend(override.aes = list(alpha = 1))) - -} - - -#' @describeIn plot_tc plot_tc for eeg_stats objects. -#' @noRd -#' -plot_tc.eeg_stats <- function(data, time_lim, ...) { - } #' Create a butterfly plot from timecourse data