R/iat.score.R

In michaelpmcdonald/noggin: Tools for Scoring, Analysis, and Modeling Common Cognitive Tasks

#' Calculate a D score based on vectors of means, SDs, and Ns
#'
#' @param m1 mean of block 1
#' @param m2 mean of block 2
#' @param sd1 standard deviation of block 1
#' @param sd2 standard deviation of block 2
#' @param n1 n (count) of block 1
#' @param n2 n (count) of block 2
#'
#' @return vector of D scores
#'
#' @importFrom dplyr '%>%'
#'
#' @export
dScore <- function(m1, m2, sd1, sd2, n1, n2){
  # with a set of block mean latencies, sds, and ns, returns a d score
  numerator <- m1-m2
  denominator <- sqrt( ( ( (n1-1)*sd1^2+(n2-1)*sd2^2) +
                           ( (n1+n2) * ((m1-m2)^2 ) / 4) ) / (n1+n2-1))
  d <- numerator/denominator
  return(d)
}

#' Find compatibility order of IAT
#'
#' @param df same as scoring frame
#'
#' @return data frame of subjects with order
#' @importFrom dplyr %>%
#' @export
iat_findOrder <- function(df){
  results <- df %>%
    dplyr::filter(blocknum == 3 & trialnum == 2) %>%
    dplyr::mutate(order = forcats::fct_recode(blockcode,
                                              "compatiblefirst" = "compatibletest1",
                                              'incompatiblefirst' = "incompatibletest1")) %>%
    dplyr::select(subject, order)
  return(results)
}

#' Score IAT
#'
#' @description Processes IAT experimental data and returns D score and
#' appropriate statistics
#'
#' @param experiment Experiment object generated by setup
#' @param platform experimental platform (default = "inquisit")
#'
#' @return a list of data.frames
#' @export
#' @import dplyr
#' @import tidyr
score.iat <- function(experiment, excludedSubjects = NA, platform = "inquisit", groupVar = NULL, ...){
  # Recode factors in a way that's easier to use
  df <- experiment$stzd %>%
    dplyr::mutate(pairing = forcats::fct_recode(blockcode,
                                                "1" = "attributepractice",
                                                '2' = "targetcompatiblepractice",
                                                '3' = "compatibletest1",
                                                '4' = "compatibletest2",
                                                '5' = "targetincompatiblepractice",
                                                '6' = "incompatibletest1",
                                                '7' = "incompatibletest2")
    ) %>%
    # generate a unique session ID for each subject
    unite(timesub, c(time, subject), sep = "_", remove = FALSE)

  # Filter out incomplete runs
  completeCheck <- df %>%
    group_by(timesub) %>% summarize(complete = length(group) == 180)
  completeTIMESUB <- filter(completeCheck, complete == TRUE)

  message("Dropped ", sum(completeCheck$complete == FALSE), " incomplete runs.")

  df <- df %>% filter(timesub %in% completeTIMESUB$timesub) #do the drop

  tbl_D_calc_statistics_long <- df %>%
    dplyr::select(subject, pairing, latency, correct) %>%
    dplyr::group_by(subject, pairing) %>%
    dplyr::summarize(mean_latency = mean(latency),
                     sd_latency = sd(latency),
                     acc = mean(correct, na.rm = TRUE),
                     n_trials = n()) %>%
    dplyr::filter(!is.na(pairing) & !is.na(mean_latency) & !is.na(sd_latency) & !is.na(n_trials))
  # Separately spread statistics into wide form and rename the variables appropriately
  # (there are better ways to do this, but it's not worth rewriting)

  temp1 <- tbl_D_calc_statistics_long %>% select(subject, pairing, mean_latency) %>% spread(pairing, mean_latency)
  temp2 <- tbl_D_calc_statistics_long %>% select(subject, pairing, sd_latency) %>% spread(pairing, sd_latency)
  temp3 <- tbl_D_calc_statistics_long %>% select(subject, pairing, n_trials) %>% spread(pairing, n_trials)
  temp4 <- tbl_D_calc_statistics_long %>% select(subject, pairing, acc) %>% spread(pairing, acc)

  # Sort columns so the next step doesn't mess up
  temp1 <- temp1[, order(names(temp1))]
  temp2 <- temp2[, order(names(temp2))]
  temp3 <- temp3[, order(names(temp3))]
  temp4 <- temp4[, order(names(temp4))]

  names(temp1) <- c(paste("lat", 1:7, sep=""), "subject")
  names(temp2) <- c(paste("sd", 1:7, sep=""), "subject")
  names(temp3) <- c(paste("n", 1:7, sep=""), "subject")
  names(temp4) <- c(paste("acc", 1:7, sep=""), "subject")


  # Join temporary tables into one wide-form table
  tbl_D_calc_statistics <- temp1 %>% left_join(temp2) %>% left_join(temp3) %>% left_join(temp4)

  # # IAT calculations # #

  tbl_D_calc_statistics$dPractice <- with(tbl_D_calc_statistics, dScore(lat6, lat3, sd6, sd3, n6, n3))
  tbl_D_calc_statistics$dTest <- with(tbl_D_calc_statistics, dScore(lat7, lat4, sd7, sd4, n7, n4))
  tbl_D_calc_statistics$dAll <- (.5*tbl_D_calc_statistics$dPractice+.5*tbl_D_calc_statistics$dTest)


  # Create a variable that indicates whether or not a dataset is complete
  tbl_D_calc_statistics$complete <- !is.na(rowSums(tbl_D_calc_statistics))

  tbl_D_calc_statistics$meanLat <- with(tbl_D_calc_statistics, (lat3+lat4+lat6+lat7)/4)

  expt$scored <- data.frame(tbl_D_calc_statistics)

  # Determine exclusion flags
  speed_flag <- iat_flagSpeed(df)
  error_flag <- iat_flagError(df, .4)
  flags <- speed_flag %>% left_join(., error_flag)
  expt$flags <- flags


  return(expt)
}