R/import_flyPAD_rawdata.R

In Dahaniel/flyPADr: Import flyPAD data into R

#' import_flyPAD_rawdata
#' Import flyPAD data from a Matlab file
#'
#' @param file name of .mat file to import
#'
#' @return a list containing metadata, sips and activity bouts
#' @export
#'
#' @examples
#'
import_flyPAD_rawdata <- function(file) {
  require(dplyr)
  require(purrr)
  require(R.matlab)
  
  tmp <- readMat(file)$Events
  data <- list()
  
  # import metadata ---------------------------------------------------------
  
  data[['cndtn_lbl']]  <- unlist(tmp["ConditionLabel",1,1])
  data[['sbstrt_lbl']] <- unlist(tmp["SubstrateLabel",1,1])
  data[['sbstrt']]     <- unlist(tmp["Substrate",1,1])
  data[['cndtn']]      <- unlist(tmp["Condition",1,1])
  data[['date']]       <- unlist(tmp["Date",1,1])
  data[['time']]       <- unlist(tmp["Time",1,1])
  
  # import and transform sips -----------------------------------------------
  
  data[['sips']] <- Map(cbind,
                        sapply(sapply(tmp["Ons",1,1][[1]], "[[",1), t), # somehow different organization than RMSEvents*, neet to transpose
                        sapply(sapply(tmp["Offs",1,1][[1]], "[[",1), t),
                        sapply(sapply(tmp["Durations",1,1][[1]], "[[",1), t)) %>% lapply(as.data.frame)
  # write NA in empty frames
  empty <- which(do.call(c, lapply(data$sips, length)) == 0)
  if (length(empty) != 0)
    data$sips[empty] <- list(data.frame(NA, NA, NA))
  
  # add names to columns
  data$sips <- lapply(data$sips, setNames, c("on", "off", "duration"))
  
  names(data$sips) <- paste(data$cndtn_lbl[data$cndtn], data$sbstrt_lbl[data$sbstrt], sep = "__")
  
  data$sips <- data$sips %>%
    map2(.y = 1:length(.), .f = ~mutate(.x, channel = .y)) %>%
    map2(.y = rep(1:(length(.)/2), each = 2), .f = ~mutate(.x, pad = .y)) %>%
    map2(.y = rep(1:(length(.)/8), each = 8), .f = ~mutate(.x, box = .y)) %>%
    map2(.y = data$cndtn, .f = ~mutate(.x, condition = .y)) %>%
    map2(.y = data$sbstrt, .f = ~mutate(.x, substrate = .y)) %>%
    map2(.y = data$cndtn_lbl[data$cndtn], .f = ~mutate(.x, condition_label = .y)) %>%
    map2(.y = data$sbstrt_lbl[data$sbstrt], .f = ~mutate(.x, substrate_label = .y)) %>%
    map(~mutate(., condition_label_2 = sapply(strsplit(condition_label, "_", fixed=TRUE), "[[", substrate[1]) ))
  
  data$sips <- do.call("rbind", data$sips) %>%
    group_by(pad, substrate) %>%
    arrange(on) %>%
    mutate(sip = 1:length(on))%>%
    ungroup() %>%
    group_by(condition_label, substrate_label) %>%
    arrange(on) %>%
    mutate(sip_glob = 1:length(on))
  
  
  
  # import and transform activity_bouts ---------------------------------------------
  
  data[['activity_bouts']] <- Map(cbind,
                                  sapply(tmp["RMSEventsOns",1,1][[1]], "[[",1),
                                  sapply(tmp["RMSEventsOffs",1,1][[1]], "[[",1),
                                  sapply(tmp["RMSEventsDurs",1,1][[1]], "[[",1)) %>% lapply(as.data.frame)
  # write NA in empty frames
  empty <- which(do.call(c, lapply(data$activity_bouts, length)) == 0)
  if (length(empty) != 0)
    data$activity_bouts[empty] <- list(data.frame(NA, NA, NA))
  
  # add names to columns
  data$activity_bouts <- lapply(data$activity_bouts, setNames, c("on", "off", "duration"))
  
  names(data$activity_bouts) <- paste(data$cndtn_lbl[data$cndtn], data$sbstrt_lbl[data$sbstrt], sep = "__")
  
  data$activity_bouts <- data$activity_bouts %>%
    map2(.y = 1:length(.), .f = ~mutate(.x, channel = .y)) %>%
    map2(.y = rep(1:(length(.)/2), each = 2), .f = ~mutate(.x, pad = .y)) %>%
    map2(.y = rep(1:(length(.)/8), each = 8), .f = ~mutate(.x, box = .y)) %>%
    map2(.y = data$cndtn, .f = ~mutate(.x, condition = .y)) %>%
    map2(.y = data$sbstrt, .f = ~mutate(.x, substrate = .y)) %>%
    map2(.y = data$cndtn_lbl[data$cndtn], .f = ~mutate(.x, condition_label = .y)) %>%
    map2(.y = data$sbstrt_lbl[data$sbstrt], .f = ~mutate(.x, substrate_label = .y)) %>%
    map(~mutate(., condition_label_2 = sapply(strsplit(condition_label, "_", fixed=TRUE), "[[", substrate[1]) ))
  
  data$activity_bouts <- do.call("rbind", data$activity_bouts) %>%
    group_by(pad, substrate) %>%
    arrange(on) %>%
    mutate(activity_bout = 1:length(on))%>%
    ungroup() %>%
    group_by(condition_label, substrate_label) %>%
    arrange(on) %>%
    mutate(activity_bout_glob = 1:length(on))
  
  return(data)
  
}