R/format_subject_data.R

In calenwalshe/detectability_maps: What the Package Does (One Line, Title Case)

#' Format the results for a single subject.
#'
#' @param subject
#'
#' @return
#' @export
#' @import R.matlab purrr dplyr stringr
#' @examples
format_subject_data <- function(subject) {
  summarize <- dplyr::summarise

  results.list.fovea <- list.files('./data-raw/fovea/', full.names = T)
  results.list.fovea <- Filter(function(x) grepl("ResultsMat_", x), results.list.fovea) %>% Filter(function(x) grepl(subject, x), .)

  results.list.periphery <- list.files('./data-raw/periphery/', full.names = T)
  results.list.periphery <- Filter(function(x) grepl("ResultsMat_", x), results.list.periphery) %>% Filter(function(x) grepl(subject, x), .)

  subject_fovea_detection            <- lapply(results.list.fovea, FUN = function(x) readMat(x))
  subject_periphery_detection        <- lapply(results.list.periphery, FUN = function(x) readMat(x))

  # function to parse exported values from matlab
  format_foveal_data    <- function(x) {
    search_data <- x

    data.names         <- row.names(search_data)

    cResp         <- search_data[[1]][[1]][1,1,,,]
    tPresent      <- search_data[[1]][[4]]
    tPresent      <- tPresent[,,,,]

    nTrials   <- search_data[[1]][[which(rownames(search_data[[1]]) == "nTrials")]]
    nSessions <- 2
    amplitudes <- as.numeric(search_data[[1]][[which(rownames(search_data[[1]]) == "targetAmplitude")]])

    cResp.frame <- as.data.frame.table(cResp)
    names(cResp.frame) <- c("trial", "level", "session", "correct_response")

    tPresent.frame <- as.data.frame.table(tPresent)
    names(tPresent.frame) <- c("trial", "level", "session", "tPresent")

    response.frame <- left_join(cResp.frame, tPresent.frame, by = c("trial", "level", "session"))

    response.frame[,1:3] <- lapply(response.frame[,1:3], factor)

    levels(response.frame$trial) <- 1:(nTrials+1)
    levels(response.frame$level) <- amplitudes
    levels(response.frame$session) <- 1:nSessions

    response.frame$type[(response.frame$correct_response == 1 & response.frame$tPresent == 1)] <- "HIT"
    response.frame$type[(response.frame$correct_response == 0 & response.frame$tPresent == 1)] <- "MISS"
    response.frame$type[(response.frame$correct_response == 1 & response.frame$tPresent == 0)] <- "CR"
    response.frame$type[(response.frame$correct_response == 0 & response.frame$tPresent == 0)] <- "FA"

    subject  <- search_data[[1]][[which(rownames(search_data[[1]]) == "Subject")]][[1]]
    response.frame$SUBJECT  <- subject

    response.frame$eccentricity <- 0
    response.frame$experiment_name <- factor("fovea")
    response.frame$condition <- factor("fovea")
    response.frame$bCon <- .2

    response.frame <- response.frame %>% filter(trial != 1)

    # Rename columns for consistency
    response.frame <- dplyr::rename(response.frame, tAmp = level)

    fovea_data <- as_tibble(response.frame)
  }

  format_periphery_data <- function(x) {
    search_data <- x
    data.names <- row.names(search_data[[1]])

    cResp         <- search_data[[1]][[1]]
    tPresent      <- search_data[[1]][[4]]

    nTrials    <- search_data[[1]][[which(rownames(search_data[[1]]) == "nTrials")]]
    nSessions  <- 2
    amplitudes <- as.numeric(search_data[[1]][[which(rownames(search_data[[1]]) == "targetAmplitude")]])
    eccentricity.vals <- as.numeric(search_data[[1]][[which(rownames(search_data[[1]]) == "eccentricity")]])
    condition.vals    <- unlist((search_data[[1]][[which(rownames(search_data[[1]]) == "conditionLabels")]]))
    bCon              <- unlist((search_data[[1]][[which(rownames(search_data[[1]]) == "bgContrast")]]))
    subject           <- unlist((search_data[[1]][[which(rownames(search_data[[1]]) == "Subject")]]))

    cResp.frame <- as.data.frame.table(cResp)
    names(cResp.frame) <- c("eccentricity", "condition", "trial", "level", "session", "correct_response")

    tPresent.frame <- as.data.frame.table(tPresent)
    names(tPresent.frame) <- c("trial", "eccentricity", "condition", "level", "session", "tPresent")

    response.frame <- left_join(cResp.frame, tPresent.frame, by = c("trial", "condition", "level", "session", "eccentricity")) %>% as_tibble()

    response.frame[,1:5] <- lapply(response.frame[,1:5], factor)

    levels(response.frame$trial)        <- 1:(nTrials+1)
    levels(response.frame$level)        <- amplitudes
    levels(response.frame$session)      <- 1:nSessions
    levels(response.frame$eccentricity) <- eccentricity.vals
    levels(response.frame$condition)    <- condition.vals

    response.frame$type <- NULL

    response.frame$type[(response.frame$correct_response == 1 & response.frame$tPresent == 1)] <- "HIT"
    response.frame$type[(response.frame$correct_response == 0 & response.frame$tPresent == 1)] <- "MISS"
    response.frame$type[(response.frame$correct_response == 1 & response.frame$tPresent == 0)] <- "CR"
    response.frame$type[(response.frame$correct_response == 0 & response.frame$tPresent == 0)] <- "FA"

    subject  <- search_data[[1]][[which(rownames(search_data[[1]]) == "Subject")]][[1]]


    response.frame$SUBJECT  <- subject

    response.frame$bCon <- as.numeric(bCon)
    response.frame$experiment_name <- factor("periphery")

    response.frame <- response.frame %>% filter(trial != 1)

    # Rename columns for consistency
    response.frame <- dplyr::rename(response.frame, tAmp = level)

    periphery_data      <- response.frame
  }

  # map along subjects - fovea
  formatted.data.fovea <- map(subject_fovea_detection, format_foveal_data)

  # map along subjects - periphery
  formatted.data.periphery <- map(subject_periphery_detection, format_periphery_data)

  # bind all data
  all.subjects   <- do.call(rbind, c(formatted.data.fovea, formatted.data.periphery))

  all.subjects$eccentricity <- as.numeric(as.character(all.subjects$eccentricity))
  all.subjects$tAmp         <- as.numeric(as.character(all.subjects$tAmp))

  # Transform X
  all.subjects <- all.subjects %>% mutate(X = ifelse(condition == "fovea", 0,
                                                     ifelse(condition == "temporal", eccentricity * 120,
                                                            ifelse(condition == "inferior", 0,
                                                                   ifelse(condition == "superior", 0, 0)))))
  # Transform Y
  all.subjects <- all.subjects %>% mutate(Y = ifelse(condition == "superior", -eccentricity * 120,
                                                     ifelse(condition == "inferior",eccentricity * 120,0)))

  all.subjects$tAmp <- 255 * all.subjects$tAmp * 4.5499 / (127 * .2); # unit conversion

  all.subjects$SUBJECT <- subject


  return(all.subjects)
}