Merge pull request #83 from craddm/average_tfr_fix

better behaved grouping
craddm · Mar 6, 2021 · f65305a · f65305a
2 parents da27b01 + 7d46db1
commit f65305a
Show file tree

Hide file tree

Showing 8 changed files with 192 additions and 187 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -7,6 +7,7 @@
     - `stat_scalpcontours()`
 - `geom_topo()` now has contours
 - added errors with when attempting to use `compute_psd` or `compute_tfr` on `eeg_group` objects.
+- `compute_tfr()` now works better with `eeg_evoked` objects that contain multiple conditions.
 
 
 ### Internal changes / bug fixes
@@ -17,6 +18,8 @@
 - `cart_to_spherical` coord flipping bug fixed (hopefully...)
 - `filter` now converts to tibble internally and does not coerce `signals` to a vector when there is only one channel.
 - added copyright info to `summary_contour` file
+- `eeg_combine.eeg_evoked` made to behave more consistently when creating grouped data
+- all `as.data.frame()` functions moved to `df_converters.r`
 
 # eegUtils 0.6.0
 

diff --git a/R/data_combine.R b/R/data_combine.R
@@ -178,6 +178,9 @@ eeg_combine.eeg_evoked <- function(data,
   if (length(unique(epochs(data)$participant_id)) > 1) {
     message("Multiple participant IDs, creating eeg_group.")
     class(data) <- c("eeg_group", "eeg_evoked", "eeg_epochs")
+    p_ids <- rle(as.character(epochs(data)$participant_id))
+    p_ids$lengths <- p_ids$lengths * length(unique(data$timings$time))
+    data$timings$participant_id <- inverse.rle(p_ids)
   }
 
   data

diff --git a/R/df_converters.R b/R/df_converters.R
@@ -1,4 +1,4 @@
-#' Convert eeg_data to data.frame
+#' Convert `eeg_data` to `data.frame`
 #'
 #' Convert an object of class `eeg_data` into a standard data.frame.
 #'
@@ -249,5 +249,186 @@ as.data.frame.eeg_stats <- function(x,
   df
 }
 
+#' Convert `eeg_epochs` object to data.frame
+#'
+#' Convert an `eeg_epochs` object to a data.frame for use with whatever
+#' packages you desire.
+#'
+#' @author Matt Craddock \email{matt@@mattcraddock.com}
+#' @param x Object of class `eeg_epochs`
+#' @param row.names Kept for compatability with S3 generic, ignored.
+#' @param optional Kept for compatability with S3 generic, ignored.
+#' @param long Convert to long format. Defaults to FALSE.
+#' @param events Include events in output. Defaults to FALSE. Currently ignored.
+#' @param cond_labels Add column tagging epochs with events that have matching
+#'   labels. Deprecated. Metainfo from the epochs structure is now added
+#'   automatically.
+#' @param coords Include electrode coordinates in output. Ignored if long == FALSE.
+#' @param ... arguments for other as.data.frame commands
+#'
+#' @importFrom tidyr gather
+#' @importFrom dplyr left_join
+#' @export
+
+as.data.frame.eeg_epochs <- function(x, row.names = NULL,
+                                     optional = FALSE,
+                                     long = FALSE,
+                                     events = FALSE,
+                                     cond_labels,
+                                     coords = TRUE,
+                                     ...) {
+
+  if (!missing(cond_labels)) {
+    stop("The cond_labels argument is deprecated.")
+  }
+
+  chan_names <- channel_names(x)
+  df <- data.frame(x$signals,
+                   time = x$timings$time,
+                   epoch = x$timings$epoch,
+                   stringsAsFactors = FALSE)
+
+  names(df)[1:length(chan_names)] <- chan_names
+  # combine the new data frame with any condition labels from the events table
+  if (long) {
+
+    # When converting to long, use factor_key to keep channels in same order,
+    # then convert back to character.
+    df <- tidyr::gather(df,
+                        electrode,
+                        amplitude,
+                        channel_names(x),
+                        factor_key = TRUE)
+
+    df$electrode <- as.character(df$electrode)
+
+    if (coords && !is.null(channels(x))) {
+      df <- dplyr::left_join(df,
+                             channels(x)[, c("electrode", "x", "y")],
+                             by = "electrode")
+    }
+  }
+
+  if (!is.null(x$epochs)) {
+    df <- dplyr::left_join(df,
+                           x$epochs,
+                           by = "epoch")
+  }
+
+  df
+}
+
+#' Convert `eeg_evoked` object to data frame
+#
+#' @author Matt Craddock \email{matt@@mattcraddock.com}
+#' @param x Object of class `eeg_evoked`
+#' @param row.names Kept for compatability with S3 generic, ignored.
+#' @param optional Kept for compatability with S3 generic, ignored.
+#' @param long Convert to long format. Defaults to FALSE
+#' @param coords include electrode coordinates in output. Ignored if long = FALSE.
+#' @param ... arguments for other as.data.frame commands
+#'
+#' @importFrom tidyr gather
+#' @export
+
+as.data.frame.eeg_evoked <- function(x,
+                                     row.names = NULL,
+                                     optional = FALSE,
+                                     long = FALSE,
+                                     coords = TRUE,
+                                     ...) {
+
+  # if (inherits(x, "eeg_group")) {
+  #   stop("currently not working with grouped evoked")
+  # }
+
+  df <- cbind(x$signals,
+              x$timings)
+
+  df <- dplyr::left_join(df,
+                         epochs(x))
+  if (long) {
+    df <- tidyr::gather(df,
+                        "electrode",
+                        "amplitude",
+                        channel_names(x),
+                        factor_key = TRUE)
+    df$electrode <- as.character(df$electrode)
+
+    if (coords && !is.null(channels(x))) {
+      df <- left_join(df,
+                      channels(x)[, c("electrode", "x", "y")],
+                      by = "electrode")
+    }
+  }
+
+  df
+}
+
+#' Convert `eeg_ICA` object to data frame
+#
+#' @author Matt Craddock \email{matt@@mattcraddock.com}
+#' @param x Object of class `eeg_ICA`
+#' @param row.names Kept for compatability with S3 generic, ignored.
+#' @param optional Kept for compatability with S3 generic, ignored.
+#' @param long Convert to long format. Defaults to FALSE
+#' @param cond_labels add condition labels to data frame. Deprecated.
+#' @param mixing If TRUE, outputs the mixing matrix. If FALSE, outputs source activations.
+#' @param coords Adds electrode coordinates if TRUE; only if long data and the mixing matrix are requested.
+#' @param ... arguments for other as.data.frame commands
+#'
+#' @importFrom tidyr gather
+#' @export
+
+as.data.frame.eeg_ICA <- function(x,
+                                  row.names = NULL,
+                                  optional = FALSE,
+                                  long = FALSE,
+                                  cond_labels,
+                                  mixing = FALSE,
+                                  coords = TRUE,
+                                  ...) {
+
+  if (!missing(cond_labels)) {
+    stop("The cond_labels argument is deprecated.")
+  }
+
+  if (mixing) {
+    df <- x$mixing_matrix
+
+    if (coords) {
+
+      if (is.null(channels(x))) {
+        stop("No chan_info, use electrode_locations() first.")
+      }
+
+      df <- dplyr::left_join(df,
+                             channels(x)[, c("electrode", "x", "y")],
+                             by = "electrode")
+    }
+
+  } else {
+    df <- data.frame(x$signals,
+                     x$timings)
+
+    if (!is.null(x$epochs)) {
+      df <- dplyr::left_join(df,
+                             x$epochs,
+                             by = "epoch")
+    }
+  }
+
+  if (long) {
+    df <- tidyr::gather(df,
+                        component,
+                        amplitude,
+                        channel_names(x),
+                        factor_key = TRUE)
+    df$component <- as.character(df$component)
+  }
+
+
+  df
+}