R/to_tbl.R

Defines functions long_dt as.data.table.psd_lst as.data.table.eeg_lst as_tidytable.eeg_lst

Documented in as.data.table.eeg_lst as.data.table.psd_lst as_tidytable.eeg_lst

#' Convert an eeg_lst to a long table in [`tidytable`][tidytable::tidytable] format.
#'
#' Convert the signal_tbl table from wide to long format.
#'
#' @inheritParams as.data.table.eeg_lst
#' @return  A [`tidytable`][tidytable::tidytable].
as_tidytable.eeg_lst <- function(x, .unit = "s", ...) {
  data.table::as.data.table(x, .unit = .unit, ...) %>%
    tidytable::as_tidytable(.name_repair = "unique")
}

#' Convert an eeg_lst to a long table in [`data.table`][data.table::data.table] format.
#'
#' Convert the signal_tbl table from wide to long format.
#'
#' @param x An `eeg_lst` object.
#' @param .unit Unit for the `.time` column of the transformed object: "s" (default), "ms", "samples".
#' @inheritParams data.table::as.data.table
#' @return  A [`data.table`][data.table::data.table].
as.data.table.eeg_lst <- function(x, .unit = "s", ... ) {
  long_table <- long_dt(x$.signal, x$.segments) %>%
  mutate.(.time := as_time(.sample, .unit = .unit), .sample = NULL)    
  # long_table[, .time := as_time(.sample, .unit = .unit)]
  # long_table[, .sample := NULL]
  long_table %>% select.(.time, tidyselect::everything())
}


#' Convert a psd_lst list to a long table in [`data.table`][data.table::data.table] format.
#'
#' Convert the psd_tbl table from wide to long format.
#'
#' @param x A `psd_lst` object.
#' @inheritParams data.table::as.data.table
#' @return  A [`data.table`][data.table::data.table].
as.data.table.psd_lst <- function(x, ...) {
  long_table <- long_dt(x$.psd, x$.segments)
  long_table %>% select.(.freq, tidyselect::everything())
}


long_dt <- function(dt,.segments){
  keys <-dt %>%
    select.(where(~ is_channel_dbl(.) || is_component_dbl(.))) %>%
    colnames()
  if (length(keys) == 0) {
    stop("No channels found.", call. = TRUE)
  }
  long_dt <-dt %>%
    data.table::melt(
      variable.name = ".key",
      measure.vars = keys,
      value.name = ".value"
    )
  long_dt[, .key := as.character(.key)][
    , .value := `attributes<-`(.value, NULL)
  ]
  long_dt %>%
    left_join.(., data.table::as.data.table(.segments), by = ".id")
}



#' Convert an eeg_lst to a long table in [`tibble`][tibble::tibble] format.
#' 
#' Convert the signal_tbl table from wide to long format.
#'
#' @inheritParams as.data.table.eeg_lst
#' @return A [`tibble`][tibble::tibble]
#' @family tibble
as_tibble.eeg_lst <- function(x, .unit = "s", ...) {
  data.table::as.data.table(x, .unit = .unit, ...) %>%
    tibble::as_tibble(.name_repair = "unique")
}

#' Convert an psd_lst to a long table in [`tibble`][tibble::tibble] format.
#' 
#' Convert the signal_tbl table from wide to long format.
#'
#' @inheritParams as.data.table.psd_lst
#' @return A [`tibble`][tibble::tibble]
#' @family tibble
as_tibble.psd_lst <- function(x, ...) {
  data.table::as.data.table(x, ...) %>%
    tibble::as_tibble(.name_repair = "unique")
}




#' Convert an psd_lst to a long table in [`tidytable`][tidytable::tidytable] format.
#'
#' Convert the signal_tbl table from wide to long format.
#'
#' @param x A `psd_lst` object.
#' @param ... unused
#' @return  A [`tidytable`][tidytable::tidytable].
#'
#'
#'
as_tidytable.psd_lst <- function(x, ...) {
  data.table::as.data.table(x) %>%
    tidytable::as_tidytable(.name_repair = "unique")
}


as_tibble.signal_tbl <- function(x, ..., .rows = NULL,
                                 .name_repair = c("check_unique", "unique", "universal", "minimal"),
                                 rownames) {
  NextMethod()
}




#' @rdname as_tibble.eeg_lst
as_data_frame.eeg_lst <- as_tibble.eeg_lst




#' Convert an eeg_lst to a (base) data frame.
#'
#' @inheritParams as.data.table.eeg_lst
#' @inheritParams base::as.data.frame
#'
#' @return A data.frame.
#'
#' @export
as.data.frame.eeg_lst <- function(x,  row.names = NULL, optional = FALSE, ..., .unit = "second") {
  as.data.frame(as.data.table.eeg_lst(x, .unit = "second"), row.names = row.names, optional = optional, ...)
}

#' Convert a psd_lst to a (base) data frame.
#'
#' @inheritParams as.data.table.psd_lst
#' @inheritParams base::as.data.frame
#' @return A data.frame.
#'
#'
#' @family tibble
#' @export
as.data.frame.psd_lst <- function(x,  row.names = NULL, optional = FALSE, ...) {
  as.data.frame(as.data.table.psd_lst(x), row.names = row.names, optional = optional, ...)
}


#' @rdname as_tibble.eeg_lst
as_long_tbl.eeg_lst <- as_tibble.eeg_lst

as_long_tbl <- function(x, ...) {
  UseMethod("as_long_tbl")
}

as_long_tbl.mixing_tbl <- function(x, add_channels_info = TRUE, ...) {
  x %>%
    .[, lapply(.SD, `attributes<-`, NULL)] %>%
    tidyr::gather(key = ".key", value = ".value", channel_names(x)) %>%
    dplyr::mutate(.type = ".channel") %>%
    {
      if (add_channels_info) {
        dplyr::left_join(., channels_tbl(x), by = c(".key" = ".channel"))
      } else {
        .
      }
    }
}
bnicenboim/eeguana documentation built on March 16, 2024, 7:21 a.m.