R/backward-compatibility.R

In raveio: File-System Toolbox for RAVE Project

#' @title Compatibility support for 'RAVE' 1.0 format
#' @description Convert 'RAVE' subject generated by 2.0 pipeline such that
#' 1.0 modules can use the data. The subject must have valid electrodes.
#' The data must be imported, with time-frequency transformed to pass the
#' validation before converting.
#' @param subject 'RAVE' subject characters, such as \code{'demo/YAB'}, or
#' a subject instance generated from \code{\link{RAVESubject}}
#' @param verbose whether to verbose the messages
#' @param ... ignored, reserved for future use
#' @returns Nothing
#' @export
rave_subject_format_conversion <- function(
    subject, verbose = TRUE, ...) {

  subject <- restore_subject_instance(subject, strict = FALSE)

  if(!all(subject$electrode_types %in% "LFP")) {
    warning("RAVE 1.0 only support analyzing signals with time-frequency decomposition. Electrodes with non-LFP signals will be ignored.")
  }

  progress <- dipsaus::progress2(title = "Adding backward compatibility support", quiet = !verbose, shiny_auto_close = TRUE, max = 4)

  progress$inc("Validating subject")

  validation <- validate_subject(subject = subject, verbose = verbose, version = 2, method = "normal")

  # check the following validation results
  if(!all(sapply(validation$preprocess[c(
    "electrodes_set", "data_imported", "notch_filtered",
    "has_wavelet", "blocks_set", "sample_rate_set")], function(x) {
      isTRUE(x$valid)
    }))) {
    stop("Please finish the following preprocess pipelines before converting: data import, Notch filter, Wavelet")
  }
  if(!isTRUE(validation$voltage_data$voltage_data$valid)) {
    stop(sprintf("Subject [%s] fails the validation: voltage data are invalid", subject$subject_id))
  }
  if(!isTRUE(validation$power_phase_data$power_phase$valid)) {
    stop(sprintf("Subject [%s] fails the validation: power/phase data are invalid", subject$subject_id))
  }

  electrodes <- subject$electrodes
  electrode_types <- subject$electrode_types
  blocks <- subject$blocks

  # 1. add /ref/xxx to voltage data
  voltage_path <- file.path(subject$data_path, "voltage")
  power_path <- file.path(subject$data_path, "power")
  phase_path <- file.path(subject$data_path, "phase")

  progress$inc("Adding RAVE 1.0 redundancy data")

  block_lengths <- lapply_async(seq_along(electrodes), function(ii) {
    e <- electrodes[[ii]]
    etype <- electrode_types[[ii]]
    h5path <- file.path(voltage_path, sprintf("%s.h5", e))

    # add /ref/voltage/<block> for each block and should be identical to /raw/voltage/<block>
    re <- sapply(blocks, function(block) {
      s <- load_h5(h5path, name = sprintf("/raw/voltage/%s", block), ram = TRUE)
      # save_h5(s, file = h5path, name = sprintf("/ref/voltage/%s", block), chunk = 1024, quiet = TRUE)
      length(s)
    }, simplify = FALSE, USE.NAMES = TRUE)
    save_h5("invalid", file = h5path, name = "reference", ctype = "character", quiet = TRUE)

    h5path <- file.path(power_path, sprintf("%s.h5", e))
    save_h5("invalid", file = h5path, name = "reference", ctype = "character", quiet = TRUE)
    # if(etype %in% c("LFP")) {
    #   for(block in blocks) {
    #     s <- load_h5(h5path, name = sprintf("/raw/power/%s", block), ram = TRUE)
    #     save_h5(s, file = h5path, name = sprintf("/ref/power/%s", block), chunk = c(nrow(s), 1024), quiet = TRUE)
    #   }
    # }


    h5path <- file.path(phase_path, sprintf("%s.h5", e))
    save_h5("invalid", file = h5path, name = "reference", ctype = "character", quiet = TRUE)
    # if(etype %in% c("LFP")) {
    #   for(block in blocks) {
    #     s <- load_h5(h5path, name = sprintf("/raw/phase/%s", block), ram = TRUE)
    #     save_h5(s, file = h5path, name = sprintf("/ref/phase/%s", block), chunk = c(nrow(s), 1024), quiet = TRUE)
    #   }
    # }

    if(etype %in% c("LFP")) {
      return(re)
    } else {
      return()
    }
  }, callback = function(ii) {
    sprintf("Migrating voltage|electrode %s", electrodes[[ii]])
  })

  progress$inc("Generating time point table & caching information")

  block_lengths <- dipsaus::drop_nulls(block_lengths)
  block_lengths <- block_lengths[[1]]
  volt_srate <- subject$raw_sample_rates[electrode_types %in% "LFP"][[1]]
  wave_srate <- subject$power_sample_rate
  tp_tbl <- do.call("rbind", lapply(blocks, function(block){
    l <- block_lengths[[block]]
    l <- floor((l - 1) / volt_srate * wave_srate) + 1
    data.frame(
      Block = block,
      Time = seq(0, by = 1 / wave_srate, length.out = l)
    )
  }))
  utils::write.csv(tp_tbl, file.path(subject$meta_path, "time_points.csv"))

  # 2. add cached_reference.csv to data/cache
  cache_path <- file.path(subject$data_path, "cache")
  dir_create2(cache_path)

  utils::write.csv(data.frame(
    Electrode = electrodes,
    Reference = "invalid"
  ), file = file.path(cache_path, 'cached_reference.csv'))

  # 3. add keywords to rave.yaml
  progress$inc("Registering preprocessing information")
  yaml <- subject$preprocess_settings$path
  backup_file(yaml)

  # d1 <- load_yaml("/Users/dipterix/rave_data/data_dir/test1/KC/rave/preprocess/rave.yaml")
  # d2 <- load_yaml(yaml)
  preproc_data <- subject$preprocess_settings$data
  preproc_data$project_name <- subject$project_name
  preproc_data$subject_code <- subject$subject_code
  preproc_data$channels <- electrodes
  preproc_data$exclchan <- NULL
  preproc_data$epichan <- NULL
  preproc_data$badchan <- electrodes[!electrode_types %in% c("LFP")]
  wavelet_params <- preproc_data$wavelet_params
  wavelet_params$channels <- wavelet_params$electrodes
  wavelet_params$target_srate <- wavelet_params$downsample_to
  wavelet_params$wave_num <- wavelet_params$cycle
  preproc_data$wavelet_log <- list(wavelet_params)
  preproc_data$checklevel <- 4 # waveleted
  subject$preprocess_settings$save()

  return(invisible())

}