#' Disaffect platform-specific output
#'
#' @param experiment
#'
#' @return experiment object + standardized data frame stzd
#' @export
disaffect.iat <- function(experiment){
## A standard IAT data structure contains the columns:
## date, time, group, subject, blockcode, blocknum, trialcode, trialnum,
## response, correct, latency, stimulusnumber1, stimulusitem1
if (is.na(experiment$platform)){
warning("Experiment cannot be disaffected without specifying a platform.")
}
if (experiment$platform == "inquisit"){
experiment$stzd <- experiment$raw %>% select("date" = date,
"time" = time,
"group" = group,
"subject" = subject,
"trialcode" = trialcode,
"trialnum" = trialnum,
"response" = response,
"correct" = correct,
"latency" = latency,
"stimulusnumber" = stimulusnumber1,
"stimulusitem" = stimulusitem1)
}
return(experiment)
}
#' 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, ...){
# Set up the expt object
class(experiment) <- c("iat", "experiment")
# 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)
}
#' Generate flags for the IAT
#'
#' @param experiment experiment object
#'
#' @return experiment + exclusionCriteria
#' @export
flag.iat <- function(...){
}
#' 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)
}
#' Flag subjects for excessive speed
#'
#' @param df dataframe containing columns subject, pairing, and latency
#' @param threshold value (in seconds) to assess as a speed threshold (i.e. trials under 300ms)
#' @param criterion value (as proportion) above which to flag a subject for discard, i.e. .10 of trials under 300ms
#'
#' @return a vector of subjects, proportion under threshold, and flag (logical)
#' @export
#' @importFrom dplyr %>%
iat_flagSpeed <- function(df, threshold = .3, criterion = .1){
df %>%
dplyr::select(subject, pairing, latency) %>%
dplyr::filter(pairing %in% c("3","4","6","7")) %>% # only examine in paired blocks
dplyr::group_by(subject) %>%
dplyr::summarize(meanUnderThreshold = mean(latency <= threshold), # returns proportion under 300ms
speed_flag = mean(latency <= threshold) > criterion)
}
#' Flag Error Rate (IAT)
#'
#' @param df dataframe containing subject number, pairing, and correct (1/0 or T/F)
#' @param criterion maximum acceptable error rate
#'
#' @return dataframe of subject numbers and flag values (true/false)
#' @export
#' @importFrom dplyr %>%
iat_flagError <- function(df, criterion){
flag_data <- df %>%
dplyr::select(subject, pairing, correct) %>%
dplyr::group_by(subject, pairing) %>%
dplyr::summarize(error_rate = mean(1 - correct)) %>%
dplyr::group_by(subject) %>%
dplyr::summarize(error_rate = mean(error_rate),
error_flag = max(error_rate) >= criterion)
return(flag_data)
}
#' 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)
}
# find stimuli pair in a particular block for a particular subject
# df %>% filter(subject == XX & blockcode == "compatibletest1" & response == 23 & correct == 1) %>% select(trialcode) %>% unique()
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.