From 0c3cb1fc180e43764d4041b6a8c58a68e7e3a7bb Mon Sep 17 00:00:00 2001 From: Michal Kouril Date: Fri, 20 Oct 2023 22:59:07 -0400 Subject: [PATCH 1/3] Fixed IATreliability ordering. Fix to the originally intended preordering of the responses. --- R/IATreliability.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/IATreliability.R b/R/IATreliability.R index 2dbeb8e..bcd7895 100644 --- a/R/IATreliability.R +++ b/R/IATreliability.R @@ -22,28 +22,28 @@ IATreliability <- function(data, inclusive.sd=TRUE){ b1.prac <-c() for (i in 1:nrow(data$clean.latencies.prac1)){ temp <- data$clean.latencies.prac1[i,] - temp <- temp[order(data$raw.stim.number.prac1[i,])] + temp <- unlist(temp[order(unlist(data$raw.stim.number.prac1[i,]))]) b1.prac <- rbind(b1.prac, temp) } b2.prac <-c() for (i in 1:nrow(data$clean.latencies.prac2)){ temp <- data$clean.latencies.prac2[i,] - temp <- temp[order(data$raw.stim.number.prac2[i,])] + temp <- unlist(temp[order(unlist(data$raw.stim.number.prac2[i,]))]) b2.prac <- rbind(b2.prac, temp) } b1.crit <-c() for (i in 1:nrow(data$clean.latencies.crit1)){ temp <- data$clean.latencies.crit1[i,] - temp <- temp[order(data$raw.stim.number.crit1[i,])] + temp <- unlist(temp[order(unlist(data$raw.stim.number.crit1[i,]))]) b1.crit <- rbind(b1.crit, temp) } b2.crit <-c() for (i in 1:nrow(data$clean.latencies.crit2)){ temp <- data$clean.latencies.crit2[i,] - temp <- temp[order(data$raw.stim.number.crit2[i,])] + temp <- unlist(temp[order(unlist(data$raw.stim.number.crit2[i,]))]) b2.crit <- rbind(b2.crit, temp) } From 1756abb2181cc07d61020cebb0c730228f5ecf98 Mon Sep 17 00:00:00 2001 From: Michal Kouril Date: Fri, 20 Oct 2023 23:47:46 -0400 Subject: [PATCH 2/3] Added reliability testing. --- tests/testthat/test-analyze.R | 17 +++++++++++++---- tests/testthat/test-iatreliability.R | 27 +++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 4 deletions(-) create mode 100644 tests/testthat/test-iatreliability.R diff --git a/tests/testthat/test-analyze.R b/tests/testthat/test-analyze.R index c219393..85ca348 100644 --- a/tests/testthat/test-analyze.R +++ b/tests/testthat/test-analyze.R @@ -6,10 +6,19 @@ test_that("Function to import and analyze csv", { allContent = allContent[-2] dat = read.csv(textConnection(allContent), header = TRUE, stringsAsFactors = FALSE) - dat$compatible.crit <- combineIATfourblocks(dat$Q4.RP4, dat$Q18.LP4, dat$Q14.RN7, dat$Q28.LN7) - dat$incompatible.crit <- combineIATfourblocks(dat$Q7.RP7, dat$Q21.LP7, dat$Q11.RN4, dat$Q25.LN4) - dat$compatible.prac <- combineIATfourblocks(dat$Q3.RP3, dat$Q17.LP3, dat$Q13.RN6, dat$Q27.LN6) - dat$incompatible.prac <- combineIATfourblocks(dat$Q6.RP6, dat$Q20.LP6, dat$Q10.RN3, dat$Q24.LN3) + + suppressWarnings( + dat$compatible.crit <- combineIATfourblocks(dat$Q4.RP4, dat$Q18.LP4, dat$Q14.RN7, dat$Q28.LN7) + ) + suppressWarnings( + dat$incompatible.crit <- combineIATfourblocks(dat$Q7.RP7, dat$Q21.LP7, dat$Q11.RN4, dat$Q25.LN4) + ) + suppressWarnings( + dat$compatible.prac <- combineIATfourblocks(dat$Q3.RP3, dat$Q17.LP3, dat$Q13.RN6, dat$Q27.LN6) + ) + suppressWarnings( + dat$incompatible.prac <- combineIATfourblocks(dat$Q6.RP6, dat$Q20.LP6, dat$Q10.RN3, dat$Q24.LN3) + ) clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, dat$incompatible.prac, dat$incompatible.crit) diff --git a/tests/testthat/test-iatreliability.R b/tests/testthat/test-iatreliability.R new file mode 100644 index 0000000..c0d1ba2 --- /dev/null +++ b/tests/testthat/test-iatreliability.R @@ -0,0 +1,27 @@ +context("reliability") + +test_that("IATreliability", { + filename <- "iat_small.csv" + allContent <- readLines(filename, encoding="UTF-8") + allContent = allContent[-2] + dat = read.csv(textConnection(allContent), header = TRUE, stringsAsFactors = FALSE) + + suppressWarnings( + dat$compatible.crit <- combineIATfourblocks(dat$Q4.RP4, dat$Q18.LP4, dat$Q14.RN7, dat$Q28.LN7) + ) + suppressWarnings( + dat$incompatible.crit <- combineIATfourblocks(dat$Q7.RP7, dat$Q21.LP7, dat$Q11.RN4, dat$Q25.LN4) + ) + suppressWarnings( + dat$compatible.prac <- combineIATfourblocks(dat$Q3.RP3, dat$Q17.LP3, dat$Q13.RN6, dat$Q27.LN6) + ) + suppressWarnings( + dat$incompatible.prac <- combineIATfourblocks(dat$Q6.RP6, dat$Q20.LP6, dat$Q10.RN3, dat$Q24.LN3) + ) + + clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, + dat$incompatible.prac, dat$incompatible.crit) + + reliability <- IATreliability(clean) + expect_true(round(reliability$reliability,4) == 1) +}) From 9ae18e26083d4177588befa0c73cca9c5917fa1a Mon Sep 17 00:00:00 2001 From: Michal Kouril Date: Sat, 21 Oct 2023 10:49:49 -0400 Subject: [PATCH 3/3] 1.6.0 candidate; Added tests; Fixed styling. --- .Rbuildignore | 1 + .github/workflows/ci-tests.yml | 12 + DESCRIPTION | 7 +- NAMESPACE | 6 + R/IATalpha.R | 29 +- R/IATreliability.R | 101 +- R/cleanIAT.R | 1308 +++++++++++---------- R/cleanIAT.noprac.R | 678 +++++------ R/combineIATfourblocks.R | 70 +- R/parcelIAT.R | 110 +- R/writeIATfull.R | 1501 +++++++++++++------------ man/cleanIAT.Rd | 23 +- man/writeIATfull.Rd | 421 +++---- tests/testthat/test-analyze.R | 14 +- tests/testthat/test-cleaniat-noprac.R | 27 + tests/testthat/test-iatalpha.R | 30 + tests/testthat/test-iatreliability.R | 14 +- tests/testthat/test-parcel.R | 30 + tests/testthat/test-qsf.R | 43 +- 19 files changed, 2407 insertions(+), 2018 deletions(-) create mode 100644 .github/workflows/ci-tests.yml create mode 100644 tests/testthat/test-cleaniat-noprac.R create mode 100644 tests/testthat/test-iatalpha.R create mode 100644 tests/testthat/test-parcel.R diff --git a/.Rbuildignore b/.Rbuildignore index 91114bf..dd2032e 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,2 +1,3 @@ ^.*\.Rproj$ ^\.Rproj\.user$ +.github diff --git a/.github/workflows/ci-tests.yml b/.github/workflows/ci-tests.yml new file mode 100644 index 0000000..14f578e --- /dev/null +++ b/.github/workflows/ci-tests.yml @@ -0,0 +1,12 @@ +name: ci-tests +on: [push] +jobs: + r-cmd-check: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v3 + - uses: r-lib/actions/setup-r@v2 + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + - uses: r-lib/actions/check-r-package@v2 diff --git a/DESCRIPTION b/DESCRIPTION index 13fb817..9f4919d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,13 +1,14 @@ Package: iatgen Type: Package Title: IATs for Qualtrics -Version: 1.5.0 +Version: 1.6.0 Authors@R: c(person("Tom","Carpenter", role = c("aut"), email = "tcarpenter@spu.edu"), person("Michal","Kouril", role = c("aut", "cre"), email = "michal.kouril@cchmc.org")) Description: Generate and analyze IATs (Implicit Association Tests) for use in Qualtrics . License: CC BY-NC 4.0 Encoding: UTF-8 -RoxygenNote: 7.1.1 -Imports: jsonlite, psych, stringr, testthat +RoxygenNote: 7.2.3 +Imports: jsonlite, psych, stringr +Suggests: testthat NeedsCompilation: no diff --git a/NAMESPACE b/NAMESPACE index fe43221..25728fc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,12 @@ export(parcelIAT) export(writeIATfull) importFrom(jsonlite,minify) importFrom(jsonlite,toJSON) +importFrom(psych,alpha) importFrom(stats,cor) importFrom(stats,median) importFrom(stats,sd) +importFrom(stringr,str_count) +importFrom(stringr,str_length) +importFrom(stringr,str_locate) +importFrom(stringr,str_replace_all) +importFrom(stringr,str_sub) diff --git a/R/IATalpha.R b/R/IATalpha.R index 4655209..52f5702 100644 --- a/R/IATalpha.R +++ b/R/IATalpha.R @@ -4,6 +4,7 @@ #' @param data an object created by \code{cleanIAT()} representing a cleaned IAT. #' @return Returns a list with alphas based on the practice trials, the critical trials, and the entire IAT. Also retuns a matrix `diffscores` of the differences in latency for all matched trials (pooled practice and critical into one matrix) #' @export +#' @importFrom psych alpha #' @references Schnabel, K., Asendorpf, J. B., & Greenwald, A. G. (2008). Using Implicit Association Tests for the Assessment of Implicit Personality Self-Concept. In The SAGE Handbook of Personality Theory and Assessment: Volume 2—Personality Measurement and Testing (pp. 508–528). SAGE Publications Ltd. https://doi.org/10.4135/9781849200479.n24 #' @examples \dontrun{ #' ### RELIABILITY ANALYSIS - ESTIMATE ONLY ### @@ -12,33 +13,31 @@ #' ### RELIABILITY ANALYSIS - ENTIRE RELIABILITY OUTPUT ### #' IATalpha(clean) #' } - -IATalpha <- function(data){ - # require(psych) +IATalpha <- function(data) { prac1 <- data$clean.latencies.prac1 prac2 <- data$clean.latencies.prac2 crit1 <- data$clean.latencies.crit1 crit2 <- data$clean.latencies.crit2 - #matricies must have exact same dimensions. + # matricies must have exact same dimensions. # Any weird or extra trials due to error will cause issues. id correct dimensions and coerce. getmode <- function(v) { uniqv <- unique(v) uniqv[which.max(tabulate(match(v, uniqv)))] } - prac1.cols <- getmode(rowSums(!is.na(prac1[!data$skipped & !data$drop.participant,]))) - prac2.cols <- getmode(rowSums(!is.na(prac2[!data$skipped & !data$drop.participant,]))) - crit1.cols <- getmode(rowSums(!is.na(crit1[!data$skipped & !data$drop.participant,]))) - crit2.cols <- getmode(rowSums(!is.na(crit2[!data$skipped & !data$drop.participant,]))) + prac1.cols <- getmode(rowSums(!is.na(prac1[!data$skipped & !data$drop.participant, ]))) + prac2.cols <- getmode(rowSums(!is.na(prac2[!data$skipped & !data$drop.participant, ]))) + crit1.cols <- getmode(rowSums(!is.na(crit1[!data$skipped & !data$drop.participant, ]))) + crit2.cols <- getmode(rowSums(!is.na(crit2[!data$skipped & !data$drop.participant, ]))) - prac1 <- prac1[,1:prac1.cols] - prac2 <- prac2[,1:prac2.cols] - crit1 <- crit1[,1:crit1.cols] - crit2 <- crit2[,1:crit2.cols] + prac1 <- prac1[, 1:prac1.cols] + prac2 <- prac2[, 1:prac2.cols] + crit1 <- crit1[, 1:crit1.cols] + crit2 <- crit2[, 1:crit2.cols] - prac <- prac1-prac2 - crit <- crit1-crit2 + prac <- prac1 - prac2 + crit <- crit1 - crit2 df <- cbind(prac, crit) colnames(df) <- paste0("trial", 1:ncol(df)) @@ -47,5 +46,5 @@ IATalpha <- function(data){ alpha.crit <- suppressMessages(suppressWarnings(psych::alpha(crit)$total[1])) alpha.total <- suppressMessages(suppressWarnings(psych::alpha(df)$total[1])) - return(list(alpha.prac=alpha.prac, alpha.crit=alpha.crit, alpha.total=alpha.total, diffscores=df)) + return(list(alpha.prac = alpha.prac, alpha.crit = alpha.crit, alpha.total = alpha.total, diffscores = df)) } diff --git a/R/IATreliability.R b/R/IATreliability.R index bcd7895..8e37839 100644 --- a/R/IATreliability.R +++ b/R/IATreliability.R @@ -1,5 +1,3 @@ -# requireNamespace("stringr") - ########## STEP SIX: RELIABILITY ANALYSIS #' Data analysis function: Estimate reliability of IAT #' @description One can easily estimate the IAT reliability by scoring the IAT separately based on odd and even trials and compute a split-half reliability. This is accomplished using \code{IATreliability()}, which sorts trials in order by type (positive, negative, target A, target B), takes alternating trials in order of presentation, scores and correlates the IAT, and applies a split-half spearman-brown correction (De Houwer & De Bruycker, 2007). This ensures an even distribution of targets and categories in odd/even trialsets. @@ -16,34 +14,33 @@ #' ### RELIABILITY ANALYSIS - ENTIRE RELIABILITY OUTPUT ### #' IATreliability(clean) #' } -IATreliability <- function(data, inclusive.sd=TRUE){ - - #put clean latencies in order by stim number, which sorts by pos, neg, A, and B trials and within that, order of presentation - b1.prac <-c() - for (i in 1:nrow(data$clean.latencies.prac1)){ - temp <- data$clean.latencies.prac1[i,] - temp <- unlist(temp[order(unlist(data$raw.stim.number.prac1[i,]))]) +IATreliability <- function(data, inclusive.sd = TRUE) { + # put clean latencies in order by stim number, which sorts by pos, neg, A, and B trials and within that, order of presentation + b1.prac <- c() + for (i in 1:nrow(data$clean.latencies.prac1)) { + temp <- data$clean.latencies.prac1[i, ] + temp <- unlist(temp[order(unlist(data$raw.stim.number.prac1[i, ]))]) b1.prac <- rbind(b1.prac, temp) } - b2.prac <-c() - for (i in 1:nrow(data$clean.latencies.prac2)){ - temp <- data$clean.latencies.prac2[i,] - temp <- unlist(temp[order(unlist(data$raw.stim.number.prac2[i,]))]) + b2.prac <- c() + for (i in 1:nrow(data$clean.latencies.prac2)) { + temp <- data$clean.latencies.prac2[i, ] + temp <- unlist(temp[order(unlist(data$raw.stim.number.prac2[i, ]))]) b2.prac <- rbind(b2.prac, temp) } - b1.crit <-c() - for (i in 1:nrow(data$clean.latencies.crit1)){ - temp <- data$clean.latencies.crit1[i,] - temp <- unlist(temp[order(unlist(data$raw.stim.number.crit1[i,]))]) + b1.crit <- c() + for (i in 1:nrow(data$clean.latencies.crit1)) { + temp <- data$clean.latencies.crit1[i, ] + temp <- unlist(temp[order(unlist(data$raw.stim.number.crit1[i, ]))]) b1.crit <- rbind(b1.crit, temp) } - b2.crit <-c() - for (i in 1:nrow(data$clean.latencies.crit2)){ - temp <- data$clean.latencies.crit2[i,] - temp <- unlist(temp[order(unlist(data$raw.stim.number.crit2[i,]))]) + b2.crit <- c() + for (i in 1:nrow(data$clean.latencies.crit2)) { + temp <- data$clean.latencies.crit2[i, ] + temp <- unlist(temp[order(unlist(data$raw.stim.number.crit2[i, ]))]) b2.crit <- rbind(b2.crit, temp) } @@ -51,72 +48,72 @@ IATreliability <- function(data, inclusive.sd=TRUE){ ## BLOCK 1 - odd.prac.1 <- seq(1, ncol(b1.prac), by=2) - even.prac.1 <- seq(2, ncol(b1.prac), by=2) + odd.prac.1 <- seq(1, ncol(b1.prac), by = 2) + even.prac.1 <- seq(2, ncol(b1.prac), by = 2) - odd.crit.1 <- seq(1, ncol(b1.crit), by=2) - even.crit.1 <- seq(2, ncol(b1.crit), by=2) + odd.crit.1 <- seq(1, ncol(b1.crit), by = 2) + even.crit.1 <- seq(2, ncol(b1.crit), by = 2) # save latencies and means for block 1 - odd.prac.latencies1 <- b1.prac[,odd.prac.1] - even.prac.latencies1 <- b1.prac[,even.prac.1] - odd.prac.means1 <- rowMeans(odd.prac.latencies1, na.rm=T) - even.prac.means1 <- rowMeans(even.prac.latencies1, na.rm=T) + odd.prac.latencies1 <- b1.prac[, odd.prac.1] + even.prac.latencies1 <- b1.prac[, even.prac.1] + odd.prac.means1 <- rowMeans(odd.prac.latencies1, na.rm = T) + even.prac.means1 <- rowMeans(even.prac.latencies1, na.rm = T) odd.prac.means1[is.nan(odd.prac.means1)] <- NA even.prac.means1[is.nan(even.prac.means1)] <- NA - odd.crit.latencies1 <- b1.crit[,odd.crit.1] - even.crit.latencies1 <- b1.crit[,even.crit.1] - odd.crit.means1 <- rowMeans(odd.crit.latencies1, na.rm=T) - even.crit.means1 <- rowMeans(even.crit.latencies1, na.rm=T) + odd.crit.latencies1 <- b1.crit[, odd.crit.1] + even.crit.latencies1 <- b1.crit[, even.crit.1] + odd.crit.means1 <- rowMeans(odd.crit.latencies1, na.rm = T) + even.crit.means1 <- rowMeans(even.crit.latencies1, na.rm = T) odd.crit.means1[is.nan(odd.crit.means1)] <- NA even.crit.means1[is.nan(even.crit.means1)] <- NA ## BLOCK 2 - odd.prac.2 <- seq(1, ncol(b2.prac), by=2) - even.prac.2 <- seq(2, ncol(b2.prac), by=2) + odd.prac.2 <- seq(1, ncol(b2.prac), by = 2) + even.prac.2 <- seq(2, ncol(b2.prac), by = 2) - odd.crit.2 <- seq(1, ncol(b2.crit), by=2) - even.crit.2 <- seq(2, ncol(b2.crit), by=2) + odd.crit.2 <- seq(1, ncol(b2.crit), by = 2) + even.crit.2 <- seq(2, ncol(b2.crit), by = 2) # save latencies and means for block 2 - odd.prac.latencies2 <- b2.prac[,odd.prac.2] - even.prac.latencies2 <- b2.prac[,even.prac.2] - odd.prac.means2 <- rowMeans(odd.prac.latencies2, na.rm=T) - even.prac.means2 <- rowMeans(even.prac.latencies2, na.rm=T) + odd.prac.latencies2 <- b2.prac[, odd.prac.2] + even.prac.latencies2 <- b2.prac[, even.prac.2] + odd.prac.means2 <- rowMeans(odd.prac.latencies2, na.rm = T) + even.prac.means2 <- rowMeans(even.prac.latencies2, na.rm = T) odd.prac.means2[is.nan(odd.prac.means2)] <- NA even.prac.means2[is.nan(even.prac.means2)] <- NA - odd.crit.latencies2 <- b2.crit[,odd.crit.2] - even.crit.latencies2 <- b2.crit[,even.crit.2] - odd.crit.means2 <- rowMeans(odd.crit.latencies2, na.rm=T) - even.crit.means2 <- rowMeans(even.crit.latencies2, na.rm=T) + odd.crit.latencies2 <- b2.crit[, odd.crit.2] + even.crit.latencies2 <- b2.crit[, even.crit.2] + odd.crit.means2 <- rowMeans(odd.crit.latencies2, na.rm = T) + even.crit.means2 <- rowMeans(even.crit.latencies2, na.rm = T) odd.crit.means2[is.nan(odd.crit.means2)] <- NA even.crit.means2[is.nan(even.crit.means2)] <- NA diff.prac.odd <- odd.prac.means2 - odd.prac.means1 - inclusive.sd.prac.odd <- apply(cbind(as.matrix(odd.prac.latencies1), as.matrix(odd.prac.latencies2)), 1, sd, na.rm=TRUE) + inclusive.sd.prac.odd <- apply(cbind(as.matrix(odd.prac.latencies1), as.matrix(odd.prac.latencies2)), 1, sd, na.rm = TRUE) D1.prac <- diff.prac.odd / inclusive.sd.prac.odd diff.crit.odd <- odd.crit.means2 - odd.crit.means1 - inclusive.sd.crit.odd <- apply(cbind(as.matrix(odd.crit.latencies1), as.matrix(odd.crit.latencies2)), 1, sd, na.rm=T) + inclusive.sd.crit.odd <- apply(cbind(as.matrix(odd.crit.latencies1), as.matrix(odd.crit.latencies2)), 1, sd, na.rm = T) D1.crit <- diff.crit.odd / inclusive.sd.crit.odd diff.prac.even <- even.prac.means2 - even.prac.means1 - inclusive.sd.prac.even <- apply(cbind(as.matrix(even.prac.latencies1), as.matrix(even.prac.latencies2)), 1, sd, na.rm=T) + inclusive.sd.prac.even <- apply(cbind(as.matrix(even.prac.latencies1), as.matrix(even.prac.latencies2)), 1, sd, na.rm = T) D2.prac <- diff.prac.even / inclusive.sd.prac.even diff.crit.even <- even.crit.means2 - even.crit.means1 - inclusive.sd.crit.even <- apply(cbind(as.matrix(even.crit.latencies1), as.matrix(even.crit.latencies2)), 1, sd, na.rm=T) + inclusive.sd.crit.even <- apply(cbind(as.matrix(even.crit.latencies1), as.matrix(even.crit.latencies2)), 1, sd, na.rm = T) D2.crit <- diff.crit.even / inclusive.sd.crit.even D1 <- ((D1.prac + D1.crit) / 2) D2 <- ((D2.prac + D2.crit) / 2) - splithalfcorr <- cor(D1, D2, use="pairwise.complete.obs") - reliability <- (2*splithalfcorr) / (1 + splithalfcorr) - return(list(reliability=reliability, splithalfcorr=splithalfcorr, D.odd = D1, D.even = D2, D.prac.odd=D1.prac, D.crit.odd=D1.crit, D.prac.even=D2.prac, D.crit.even=D2.crit)) + splithalfcorr <- cor(D1, D2, use = "pairwise.complete.obs") + reliability <- (2 * splithalfcorr) / (1 + splithalfcorr) + return(list(reliability = reliability, splithalfcorr = splithalfcorr, D.odd = D1, D.even = D2, D.prac.odd = D1.prac, D.crit.odd = D1.crit, D.prac.even = D2.prac, D.crit.even = D2.crit)) } diff --git a/R/cleanIAT.R b/R/cleanIAT.R index dbffa42..5de48e4 100644 --- a/R/cleanIAT.R +++ b/R/cleanIAT.R @@ -1,5 +1,3 @@ -requireNamespace("stringr") - #' Data analysis function: Processes and cleans raw IAT data #' @description Prior to running, please see \code{combineIATfourblocks()}. This function processes, cleans, and scores the combined IAT data. In addition, it returns diagnostics (see examples, below). By default, the function implements the D-score algorithm (Greenwald et al., 2003, p 214, center column). Because it assumes users were forced to correct errors, no error penalty is imposed (unless the user requests it; see below). The function can be easily configured to do other scoring procedures as well. The function accepts as an input four vectors of IAT responses (see \code{prac1}, \code{crit1}, \code{prac2}, and \code{crit2}, below). It returns a list containing a variety of IAT variables, including matrices of clean latencies and other information (see below). The most important is \code{clean$D}, which is the final D scores for the analysis. Users can also extract clean block means for each participant using \code{clean$clean.means.prac1}, \code{clean$clean.means.crit1}, \code{clean$clean.means.prac2}, and \code{clean$clean.means.crit2}. Users can extract matrices of clean latencies using \code{clean$clean.latencies.prac1}, \code{clean$clean.latencies.crit1}, etc. Raw latencies can be requested with \code{clean$raw.latencies.prac1}, etc. Users can request to know whether a trial was correct with \code{clean$clean.correct.prac1}, etc. and precisely which stimulus was used on a given trial with \code{clean$clean.stim.number.prac1}, etc. (Stimuli are numbered based on their order entered within each category and following the sequence "positive, negative, tgtA, tgtB". For example, stimulus 1 is the first positive stimulus). See below for more information on what is returned from this function. The data cleaning function adheres to Greenwald et al. (2003; see also Lane et al., 2005, p. 92 for a simplified table of data cleaning steps). There are four main data cleaning options. First, long responses are usually dealt with by setting \code{timeout.drop=TRUE} (enabled by default), which drops individual trials over a given threshold (\code{timeout.ms}, which is 10000 ms by default). Next, overly short responses (i.e., button mashing) are dealt with by setting \code{fastprt.drop=TRUE} (enabled by default), which drops participants who have too many fast responses (more than a \code{fastprt.percent} proportion [default = .10] of responses faster than \code{fastprt.ms} [default = 300 ms]). Alternatively, one can remove individual fast trials by setting \code{fasttrial.drop=TRUE} (disabled by default), which uses a default threshold of \code{fasttrial.ms=400} ms. (This is seldom used but enables users to use alternative scoring methods [e.g., Greenwald et al., 2003, p 214, right column]). Finally, an error penalty is imposed on incorrect responses in some variants. If the IAT forces participants to correct errors, then no error penalty should be imposed (\code{error.penalty=FALSE}, the default setting). However, if participants are not forced to correct errors, one is added. Most common is a 600 ms penalty above the clean block mean (Greenwald et al., 2003), which is done by setting \code{error.penalty.ms=600}, sometimes known as the D600 scoring procedure. Greenwald et al. (2003) also suggested one could use two standard deviations instead of 600 ms, which is done by setting \code{error.penalty.ms="2SD"}. Finally, the function ensures that the data are not corrupted (i.e., JavaScript malfunction on participant's computer when completing the survey) by requiring that only appropriate characters (numbers, commas, "C", "X", and "END) are in the raw data. #' @param prac1 A vector of one kind of practice responses (e.g., compatible practice), one per participant. @@ -17,6 +15,7 @@ requireNamespace("stringr") #' @param error.penalty.ms (Required if \code{error.penalty=TRUE}; set to \code{error.penalty.ms=600} by default). Following the D600 procedure, IAT errors are scored as the correct-trial block mean plus an error penalty of 600 ms. Can be manually set to any desired value. One can also use the 2SD penalty [Greenwald et al., 2003, p 214, right column] by setting \code{error.penalty.ms="2SD"}. Ignored if \code{error.penalty=FALSE}. #' @param inclusive.sd Unused parameter. #' @importFrom stats median sd +#' @importFrom stringr str_count str_length str_locate str_replace_all str_sub #' @export #' @return Returns a list containing several important elements. #' \code{skipped} is a vector indicating whether the participant completed the IAT or skipped it. They are dropped from analysis if the IAT was skipped. @@ -93,24 +92,29 @@ requireNamespace("stringr") #' @examples \dontrun{ #' #' ### CLEAN THE IAT USING THE BUILT IN ERROR PENALTY FOR FORCED-ERROR CORRECTION ### -#' clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, -#' dat$incompatible.prac, dat$incompatible.crit) +#' clean <- cleanIAT( +#' dat$compatible.prac, dat$compatible.crit, +#' dat$incompatible.prac, dat$incompatible.crit +#' ) #' #' ### CLEAN THE IAT USING THE D600 PROCEDURE ### #' clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, -#' dat$incompatible.prac, dat$incompatible.crit, -#' error.penalty=TRUE, error.penalty.ms=600) +#' dat$incompatible.prac, dat$incompatible.crit, +#' error.penalty = TRUE, error.penalty.ms = 600 +#' ) #' #' ### CLEAN THE IAT USING THE D2SD PROCEDURE### #' clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, -#' dat$incompatible.prac, dat$incompatible.crit, -#' error.penalty=TRUE, error.penalty.ms = "2SD") +#' dat$incompatible.prac, dat$incompatible.crit, +#' error.penalty = TRUE, error.penalty.ms = "2SD" +#' ) #' #' ### CLEAN THE IAT USING THE D2SD PROCEDURE WITH TRIALS UNDER 400 MS DROPPED ### #' clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, -#' dat$incompatible.prac, dat$incompatible.crit, -#' fastprt.drop=FALSE, fasttrial.drop=TRUE, fasttrial.ms=400, -#' error.penalty=TRUE, error.penalty.ms = "2SD") +#' dat$incompatible.prac, dat$incompatible.crit, +#' fastprt.drop = FALSE, fasttrial.drop = TRUE, fasttrial.ms = 400, +#' error.penalty = TRUE, error.penalty.ms = "2SD" +#' ) #' #' ### EXAMINE CLEAN IAT SCORES #' clean$D @@ -129,52 +133,65 @@ requireNamespace("stringr") #' # ERROR RATE # #' clean$error.rate #' } +cleanIAT <- function(prac1, crit1, prac2, crit2, timeout.drop = TRUE, timeout.ms = 10000, fasttrial.drop = FALSE, fasttrial.ms = 400, fastprt.drop = TRUE, fastprt.percent = .10, fastprt.ms = 300, error.penalty = FALSE, error.penalty.ms = 600, inclusive.sd = TRUE) { + if (is.null(prac1)) { + stop("One of your input variables does not exist. Please check your data / variable names and try again.") + } + if (is.null(prac2)) { + stop("One of your input variables does not exist. Please check your data / variable names and try again.") + } + if (is.null(crit1)) { + stop("One of your input variables does not exist. Please check your data / variable names and try again.") + } + if (is.null(crit2)) { + stop("One of your input variables does not exist. Please check your data / variable names and try again.") + } -cleanIAT <- function(prac1, crit1, prac2, crit2, timeout.drop=TRUE, timeout.ms=10000, fasttrial.drop=FALSE, fasttrial.ms=400, fastprt.drop=TRUE, fastprt.percent=.10, fastprt.ms=300, error.penalty=FALSE, error.penalty.ms=600, inclusive.sd=TRUE) { - - if (is.null(prac1)){stop("One of your input variables does not exist. Please check your data / variable names and try again.")} - if (is.null(prac2)){stop("One of your input variables does not exist. Please check your data / variable names and try again.")} - if (is.null(crit1)){stop("One of your input variables does not exist. Please check your data / variable names and try again.")} - if (is.null(crit2)){stop("One of your input variables does not exist. Please check your data / variable names and try again.")} - - - if (all(is.na(prac1))){stop("One of your input variables is empty")} - if (all(is.na(prac2))){stop("One of your input variables is empty")} - if (all(is.na(crit1))){stop("One of your input variables is empty")} - if (all(is.na(crit2))){stop("One of your input variables is empty")} + if (all(is.na(prac1))) { + stop("One of your input variables is empty") + } + if (all(is.na(prac2))) { + stop("One of your input variables is empty") + } + if (all(is.na(crit1))) { + stop("One of your input variables is empty") + } + if (all(is.na(crit2))) { + stop("One of your input variables is empty") + } ## Declare local function to add leading zeros. Needed if the first two characters contain C or X add.leading.zeros <- function(temp) { - if (stringr::str_count(stringr::str_sub(temp,1,2),"C") == 1 | stringr::str_count(stringr::str_sub(temp,1,2),"X") == 1){ - temp <- paste("0", temp, sep="") + if (stringr::str_count(stringr::str_sub(temp, 1, 2), "C") == 1 | stringr::str_count(stringr::str_sub(temp, 1, 2), "X") == 1) { + temp <- paste("0", temp, sep = "") } return(temp) } - #Check for people who skipped IAT or who have nonvalid data - #Are there 3 "END" characters at end of string? If not, did not complete IAT; mark skipped - p.prac1 <- substring(prac1, (stringr::str_length(prac1)-2), stringr::str_length(prac1)) != "END" - p.crit1 <- substring(crit1, (stringr::str_length(crit1)-2), stringr::str_length(crit1)) != "END" - p.prac2 <- substring(prac2, (stringr::str_length(prac2)-2), stringr::str_length(prac2)) != "END" - p.crit2 <- substring(crit2, (stringr::str_length(crit2)-2), stringr::str_length(crit2)) != "END" + # Check for people who skipped IAT or who have nonvalid data + # Are there 3 "END" characters at end of string? If not, did not complete IAT; mark skipped + p.prac1 <- substring(prac1, (stringr::str_length(prac1) - 2), stringr::str_length(prac1)) != "END" + p.crit1 <- substring(crit1, (stringr::str_length(crit1) - 2), stringr::str_length(crit1)) != "END" + p.prac2 <- substring(prac2, (stringr::str_length(prac2) - 2), stringr::str_length(prac2)) != "END" + p.crit2 <- substring(crit2, (stringr::str_length(crit2) - 2), stringr::str_length(crit2)) != "END" prac1[p.prac1] <- "" crit1[p.crit1] <- "" prac2[p.prac2] <- "" crit2[p.crit2] <- "" - #mark people who skipped IAT as such + # mark people who skipped IAT as such skipped.prac1 <- prac1 == "" skipped.crit1 <- crit1 == "" skipped.prac2 <- prac2 == "" skipped.crit2 <- crit2 == "" - #check integrity of people who completed IAT + # check integrity of people who completed IAT p.prac1 <- (p.prac1 & !skipped.prac1) p.crit1 <- (p.crit1 & !skipped.crit1) p.prac2 <- (p.prac2 & !skipped.prac2) p.crit2 <- (p.crit2 & !skipped.crit2) - check.me <- function(temp){ + check.me <- function(temp) { temp <- stringr::str_replace_all(temp, "END", "") temp <- stringr::str_replace_all(temp, ",", "") temp <- stringr::str_replace_all(temp, "C", "") @@ -189,7 +206,7 @@ cleanIAT <- function(prac1, crit1, prac2, crit2, timeout.drop=TRUE, timeout.ms=1 temp <- stringr::str_replace_all(temp, "7", "") temp <- stringr::str_replace_all(temp, "8", "") temp <- stringr::str_replace_all(temp, "9", "") - return(!temp=="") + return(!temp == "") } p.prac1 <- as.logical(p.prac1 + check.me(prac1)) p.crit1 <- as.logical(p.crit1 + check.me(crit1)) @@ -197,19 +214,24 @@ cleanIAT <- function(prac1, crit1, prac2, crit2, timeout.drop=TRUE, timeout.ms=1 p.crit2 <- as.logical(p.crit2 + check.me(crit2)) p.prt <- as.logical(p.prac1 + p.crit1 + p.prac2 + p.crit2) - rm(p.prac1);rm(p.crit1);rm(p.prac2);rm(p.crit2) + rm(p.prac1) + rm(p.crit1) + rm(p.prac2) + rm(p.crit2) index.prt <- 1:length(p.prt) - flag<-index.prt[p.prt==TRUE]; rm(index.prt); rm(p.prt) + flag <- index.prt[p.prt == TRUE] + rm(index.prt) + rm(p.prt) prac1[flag] <- "" crit1[flag] <- "" prac2[flag] <- "" crit2[flag] <- "" - if(length(flag) > 0){ - for(i in 1:length(flag)){ - warning(paste("Participant ",flag[i],"'s web browser encountered an error during the survey. Their IAT data are not usable and not included in analysis.", sep="")) + if (length(flag) > 0) { + for (i in 1:length(flag)) { + warning(paste("Participant ", flag[i], "'s web browser encountered an error during the survey. Their IAT data are not usable and not included in analysis.", sep = "")) } } - #update skip counts to reflect number of validly completed IATs + # update skip counts to reflect number of validly completed IATs skipped.prac1 <- prac1 == "" skipped.crit1 <- crit1 == "" skipped.prac2 <- prac2 == "" @@ -228,85 +250,101 @@ cleanIAT <- function(prac1, crit1, prac2, crit2, timeout.drop=TRUE, timeout.ms=1 ## POPULATE data frames. Make all NA if task skipped. - #prac1 - for(i in 1:length(prac1)){ + # prac1 + for (i in 1:length(prac1)) { source <- toString(prac1[i]) - num.raw.trials.prac1[i] <- stringr::str_count(source,",") - if (skipped.prac1[i]) {raw.prac1[i,] <- NA} else { - for(j in 1:num.raw.trials.prac1[i]) { - comma.location <- stringr::str_locate(source,",")[1] - raw.prac1[i,j] <- stringr::str_sub(source, 1, comma.location - 1) - source <- stringr::str_sub(source, comma.location+1, stringr::str_length(source)) + num.raw.trials.prac1[i] <- stringr::str_count(source, ",") + if (skipped.prac1[i]) { + raw.prac1[i, ] <- NA + } else { + for (j in 1:num.raw.trials.prac1[i]) { + comma.location <- stringr::str_locate(source, ",")[1] + raw.prac1[i, j] <- stringr::str_sub(source, 1, comma.location - 1) + source <- stringr::str_sub(source, comma.location + 1, stringr::str_length(source)) } } } - #crit1 - for(i in 1:length(crit1)){ + # crit1 + for (i in 1:length(crit1)) { source <- toString(crit1[i]) - num.raw.trials.crit1[i] <- stringr::str_count(source,",") - if (skipped.crit1[i]) {raw.crit1[i,] <- NA} else { - for(j in 1:num.raw.trials.crit1[i]) { - comma.location <- stringr::str_locate(source,",")[1] - raw.crit1[i,j] <- stringr::str_sub(source, 1, comma.location - 1) - source <- stringr::str_sub(source, comma.location+1, stringr::str_length(source)) + num.raw.trials.crit1[i] <- stringr::str_count(source, ",") + if (skipped.crit1[i]) { + raw.crit1[i, ] <- NA + } else { + for (j in 1:num.raw.trials.crit1[i]) { + comma.location <- stringr::str_locate(source, ",")[1] + raw.crit1[i, j] <- stringr::str_sub(source, 1, comma.location - 1) + source <- stringr::str_sub(source, comma.location + 1, stringr::str_length(source)) } } } - #prac2 - for(i in 1:length(prac2)){ + # prac2 + for (i in 1:length(prac2)) { source <- toString(prac2[i]) - num.raw.trials.prac2[i] <- stringr::str_count(source,",") - if (skipped.prac2[i]) {raw.prac2[i,] <- NA} else { - for(j in 1:num.raw.trials.prac2[i]) { - comma.location <- stringr::str_locate(source,",")[1] - raw.prac2[i,j] <- stringr::str_sub(source, 1, comma.location - 1) - source <- stringr::str_sub(source, comma.location+1, stringr::str_length(source)) + num.raw.trials.prac2[i] <- stringr::str_count(source, ",") + if (skipped.prac2[i]) { + raw.prac2[i, ] <- NA + } else { + for (j in 1:num.raw.trials.prac2[i]) { + comma.location <- stringr::str_locate(source, ",")[1] + raw.prac2[i, j] <- stringr::str_sub(source, 1, comma.location - 1) + source <- stringr::str_sub(source, comma.location + 1, stringr::str_length(source)) } } } - #crit2 - for(i in 1:length(crit2)){ + # crit2 + for (i in 1:length(crit2)) { source <- toString(crit2[i]) - num.raw.trials.crit2[i] <- stringr::str_count(source,",") - if (skipped.crit2[i]) {raw.crit2[i,] <- NA} else { - for(j in 1:num.raw.trials.crit2[i]) { - comma.location <- stringr::str_locate(source,",")[1] - raw.crit2[i,j] <- stringr::str_sub(source, 1, comma.location - 1) - source <- stringr::str_sub(source, comma.location+1, stringr::str_length(source)) + num.raw.trials.crit2[i] <- stringr::str_count(source, ",") + if (skipped.crit2[i]) { + raw.crit2[i, ] <- NA + } else { + for (j in 1:num.raw.trials.crit2[i]) { + comma.location <- stringr::str_locate(source, ",")[1] + raw.crit2[i, j] <- stringr::str_sub(source, 1, comma.location - 1) + source <- stringr::str_sub(source, comma.location + 1, stringr::str_length(source)) } } } ## ADD leading zeros on non-empty cells. Do for non-empty cells only. - #prac1 - for (i in 1:nrow(raw.prac1)){ - for (j in 1:ncol(raw.prac1)){ - if (!is.na(raw.prac1[i,j])) {raw.prac1[i,j] <- add.leading.zeros(raw.prac1[i,j])} + # prac1 + for (i in 1:nrow(raw.prac1)) { + for (j in 1:ncol(raw.prac1)) { + if (!is.na(raw.prac1[i, j])) { + raw.prac1[i, j] <- add.leading.zeros(raw.prac1[i, j]) + } } } - #crit1 - for (i in 1:nrow(raw.crit1)){ - for (j in 1:ncol(raw.crit1)){ - if (!is.na(raw.crit1[i,j])) {raw.crit1[i,j] <- add.leading.zeros(raw.crit1[i,j])} + # crit1 + for (i in 1:nrow(raw.crit1)) { + for (j in 1:ncol(raw.crit1)) { + if (!is.na(raw.crit1[i, j])) { + raw.crit1[i, j] <- add.leading.zeros(raw.crit1[i, j]) + } } } - #prac2 - for (i in 1:nrow(raw.prac2)){ - for (j in 1:ncol(raw.prac2)){ - if (!is.na(raw.prac2[i,j])) {raw.prac2[i,j] <- add.leading.zeros(raw.prac2[i,j])} + # prac2 + for (i in 1:nrow(raw.prac2)) { + for (j in 1:ncol(raw.prac2)) { + if (!is.na(raw.prac2[i, j])) { + raw.prac2[i, j] <- add.leading.zeros(raw.prac2[i, j]) + } } } - #crit2 - for (i in 1:nrow(raw.crit2)){ - for (j in 1:ncol(raw.crit2)){ - if (!is.na(raw.crit2[i,j])) {raw.crit2[i,j] <- add.leading.zeros(raw.crit2[i,j])} + # crit2 + for (i in 1:nrow(raw.crit2)) { + for (j in 1:ncol(raw.crit2)) { + if (!is.na(raw.crit2[i, j])) { + raw.crit2[i, j] <- add.leading.zeros(raw.crit2[i, j]) + } } } @@ -315,235 +353,240 @@ cleanIAT <- function(prac1, crit1, prac2, crit2, timeout.drop=TRUE, timeout.ms=1 temp.crit1 <- median(num.raw.trials.crit1[num.raw.trials.crit1 != 0]) temp.prac2 <- median(num.raw.trials.prac2[num.raw.trials.prac2 != 0]) temp.crit2 <- median(num.raw.trials.crit2[num.raw.trials.crit2 != 0]) - raw.prac1 <- raw.prac1[,1:temp.prac1] - raw.crit1 <- raw.crit1[,1:temp.crit1] - raw.prac2 <- raw.prac2[,1:temp.prac2] - raw.crit2 <- raw.crit2[,1:temp.crit2] + raw.prac1 <- raw.prac1[, 1:temp.prac1] + raw.crit1 <- raw.crit1[, 1:temp.crit1] + raw.prac2 <- raw.prac2[, 1:temp.prac2] + raw.crit2 <- raw.crit2[, 1:temp.crit2] num.raw.trials.prac1[num.raw.trials.prac1 > temp.prac1] <- temp.prac1 num.raw.trials.crit1[num.raw.trials.crit1 > temp.crit1] <- temp.crit1 num.raw.trials.prac2[num.raw.trials.prac2 > temp.prac2] <- temp.prac2 num.raw.trials.crit2[num.raw.trials.crit2 > temp.crit2] <- temp.crit2 - rm(temp.crit1); rm(temp.crit2); rm(temp.prac1); rm(temp.prac2) + rm(temp.crit1) + rm(temp.crit2) + rm(temp.prac1) + rm(temp.prac2) ## SAVE stimuli numbers as a data frame. NA handled naturally. - #prac1 + # prac1 raw.stim.number.prac1 <- raw.prac1 - for (i in 1:nrow(raw.stim.number.prac1)){ - for (j in 1:ncol(raw.stim.number.prac1)){ - raw.stim.number.prac1[i,j] <- as.numeric(stringr::str_sub(raw.stim.number.prac1[i,j], 1, 2)) + for (i in 1:nrow(raw.stim.number.prac1)) { + for (j in 1:ncol(raw.stim.number.prac1)) { + raw.stim.number.prac1[i, j] <- as.numeric(stringr::str_sub(raw.stim.number.prac1[i, j], 1, 2)) } - } #not returning numeric -- this fixes it - for (j in 1:ncol(raw.stim.number.prac1)){ - raw.stim.number.prac1[,j] <- as.numeric(raw.stim.number.prac1[,j]) + } # not returning numeric -- this fixes it + for (j in 1:ncol(raw.stim.number.prac1)) { + raw.stim.number.prac1[, j] <- as.numeric(raw.stim.number.prac1[, j]) } - #crit1 + # crit1 raw.stim.number.crit1 <- raw.crit1 - for (i in 1:nrow(raw.stim.number.crit1)){ - for (j in 1:ncol(raw.stim.number.crit1)){ - raw.stim.number.crit1[i,j] <- as.numeric(stringr::str_sub(raw.stim.number.crit1[i,j], 1, 2)) + for (i in 1:nrow(raw.stim.number.crit1)) { + for (j in 1:ncol(raw.stim.number.crit1)) { + raw.stim.number.crit1[i, j] <- as.numeric(stringr::str_sub(raw.stim.number.crit1[i, j], 1, 2)) } - } #not returning numeric -- this fixes it - for (j in 1:ncol(raw.stim.number.crit1)){ - raw.stim.number.crit1[,j] <- as.numeric(raw.stim.number.crit1[,j]) + } # not returning numeric -- this fixes it + for (j in 1:ncol(raw.stim.number.crit1)) { + raw.stim.number.crit1[, j] <- as.numeric(raw.stim.number.crit1[, j]) } - #prac2 + # prac2 raw.stim.number.prac2 <- raw.prac2 - for (i in 1:nrow(raw.stim.number.prac2)){ - for (j in 1:ncol(raw.stim.number.prac2)){ - raw.stim.number.prac2[i,j] <- as.numeric(stringr::str_sub(raw.stim.number.prac2[i,j], 1, 2)) + for (i in 1:nrow(raw.stim.number.prac2)) { + for (j in 1:ncol(raw.stim.number.prac2)) { + raw.stim.number.prac2[i, j] <- as.numeric(stringr::str_sub(raw.stim.number.prac2[i, j], 1, 2)) } - } #not returning numeric -- this fixes it - for (j in 1:ncol(raw.stim.number.prac2)){ - raw.stim.number.prac2[,j] <- as.numeric(raw.stim.number.prac2[,j]) + } # not returning numeric -- this fixes it + for (j in 1:ncol(raw.stim.number.prac2)) { + raw.stim.number.prac2[, j] <- as.numeric(raw.stim.number.prac2[, j]) } - #crit2 + # crit2 raw.stim.number.crit2 <- raw.crit2 - for (i in 1:nrow(raw.stim.number.crit2)){ - for (j in 1:ncol(raw.stim.number.crit2)){ - raw.stim.number.crit2[i,j] <- as.numeric(stringr::str_sub(raw.stim.number.crit2[i,j], 1, 2)) + for (i in 1:nrow(raw.stim.number.crit2)) { + for (j in 1:ncol(raw.stim.number.crit2)) { + raw.stim.number.crit2[i, j] <- as.numeric(stringr::str_sub(raw.stim.number.crit2[i, j], 1, 2)) } - } #not returning numeric -- this fixes it - for (j in 1:ncol(raw.stim.number.crit2)){ - raw.stim.number.crit2[,j] <- as.numeric(raw.stim.number.crit2[,j]) + } # not returning numeric -- this fixes it + for (j in 1:ncol(raw.stim.number.crit2)) { + raw.stim.number.crit2[, j] <- as.numeric(raw.stim.number.crit2[, j]) } ## SAVE trial status (correct v incorrect) as a data frame. NA handled naturally. - #prac1 + # prac1 raw.correct.prac1 <- raw.prac1 - for (i in 1:nrow(raw.correct.prac1)){ - for (j in 1:ncol(raw.correct.prac1)){ - raw.correct.prac1[i,j] <- stringr::str_sub(raw.correct.prac1[i,j], 3, 3) + for (i in 1:nrow(raw.correct.prac1)) { + for (j in 1:ncol(raw.correct.prac1)) { + raw.correct.prac1[i, j] <- stringr::str_sub(raw.correct.prac1[i, j], 3, 3) } } - #crit1 + # crit1 raw.correct.crit1 <- raw.crit1 - for (i in 1:nrow(raw.correct.crit1)){ - for (j in 1:ncol(raw.correct.crit1)){ - raw.correct.crit1[i,j] <- stringr::str_sub(raw.correct.crit1[i,j], 3, 3) + for (i in 1:nrow(raw.correct.crit1)) { + for (j in 1:ncol(raw.correct.crit1)) { + raw.correct.crit1[i, j] <- stringr::str_sub(raw.correct.crit1[i, j], 3, 3) } } - #prac2 + # prac2 raw.correct.prac2 <- raw.prac2 - for (i in 1:nrow(raw.correct.prac2)){ - for (j in 1:ncol(raw.correct.prac2)){ - raw.correct.prac2[i,j] <- stringr::str_sub(raw.correct.prac2[i,j], 3, 3) + for (i in 1:nrow(raw.correct.prac2)) { + for (j in 1:ncol(raw.correct.prac2)) { + raw.correct.prac2[i, j] <- stringr::str_sub(raw.correct.prac2[i, j], 3, 3) } } - #crit2 + # crit2 raw.correct.crit2 <- raw.crit2 - for (i in 1:nrow(raw.correct.crit2)){ - for (j in 1:ncol(raw.correct.crit2)){ - raw.correct.crit2[i,j] <- stringr::str_sub(raw.correct.crit2[i,j], 3, 3) + for (i in 1:nrow(raw.correct.crit2)) { + for (j in 1:ncol(raw.correct.crit2)) { + raw.correct.crit2[i, j] <- stringr::str_sub(raw.correct.crit2[i, j], 3, 3) } } ## SAVE latencies as a data frame, convert to numeric. NA handled naturally - #prac1 + # prac1 raw.latencies.prac1 <- raw.prac1 - for (i in 1:nrow(raw.latencies.prac1)){ - for (j in 1:ncol(raw.latencies.prac1)){ - end <- nchar(raw.latencies.prac1[i,j]) - raw.latencies.prac1[i,j] <- stringr::str_sub(raw.latencies.prac1[i,j], 4, end) + for (i in 1:nrow(raw.latencies.prac1)) { + for (j in 1:ncol(raw.latencies.prac1)) { + end <- nchar(raw.latencies.prac1[i, j]) + raw.latencies.prac1[i, j] <- stringr::str_sub(raw.latencies.prac1[i, j], 4, end) } } - for (j in 1:ncol(raw.latencies.prac1)){ - raw.latencies.prac1[,j] <- as.numeric(raw.latencies.prac1[,j]) + for (j in 1:ncol(raw.latencies.prac1)) { + raw.latencies.prac1[, j] <- as.numeric(raw.latencies.prac1[, j]) } - #crit1 + # crit1 raw.latencies.crit1 <- raw.crit1 - for (i in 1:nrow(raw.latencies.crit1)){ - for (j in 1:ncol(raw.latencies.crit1)){ - end <- nchar(raw.latencies.crit1[i,j]) - raw.latencies.crit1[i,j] <- stringr::str_sub(raw.latencies.crit1[i,j], 4, end) + for (i in 1:nrow(raw.latencies.crit1)) { + for (j in 1:ncol(raw.latencies.crit1)) { + end <- nchar(raw.latencies.crit1[i, j]) + raw.latencies.crit1[i, j] <- stringr::str_sub(raw.latencies.crit1[i, j], 4, end) } } - for (j in 1:ncol(raw.latencies.crit1)){ - raw.latencies.crit1[,j] <- as.numeric(raw.latencies.crit1[,j]) + for (j in 1:ncol(raw.latencies.crit1)) { + raw.latencies.crit1[, j] <- as.numeric(raw.latencies.crit1[, j]) } - #prac2 + # prac2 raw.latencies.prac2 <- raw.prac2 - for (i in 1:nrow(raw.latencies.prac2)){ - for (j in 1:ncol(raw.latencies.prac2)){ - end <- nchar(raw.latencies.prac2[i,j]) - raw.latencies.prac2[i,j] <- stringr::str_sub(raw.latencies.prac2[i,j], 4, end) + for (i in 1:nrow(raw.latencies.prac2)) { + for (j in 1:ncol(raw.latencies.prac2)) { + end <- nchar(raw.latencies.prac2[i, j]) + raw.latencies.prac2[i, j] <- stringr::str_sub(raw.latencies.prac2[i, j], 4, end) } } - for (j in 1:ncol(raw.latencies.prac2)){ - raw.latencies.prac2[,j] <- as.numeric(raw.latencies.prac2[,j]) + for (j in 1:ncol(raw.latencies.prac2)) { + raw.latencies.prac2[, j] <- as.numeric(raw.latencies.prac2[, j]) } - #crit2 + # crit2 raw.latencies.crit2 <- raw.crit2 - for (i in 1:nrow(raw.latencies.crit2)){ - for (j in 1:ncol(raw.latencies.crit2)){ - end <- nchar(raw.latencies.crit2[i,j]) - raw.latencies.crit2[i,j] <- stringr::str_sub(raw.latencies.crit2[i,j], 4, end) + for (i in 1:nrow(raw.latencies.crit2)) { + for (j in 1:ncol(raw.latencies.crit2)) { + end <- nchar(raw.latencies.crit2[i, j]) + raw.latencies.crit2[i, j] <- stringr::str_sub(raw.latencies.crit2[i, j], 4, end) } } - for (j in 1:ncol(raw.latencies.crit2)){ - raw.latencies.crit2[,j] <- as.numeric(raw.latencies.crit2[,j]) + for (j in 1:ncol(raw.latencies.crit2)) { + raw.latencies.crit2[, j] <- as.numeric(raw.latencies.crit2[, j]) } ## CREATE containers for clean versions - clean.latencies.prac1 <-raw.latencies.prac1 + clean.latencies.prac1 <- raw.latencies.prac1 clean.correct.prac1 <- raw.correct.prac1 clean.stim.number.prac1 <- raw.stim.number.prac1 - clean.latencies.crit1 <-raw.latencies.crit1 + clean.latencies.crit1 <- raw.latencies.crit1 clean.correct.crit1 <- raw.correct.crit1 clean.stim.number.crit1 <- raw.stim.number.crit1 - clean.latencies.prac2 <-raw.latencies.prac2 + clean.latencies.prac2 <- raw.latencies.prac2 clean.correct.prac2 <- raw.correct.prac2 clean.stim.number.prac2 <- raw.stim.number.prac2 - clean.latencies.crit2 <-raw.latencies.crit2 + clean.latencies.crit2 <- raw.latencies.crit2 clean.correct.crit2 <- raw.correct.crit2 clean.stim.number.crit2 <- raw.stim.number.crit2 ## DROP trials that are too long - num.timeout.removed.prac1 <- 0 #create a count of timeout responses removed - num.timeout.removed.crit1 <- 0 #create a count of timeout responses removed - num.timeout.removed.prac2 <- 0 #create a count of timeout responses removed - num.timeout.removed.crit2 <- 0 #create a count of timeout responses removed + num.timeout.removed.prac1 <- 0 # create a count of timeout responses removed + num.timeout.removed.crit1 <- 0 # create a count of timeout responses removed + num.timeout.removed.prac2 <- 0 # create a count of timeout responses removed + num.timeout.removed.crit2 <- 0 # create a count of timeout responses removed - if (timeout.drop==TRUE){ + if (timeout.drop == TRUE) { # if enabled, removes trials over 10k ms # NA handling: only performs comparison logic if not NA - #prac1 - for (i in 1:nrow(clean.latencies.prac1)){ - for (j in 1:ncol(clean.latencies.prac1)){ - if (!is.na(clean.latencies.prac1[i,j])){ - if(clean.latencies.prac1[i,j] > timeout.ms) { - clean.latencies.prac1[i,j] <- NA - clean.correct.prac1[i,j] <- NA - clean.stim.number.prac1[i,j] <- NA - num.timeout.removed.prac1 <- num.timeout.removed.prac1 + 1 #counter of total removals for sample for rate analysis + # prac1 + for (i in 1:nrow(clean.latencies.prac1)) { + for (j in 1:ncol(clean.latencies.prac1)) { + if (!is.na(clean.latencies.prac1[i, j])) { + if (clean.latencies.prac1[i, j] > timeout.ms) { + clean.latencies.prac1[i, j] <- NA + clean.correct.prac1[i, j] <- NA + clean.stim.number.prac1[i, j] <- NA + num.timeout.removed.prac1 <- num.timeout.removed.prac1 + 1 # counter of total removals for sample for rate analysis } } } } - #crit1 - for (i in 1:nrow(clean.latencies.crit1)){ - for (j in 1:ncol(clean.latencies.crit1)){ - if (!is.na(clean.latencies.crit1[i,j])){ - if(clean.latencies.crit1[i,j] > timeout.ms) { - clean.latencies.crit1[i,j] <- NA - clean.correct.crit1[i,j] <- NA - clean.stim.number.crit1[i,j] <- NA - num.timeout.removed.crit1 <- num.timeout.removed.crit1 + 1 #counter of total removals for sample for rate analysis + # crit1 + for (i in 1:nrow(clean.latencies.crit1)) { + for (j in 1:ncol(clean.latencies.crit1)) { + if (!is.na(clean.latencies.crit1[i, j])) { + if (clean.latencies.crit1[i, j] > timeout.ms) { + clean.latencies.crit1[i, j] <- NA + clean.correct.crit1[i, j] <- NA + clean.stim.number.crit1[i, j] <- NA + num.timeout.removed.crit1 <- num.timeout.removed.crit1 + 1 # counter of total removals for sample for rate analysis } } } } - #prac2 - for (i in 1:nrow(clean.latencies.prac2)){ - for (j in 1:ncol(clean.latencies.prac2)){ - if (!is.na(clean.latencies.prac2[i,j])){ - if(clean.latencies.prac2[i,j] > timeout.ms) { - clean.latencies.prac2[i,j] <- NA - clean.correct.prac2[i,j] <- NA - clean.stim.number.prac2[i,j] <- NA - num.timeout.removed.prac2 <- num.timeout.removed.prac2 + 1 #counter of total removals for sample for rate analysis + # prac2 + for (i in 1:nrow(clean.latencies.prac2)) { + for (j in 1:ncol(clean.latencies.prac2)) { + if (!is.na(clean.latencies.prac2[i, j])) { + if (clean.latencies.prac2[i, j] > timeout.ms) { + clean.latencies.prac2[i, j] <- NA + clean.correct.prac2[i, j] <- NA + clean.stim.number.prac2[i, j] <- NA + num.timeout.removed.prac2 <- num.timeout.removed.prac2 + 1 # counter of total removals for sample for rate analysis } } } } - #crit2 - for (i in 1:nrow(clean.latencies.crit2)){ - for (j in 1:ncol(clean.latencies.crit2)){ - if (!is.na(clean.latencies.crit2[i,j])){ - if(clean.latencies.crit2[i,j] > timeout.ms) { - clean.latencies.crit2[i,j] <- NA - clean.correct.crit2[i,j] <- NA - clean.stim.number.crit2[i,j] <- NA - num.timeout.removed.crit2 <- num.timeout.removed.crit2 + 1 #counter of total removals for sample for rate analysis + # crit2 + for (i in 1:nrow(clean.latencies.crit2)) { + for (j in 1:ncol(clean.latencies.crit2)) { + if (!is.na(clean.latencies.crit2[i, j])) { + if (clean.latencies.crit2[i, j] > timeout.ms) { + clean.latencies.crit2[i, j] <- NA + clean.correct.crit2[i, j] <- NA + clean.stim.number.crit2[i, j] <- NA + num.timeout.removed.crit2 <- num.timeout.removed.crit2 + 1 # counter of total removals for sample for rate analysis } } } } } - #SUM total for final reporting - num.timeout.removed <- sum(c(num.timeout.removed.prac1, num.timeout.removed.crit1, - num.timeout.removed.prac2, num.timeout.removed.crit2), na.rm=T) + # SUM total for final reporting + num.timeout.removed <- sum(c( + num.timeout.removed.prac1, num.timeout.removed.crit1, + num.timeout.removed.prac2, num.timeout.removed.crit2 + ), na.rm = T) ## DROP trials that are too short (for some algorithms) @@ -552,633 +595,686 @@ cleanIAT <- function(prac1, crit1, prac2, crit2, timeout.drop=TRUE, timeout.ms=1 num.fasttrial.removed.prac2 <- 0 num.fasttrial.removed.crit2 <- 0 - if (fasttrial.drop == T){ + if (fasttrial.drop == T) { # removes trials under a given threshold # NA handling: only performs comparison logic if not NA - #prac1 - for (i in 1:nrow(clean.latencies.prac1)){ - for (j in 1:ncol(clean.latencies.prac1)){ - if (!is.na(clean.latencies.prac1[i,j])){ - if(clean.latencies.prac1[i,j] < fasttrial.ms) { - clean.latencies.prac1[i,j] <- NA - clean.correct.prac1[i,j] <- NA - clean.stim.number.prac1[i,j] <- NA - num.fasttrial.removed.prac1 <- num.fasttrial.removed.prac1 + 1 #counter of total removals for sample for rate analysis + # prac1 + for (i in 1:nrow(clean.latencies.prac1)) { + for (j in 1:ncol(clean.latencies.prac1)) { + if (!is.na(clean.latencies.prac1[i, j])) { + if (clean.latencies.prac1[i, j] < fasttrial.ms) { + clean.latencies.prac1[i, j] <- NA + clean.correct.prac1[i, j] <- NA + clean.stim.number.prac1[i, j] <- NA + num.fasttrial.removed.prac1 <- num.fasttrial.removed.prac1 + 1 # counter of total removals for sample for rate analysis } } } } - #crit1 - for (i in 1:nrow(clean.latencies.crit1)){ - for (j in 1:ncol(clean.latencies.crit1)){ - if (!is.na(clean.latencies.crit1[i,j])){ - if(clean.latencies.crit1[i,j] < fasttrial.ms) { - clean.latencies.crit1[i,j] <- NA - clean.correct.crit1[i,j] <- NA - clean.stim.number.crit1[i,j] <- NA - num.fasttrial.removed.crit1 <- num.fasttrial.removed.crit1 + 1 #counter of total removals for sample for rate analysis + # crit1 + for (i in 1:nrow(clean.latencies.crit1)) { + for (j in 1:ncol(clean.latencies.crit1)) { + if (!is.na(clean.latencies.crit1[i, j])) { + if (clean.latencies.crit1[i, j] < fasttrial.ms) { + clean.latencies.crit1[i, j] <- NA + clean.correct.crit1[i, j] <- NA + clean.stim.number.crit1[i, j] <- NA + num.fasttrial.removed.crit1 <- num.fasttrial.removed.crit1 + 1 # counter of total removals for sample for rate analysis } } } } - #prac2 - for (i in 1:nrow(clean.latencies.prac2)){ - for (j in 1:ncol(clean.latencies.prac2)){ - if (!is.na(clean.latencies.prac2[i,j])){ - if(clean.latencies.prac2[i,j] < fasttrial.ms) { - clean.latencies.prac2[i,j] <- NA - clean.correct.prac2[i,j] <- NA - clean.stim.number.prac2[i,j] <- NA - num.fasttrial.removed.prac2 <- num.fasttrial.removed.prac2 + 1 #counter of total removals for sample for rate analysis + # prac2 + for (i in 1:nrow(clean.latencies.prac2)) { + for (j in 1:ncol(clean.latencies.prac2)) { + if (!is.na(clean.latencies.prac2[i, j])) { + if (clean.latencies.prac2[i, j] < fasttrial.ms) { + clean.latencies.prac2[i, j] <- NA + clean.correct.prac2[i, j] <- NA + clean.stim.number.prac2[i, j] <- NA + num.fasttrial.removed.prac2 <- num.fasttrial.removed.prac2 + 1 # counter of total removals for sample for rate analysis } } } } - #crit2 - for (i in 1:nrow(clean.latencies.crit2)){ - for (j in 1:ncol(clean.latencies.crit2)){ - if (!is.na(clean.latencies.crit2[i,j])){ - if(clean.latencies.crit2[i,j] < fasttrial.ms) { - clean.latencies.crit2[i,j] <- NA - clean.correct.crit2[i,j] <- NA - clean.stim.number.crit2[i,j] <- NA - num.fasttrial.removed.crit2 <- num.fasttrial.removed.crit2 + 1 #counter of total removals for sample for rate analysis + # crit2 + for (i in 1:nrow(clean.latencies.crit2)) { + for (j in 1:ncol(clean.latencies.crit2)) { + if (!is.na(clean.latencies.crit2[i, j])) { + if (clean.latencies.crit2[i, j] < fasttrial.ms) { + clean.latencies.crit2[i, j] <- NA + clean.correct.crit2[i, j] <- NA + clean.stim.number.crit2[i, j] <- NA + num.fasttrial.removed.crit2 <- num.fasttrial.removed.crit2 + 1 # counter of total removals for sample for rate analysis } } } } - } - #SUM total for final reporting - num.fasttrial.removed <- sum(c(num.fasttrial.removed.prac1, num.fasttrial.removed.crit1, - num.fasttrial.removed.prac2, num.fasttrial.removed.crit2), na.rm=T) + # SUM total for final reporting + num.fasttrial.removed <- sum(c( + num.fasttrial.removed.prac1, num.fasttrial.removed.crit1, + num.fasttrial.removed.prac2, num.fasttrial.removed.crit2 + ), na.rm = T) ## DROP PARTICIPANT IF OVERLY FAST # generate large combo dataset fastprt.trials <- cbind(clean.latencies.prac1, clean.latencies.crit1, clean.latencies.prac2, clean.latencies.crit2) - raw.latencies.combo <- cbind(raw.latencies.prac1, raw.latencies.crit1, raw.latencies.prac2, raw.latencies.crit2) #fast trials may already be dropped. This compares against raw latencies to ensure we don't keep someone because we have already dropped their fast trials. + raw.latencies.combo <- cbind(raw.latencies.prac1, raw.latencies.crit1, raw.latencies.prac2, raw.latencies.crit2) # fast trials may already be dropped. This compares against raw latencies to ensure we don't keep someone because we have already dropped their fast trials. - #also need a num.raw.trials for this dataset + # also need a num.raw.trials for this dataset num.raw.trials <- num.raw.trials.prac1 + num.raw.trials.crit1 + num.raw.trials.prac2 + num.raw.trials.crit2 - #create a counter variable for overly fast trials + # create a counter variable for overly fast trials fastprt.trials[is.na(fastprt.trials)] <- 0 # convert all NAs (e.g., for skips, dropped trials) to zeros // else comparison fails raw.latencies.combo[is.na(raw.latencies.combo)] <- 0 # convert all NAs (e.g., for skips) to zeros // else comparison fails - for (i in 1:nrow(fastprt.trials)){ - for (j in 1:ncol(fastprt.trials)){ - if(raw.latencies.combo[i,j] < fastprt.ms){fastprt.trials[i,j] = 1} else {fastprt.trials[i,j] = 0} + for (i in 1:nrow(fastprt.trials)) { + for (j in 1:ncol(fastprt.trials)) { + if (raw.latencies.combo[i, j] < fastprt.ms) { + fastprt.trials[i, j] <- 1 + } else { + fastprt.trials[i, j] <- 0 + } } } rm(raw.latencies.combo) - if (fastprt.drop == TRUE){ - number.fastprt <- rowSums(fastprt.trials, na.rm=TRUE) + if (fastprt.drop == TRUE) { + number.fastprt <- rowSums(fastprt.trials, na.rm = TRUE) drop.participant <- (number.fastprt > (num.raw.trials * fastprt.percent)) - #If we are goign to drop, drop from both practice and critical blocks - - clean.latencies.prac1[drop.participant,] <- NA - clean.latencies.crit1[drop.participant,] <- NA - clean.correct.prac1[drop.participant,] <- NA - clean.correct.crit1[drop.participant,] <- NA - clean.stim.number.prac1[drop.participant,] <- NA - clean.stim.number.crit1[drop.participant,] <- NA - clean.latencies.prac2[drop.participant,] <- NA - clean.latencies.crit2[drop.participant,] <- NA - clean.correct.prac2[drop.participant,] <- NA - clean.correct.crit2[drop.participant,] <- NA - clean.stim.number.prac2[drop.participant,] <- NA - clean.stim.number.crit2[drop.participant,] <- NA - + # If we are goign to drop, drop from both practice and critical blocks + + clean.latencies.prac1[drop.participant, ] <- NA + clean.latencies.crit1[drop.participant, ] <- NA + clean.correct.prac1[drop.participant, ] <- NA + clean.correct.crit1[drop.participant, ] <- NA + clean.stim.number.prac1[drop.participant, ] <- NA + clean.stim.number.crit1[drop.participant, ] <- NA + clean.latencies.prac2[drop.participant, ] <- NA + clean.latencies.crit2[drop.participant, ] <- NA + clean.correct.prac2[drop.participant, ] <- NA + clean.correct.crit2[drop.participant, ] <- NA + clean.stim.number.prac2[drop.participant, ] <- NA + clean.stim.number.crit2[drop.participant, ] <- NA } else { - drop.participant <- rep(FALSE,nrow(fastprt.trials)) # say we're not dropping anyone + drop.participant <- rep(FALSE, nrow(fastprt.trials)) # say we're not dropping anyone } # the above would flag anyone as dropped who simply skipped the task. Adjust. - skipped <- skipped.prac1 | skipped.crit1 | skipped.prac2 | skipped.crit2 #if any block is skipped, flag as skipped - fastprt.trials[skipped,] <- NA - if(fastprt.drop==T) {number.fastprt[skipped] <- NA} + skipped <- skipped.prac1 | skipped.crit1 | skipped.prac2 | skipped.crit2 # if any block is skipped, flag as skipped + fastprt.trials[skipped, ] <- NA + if (fastprt.drop == T) { + number.fastprt[skipped] <- NA + } drop.participant[skipped] <- NA # calculate rates of dropping - timeout.rate <- num.timeout.removed / sum(num.raw.trials.prac1, num.raw.trials.crit1, num.raw.trials.prac2, num.raw.trials.crit2, na.rm=T) - fasttrial.rate <- num.fasttrial.removed / sum(num.raw.trials.prac1, num.raw.trials.crit1, num.raw.trials.prac2, num.raw.trials.crit2, na.rm=T) - fastprt.count <- sum(drop.participant, na.rm=T) - fastprt.rate <- sum(drop.participant, na.rm=T) / sum(!skipped, na.rm=T) + timeout.rate <- num.timeout.removed / sum(num.raw.trials.prac1, num.raw.trials.crit1, num.raw.trials.prac2, num.raw.trials.crit2, na.rm = T) + fasttrial.rate <- num.fasttrial.removed / sum(num.raw.trials.prac1, num.raw.trials.crit1, num.raw.trials.prac2, num.raw.trials.crit2, na.rm = T) + fastprt.count <- sum(drop.participant, na.rm = T) + fastprt.rate <- sum(drop.participant, na.rm = T) / sum(!skipped, na.rm = T) ########## # Now that all trials / prts that needed dropping are dropped: - #1) grab SD without error penalty applied - #2) save a correct latencies files from correct index file - #3) add error penalty into incorrect trials and add into clean latencies - #4) calculate means and SDs + # 1) grab SD without error penalty applied + # 2) save a correct latencies files from correct index file + # 3) add error penalty into incorrect trials and add into clean latencies + # 4) calculate means and SDs ## this replicates order done in greenwald et al. syntax ## grab SD for all clean trials (without error penalty applied) for use in some penalty algorithms - #prac1 - num.clean.trials.prac1 <- clean.latencies.prac1 # skip handling: make NA + # prac1 + num.clean.trials.prac1 <- clean.latencies.prac1 # skip handling: make NA num.clean.trials.prac1[!is.na(num.clean.trials.prac1)] <- 1 - num.clean.trials.prac1 <- rowSums(num.clean.trials.prac1, na.rm=TRUE) + num.clean.trials.prac1 <- rowSums(num.clean.trials.prac1, na.rm = TRUE) num.clean.trials.prac1[skipped.prac1] <- NA std.nopenalty.prac1 <- numeric() - for(i in 1:nrow(clean.latencies.prac1)){ - row <- clean.latencies.prac1[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.trials.prac1[i] - std.nopenalty.prac1[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.trials.prac1[i]-1)) + for (i in 1:nrow(clean.latencies.prac1)) { + row <- clean.latencies.prac1[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.trials.prac1[i] + std.nopenalty.prac1[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.trials.prac1[i] - 1)) } - std.nopenalty.prac1[std.nopenalty.prac1==0] <- NA # anyone who has all trials cut will have a zero SD. - std.nopenalty.prac1[std.nopenalty.prac1==Inf] <- NA + std.nopenalty.prac1[std.nopenalty.prac1 == 0] <- NA # anyone who has all trials cut will have a zero SD. + std.nopenalty.prac1[std.nopenalty.prac1 == Inf] <- NA std.nopenalty.prac1[is.nan(std.nopenalty.prac1)] <- NA - #same for crit1 - num.clean.trials.crit1 <- clean.latencies.crit1 # skip handling: make NA + # same for crit1 + num.clean.trials.crit1 <- clean.latencies.crit1 # skip handling: make NA num.clean.trials.crit1[!is.na(num.clean.trials.crit1)] <- 1 - num.clean.trials.crit1 <- rowSums(num.clean.trials.crit1, na.rm=TRUE) + num.clean.trials.crit1 <- rowSums(num.clean.trials.crit1, na.rm = TRUE) num.clean.trials.crit1[skipped.crit1] <- NA std.nopenalty.crit1 <- numeric() - for(i in 1:nrow(clean.latencies.crit1)){ - row <- clean.latencies.crit1[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.trials.crit1[i] - std.nopenalty.crit1[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.trials.crit1[i]-1)) + for (i in 1:nrow(clean.latencies.crit1)) { + row <- clean.latencies.crit1[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.trials.crit1[i] + std.nopenalty.crit1[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.trials.crit1[i] - 1)) } - std.nopenalty.crit1[std.nopenalty.crit1==0] <- NA # anyone who has all trials cut will have a zero SD. - std.nopenalty.crit1[std.nopenalty.crit1==Inf] <- NA + std.nopenalty.crit1[std.nopenalty.crit1 == 0] <- NA # anyone who has all trials cut will have a zero SD. + std.nopenalty.crit1[std.nopenalty.crit1 == Inf] <- NA std.nopenalty.crit1[is.nan(std.nopenalty.crit1)] <- NA - #prac2 - num.clean.trials.prac2 <- clean.latencies.prac2 # skip handling: make NA + # prac2 + num.clean.trials.prac2 <- clean.latencies.prac2 # skip handling: make NA num.clean.trials.prac2[!is.na(num.clean.trials.prac2)] <- 1 - num.clean.trials.prac2 <- rowSums(num.clean.trials.prac2, na.rm=TRUE) + num.clean.trials.prac2 <- rowSums(num.clean.trials.prac2, na.rm = TRUE) num.clean.trials.prac2[skipped.prac2] <- NA std.nopenalty.prac2 <- numeric() - for(i in 1:nrow(clean.latencies.prac2)){ - row <- clean.latencies.prac2[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.trials.prac2[i] - std.nopenalty.prac2[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.trials.prac2[i]-1)) + for (i in 1:nrow(clean.latencies.prac2)) { + row <- clean.latencies.prac2[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.trials.prac2[i] + std.nopenalty.prac2[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.trials.prac2[i] - 1)) } - std.nopenalty.prac2[std.nopenalty.prac2==0] <- NA # anyone who has all trials cut will have a zero SD. - std.nopenalty.prac2[std.nopenalty.prac2==Inf] <- NA + std.nopenalty.prac2[std.nopenalty.prac2 == 0] <- NA # anyone who has all trials cut will have a zero SD. + std.nopenalty.prac2[std.nopenalty.prac2 == Inf] <- NA std.nopenalty.prac2[is.nan(std.nopenalty.prac2)] <- NA - #crit2 - num.clean.trials.crit2 <- clean.latencies.crit2 # skip handling: make NA + # crit2 + num.clean.trials.crit2 <- clean.latencies.crit2 # skip handling: make NA num.clean.trials.crit2[!is.na(num.clean.trials.crit2)] <- 1 - num.clean.trials.crit2 <- rowSums(num.clean.trials.crit2, na.rm=TRUE) + num.clean.trials.crit2 <- rowSums(num.clean.trials.crit2, na.rm = TRUE) num.clean.trials.crit2[skipped.crit2] <- NA std.nopenalty.crit2 <- numeric() - for(i in 1:nrow(clean.latencies.crit2)){ - row <- clean.latencies.crit2[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.trials.crit2[i] - std.nopenalty.crit2[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.trials.crit2[i]-1)) + for (i in 1:nrow(clean.latencies.crit2)) { + row <- clean.latencies.crit2[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.trials.crit2[i] + std.nopenalty.crit2[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.trials.crit2[i] - 1)) } - std.nopenalty.crit2[std.nopenalty.crit2==0] <- NA # anyone who has all trials cut will have a zero SD. - std.nopenalty.crit2[std.nopenalty.crit2==Inf] <- NA + std.nopenalty.crit2[std.nopenalty.crit2 == 0] <- NA # anyone who has all trials cut will have a zero SD. + std.nopenalty.crit2[std.nopenalty.crit2 == Inf] <- NA std.nopenalty.crit2[is.nan(std.nopenalty.crit2)] <- NA ## grab correct latencies, but ignore NA - #prac1 - clean.correct.latencies.prac1 <-clean.latencies.prac1 - for (i in 1:nrow(clean.correct.latencies.prac1)){ - for (j in 1:ncol(clean.correct.latencies.prac1)){ - if (!is.na(clean.correct.latencies.prac1[i,j])){ #cannot have NA in comparisons - if(raw.correct.prac1[i,j] == "X") {clean.correct.latencies.prac1[i,j] <- NA} + # prac1 + clean.correct.latencies.prac1 <- clean.latencies.prac1 + for (i in 1:nrow(clean.correct.latencies.prac1)) { + for (j in 1:ncol(clean.correct.latencies.prac1)) { + if (!is.na(clean.correct.latencies.prac1[i, j])) { # cannot have NA in comparisons + if (raw.correct.prac1[i, j] == "X") { + clean.correct.latencies.prac1[i, j] <- NA + } } } } - #crit1 - clean.correct.latencies.crit1 <-clean.latencies.crit1 - for (i in 1:nrow(clean.correct.latencies.crit1)){ - for (j in 1:ncol(clean.correct.latencies.crit1)){ - if (!is.na(clean.correct.latencies.crit1[i,j])){ #cannot have NA in comparisons - if(raw.correct.crit1[i,j] == "X") {clean.correct.latencies.crit1[i,j] <- NA} + # crit1 + clean.correct.latencies.crit1 <- clean.latencies.crit1 + for (i in 1:nrow(clean.correct.latencies.crit1)) { + for (j in 1:ncol(clean.correct.latencies.crit1)) { + if (!is.na(clean.correct.latencies.crit1[i, j])) { # cannot have NA in comparisons + if (raw.correct.crit1[i, j] == "X") { + clean.correct.latencies.crit1[i, j] <- NA + } } } } - #prac2 - clean.correct.latencies.prac2 <-clean.latencies.prac2 - for (i in 1:nrow(clean.correct.latencies.prac2)){ - for (j in 1:ncol(clean.correct.latencies.prac2)){ - if (!is.na(clean.correct.latencies.prac2[i,j])){ #cannot have NA in comparisons - if(raw.correct.prac2[i,j] == "X") {clean.correct.latencies.prac2[i,j] <- NA} + # prac2 + clean.correct.latencies.prac2 <- clean.latencies.prac2 + for (i in 1:nrow(clean.correct.latencies.prac2)) { + for (j in 1:ncol(clean.correct.latencies.prac2)) { + if (!is.na(clean.correct.latencies.prac2[i, j])) { # cannot have NA in comparisons + if (raw.correct.prac2[i, j] == "X") { + clean.correct.latencies.prac2[i, j] <- NA + } } } } - #crit2 - clean.correct.latencies.crit2 <-clean.latencies.crit2 - for (i in 1:nrow(clean.correct.latencies.crit2)){ - for (j in 1:ncol(clean.correct.latencies.crit2)){ - if (!is.na(clean.correct.latencies.crit2[i,j])){ #cannot have NA in comparisons - if(raw.correct.crit2[i,j] == "X") {clean.correct.latencies.crit2[i,j] <- NA} + # crit2 + clean.correct.latencies.crit2 <- clean.latencies.crit2 + for (i in 1:nrow(clean.correct.latencies.crit2)) { + for (j in 1:ncol(clean.correct.latencies.crit2)) { + if (!is.na(clean.correct.latencies.crit2[i, j])) { # cannot have NA in comparisons + if (raw.correct.crit2[i, j] == "X") { + clean.correct.latencies.crit2[i, j] <- NA + } } } } ## GRAB SD of pre-penalty correct responses for imposing error the 2-SD error penalty - #prac1 - num.clean.correct.prac1 <- clean.correct.latencies.prac1 # skip handling: make NA + # prac1 + num.clean.correct.prac1 <- clean.correct.latencies.prac1 # skip handling: make NA num.clean.correct.prac1[!is.na(num.clean.correct.prac1)] <- 1 - num.clean.correct.prac1 <- rowSums(num.clean.correct.prac1, na.rm=TRUE) + num.clean.correct.prac1 <- rowSums(num.clean.correct.prac1, na.rm = TRUE) num.clean.correct.prac1[skipped.prac1] <- NA clean.std.correct.prac1 <- numeric() - for(i in 1:nrow(clean.correct.latencies.prac1)){ - row <- clean.correct.latencies.prac1[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.correct.prac1[i] - clean.std.correct.prac1[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.correct.prac1[i]-1)) + for (i in 1:nrow(clean.correct.latencies.prac1)) { + row <- clean.correct.latencies.prac1[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.correct.prac1[i] + clean.std.correct.prac1[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.correct.prac1[i] - 1)) } - clean.std.correct.prac1[clean.std.correct.prac1==0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut - clean.std.correct.prac1[clean.std.correct.prac1==Inf] <- NA + clean.std.correct.prac1[clean.std.correct.prac1 == 0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut + clean.std.correct.prac1[clean.std.correct.prac1 == Inf] <- NA clean.std.correct.prac1[is.nan(clean.std.correct.prac1)] <- NA - #crit1 - num.clean.correct.crit1 <- clean.correct.latencies.crit1 # skip handling: make NA + # crit1 + num.clean.correct.crit1 <- clean.correct.latencies.crit1 # skip handling: make NA num.clean.correct.crit1[!is.na(num.clean.correct.crit1)] <- 1 - num.clean.correct.crit1 <- rowSums(num.clean.correct.crit1, na.rm=TRUE) + num.clean.correct.crit1 <- rowSums(num.clean.correct.crit1, na.rm = TRUE) num.clean.correct.crit1[skipped.crit1] <- NA clean.std.correct.crit1 <- numeric() - for(i in 1:nrow(clean.correct.latencies.crit1)){ - row <- clean.correct.latencies.crit1[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.correct.crit1[i] - clean.std.correct.crit1[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.correct.crit1[i]-1)) + for (i in 1:nrow(clean.correct.latencies.crit1)) { + row <- clean.correct.latencies.crit1[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.correct.crit1[i] + clean.std.correct.crit1[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.correct.crit1[i] - 1)) } - clean.std.correct.crit1[clean.std.correct.crit1==0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut - clean.std.correct.crit1[clean.std.correct.crit1==Inf] <- NA + clean.std.correct.crit1[clean.std.correct.crit1 == 0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut + clean.std.correct.crit1[clean.std.correct.crit1 == Inf] <- NA clean.std.correct.crit1[is.nan(clean.std.correct.crit1)] <- NA - #prac2 - num.clean.correct.prac2 <- clean.correct.latencies.prac2 # skip handling: make NA + # prac2 + num.clean.correct.prac2 <- clean.correct.latencies.prac2 # skip handling: make NA num.clean.correct.prac2[!is.na(num.clean.correct.prac2)] <- 1 - num.clean.correct.prac2 <- rowSums(num.clean.correct.prac2, na.rm=TRUE) + num.clean.correct.prac2 <- rowSums(num.clean.correct.prac2, na.rm = TRUE) num.clean.correct.prac2[skipped.prac2] <- NA clean.std.correct.prac2 <- numeric() - for(i in 1:nrow(clean.correct.latencies.prac2)){ - row <- clean.correct.latencies.prac2[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.correct.prac2[i] - clean.std.correct.prac2[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.correct.prac2[i]-1)) + for (i in 1:nrow(clean.correct.latencies.prac2)) { + row <- clean.correct.latencies.prac2[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.correct.prac2[i] + clean.std.correct.prac2[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.correct.prac2[i] - 1)) } - clean.std.correct.prac2[clean.std.correct.prac2==0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut - clean.std.correct.prac2[clean.std.correct.prac2==Inf] <- NA + clean.std.correct.prac2[clean.std.correct.prac2 == 0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut + clean.std.correct.prac2[clean.std.correct.prac2 == Inf] <- NA clean.std.correct.prac2[is.nan(clean.std.correct.prac2)] <- NA - #crit2 - num.clean.correct.crit2 <- clean.correct.latencies.crit2 # skip handling: make NA + # crit2 + num.clean.correct.crit2 <- clean.correct.latencies.crit2 # skip handling: make NA num.clean.correct.crit2[!is.na(num.clean.correct.crit2)] <- 1 - num.clean.correct.crit2 <- rowSums(num.clean.correct.crit2, na.rm=TRUE) + num.clean.correct.crit2 <- rowSums(num.clean.correct.crit2, na.rm = TRUE) num.clean.correct.crit2[skipped.crit2] <- NA clean.std.correct.crit2 <- numeric() - for(i in 1:nrow(clean.correct.latencies.crit2)){ - row <- clean.correct.latencies.crit2[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.correct.crit2[i] - clean.std.correct.crit2[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.correct.crit2[i]-1)) + for (i in 1:nrow(clean.correct.latencies.crit2)) { + row <- clean.correct.latencies.crit2[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.correct.crit2[i] + clean.std.correct.crit2[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.correct.crit2[i] - 1)) } - clean.std.correct.crit2[clean.std.correct.crit2==0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut - clean.std.correct.crit2[clean.std.correct.crit2==Inf] <- NA + clean.std.correct.crit2[clean.std.correct.crit2 == 0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut + clean.std.correct.crit2[clean.std.correct.crit2 == Inf] <- NA clean.std.correct.crit2[is.nan(clean.std.correct.crit2)] <- NA ## grab means for correct, cleaned values and add error penalty # NA handling: only performs calculations for non-missing values # NOTE: replacing values with means and penalties may accidentally resurrect dropped trials. logic now only replaces for nonmissing values. - #prac1 - clean.correct.means.prac1 <- rowMeans(clean.correct.latencies.prac1, na.rm=TRUE) + # prac1 + clean.correct.means.prac1 <- rowMeans(clean.correct.latencies.prac1, na.rm = TRUE) clean.correct.means.prac1[is.nan(clean.correct.means.prac1)] <- NA - for (i in 1:nrow(clean.latencies.prac1)){ - for (j in 1:ncol(clean.latencies.prac1)){ - if(!is.na(raw.correct.prac1[i,j])){ - if(error.penalty==TRUE && is.numeric(error.penalty.ms)){ - if(raw.correct.prac1[i,j] == "X" && !is.na(clean.latencies.prac1[i,j])) {clean.latencies.prac1[i,j] = clean.correct.means.prac1[i] + error.penalty.ms} - } else if (error.penalty==TRUE && error.penalty.ms=="2SD"){ - if(raw.correct.prac1[i,j] == "X" && !is.na(clean.latencies.prac1[i,j])) {clean.latencies.prac1[i,j] = clean.correct.means.prac1[i] + 2*clean.std.correct.prac1[i]} - } else if (error.penalty==FALSE){ - if(raw.correct.prac1[i,j] == "X" && !is.na(clean.latencies.prac1[i,j])) {clean.latencies.prac1[i,j] = clean.latencies.prac1[i,j]} + for (i in 1:nrow(clean.latencies.prac1)) { + for (j in 1:ncol(clean.latencies.prac1)) { + if (!is.na(raw.correct.prac1[i, j])) { + if (error.penalty == TRUE && is.numeric(error.penalty.ms)) { + if (raw.correct.prac1[i, j] == "X" && !is.na(clean.latencies.prac1[i, j])) { + clean.latencies.prac1[i, j] <- clean.correct.means.prac1[i] + error.penalty.ms + } + } else if (error.penalty == TRUE && error.penalty.ms == "2SD") { + if (raw.correct.prac1[i, j] == "X" && !is.na(clean.latencies.prac1[i, j])) { + clean.latencies.prac1[i, j] <- clean.correct.means.prac1[i] + 2 * clean.std.correct.prac1[i] + } + } else if (error.penalty == FALSE) { + if (raw.correct.prac1[i, j] == "X" && !is.na(clean.latencies.prac1[i, j])) { + clean.latencies.prac1[i, j] <- clean.latencies.prac1[i, j] + } + } + if (raw.correct.prac1[i, j] == "C") { + clean.latencies.prac1[i, j] <- clean.correct.latencies.prac1[i, j] } - if(raw.correct.prac1[i,j] == "C") {clean.latencies.prac1[i,j] = clean.correct.latencies.prac1[i,j]} } - if(is.na(raw.correct.prac1[i,j])){clean.latencies.prac1[i,j] <- NA} #should already be NA because they were dropped or missing but just to be safe + if (is.na(raw.correct.prac1[i, j])) { + clean.latencies.prac1[i, j] <- NA + } # should already be NA because they were dropped or missing but just to be safe } } - #crit1 - clean.correct.means.crit1 <- rowMeans(clean.correct.latencies.crit1, na.rm=TRUE) + # crit1 + clean.correct.means.crit1 <- rowMeans(clean.correct.latencies.crit1, na.rm = TRUE) clean.correct.means.crit1[is.nan(clean.correct.means.crit1)] <- NA - for (i in 1:nrow(clean.latencies.crit1)){ - for (j in 1:ncol(clean.latencies.crit1)){ - if(!is.na(raw.correct.crit1[i,j])){ - if(error.penalty==TRUE && is.numeric(error.penalty.ms)){ - if(raw.correct.crit1[i,j] == "X" && !is.na(clean.latencies.crit1[i,j])) {clean.latencies.crit1[i,j] = clean.correct.means.crit1[i] + error.penalty.ms} - } else if (error.penalty==TRUE && error.penalty.ms=="2SD"){ - if(raw.correct.crit1[i,j] == "X" && !is.na(clean.latencies.crit1[i,j])) {clean.latencies.crit1[i,j] = clean.correct.means.crit1[i] + 2*clean.std.correct.crit1[i]} - } else if (error.penalty==FALSE){ - if(raw.correct.crit1[i,j] == "X" && !is.na(clean.latencies.crit1[i,j])) {clean.latencies.crit1[i,j] = clean.latencies.crit1[i,j]} + for (i in 1:nrow(clean.latencies.crit1)) { + for (j in 1:ncol(clean.latencies.crit1)) { + if (!is.na(raw.correct.crit1[i, j])) { + if (error.penalty == TRUE && is.numeric(error.penalty.ms)) { + if (raw.correct.crit1[i, j] == "X" && !is.na(clean.latencies.crit1[i, j])) { + clean.latencies.crit1[i, j] <- clean.correct.means.crit1[i] + error.penalty.ms + } + } else if (error.penalty == TRUE && error.penalty.ms == "2SD") { + if (raw.correct.crit1[i, j] == "X" && !is.na(clean.latencies.crit1[i, j])) { + clean.latencies.crit1[i, j] <- clean.correct.means.crit1[i] + 2 * clean.std.correct.crit1[i] + } + } else if (error.penalty == FALSE) { + if (raw.correct.crit1[i, j] == "X" && !is.na(clean.latencies.crit1[i, j])) { + clean.latencies.crit1[i, j] <- clean.latencies.crit1[i, j] + } + } + if (raw.correct.crit1[i, j] == "C") { + clean.latencies.crit1[i, j] <- clean.correct.latencies.crit1[i, j] } - if(raw.correct.crit1[i,j] == "C") {clean.latencies.crit1[i,j] = clean.correct.latencies.crit1[i,j]} } - if(is.na(raw.correct.crit1[i,j])){clean.latencies.crit1[i,j] <- NA} #should already be NA because they were dropped or missing but just to be safe + if (is.na(raw.correct.crit1[i, j])) { + clean.latencies.crit1[i, j] <- NA + } # should already be NA because they were dropped or missing but just to be safe } } - #prac2 - clean.correct.means.prac2 <- rowMeans(clean.correct.latencies.prac2, na.rm=TRUE) + # prac2 + clean.correct.means.prac2 <- rowMeans(clean.correct.latencies.prac2, na.rm = TRUE) clean.correct.means.prac2[is.nan(clean.correct.means.prac2)] <- NA - for (i in 1:nrow(clean.latencies.prac2)){ - for (j in 1:ncol(clean.latencies.prac2)){ - if(!is.na(raw.correct.prac2[i,j])){ - if(error.penalty==TRUE && is.numeric(error.penalty.ms)){ - if(raw.correct.prac2[i,j] == "X" && !is.na(clean.latencies.prac2[i,j])) {clean.latencies.prac2[i,j] = clean.correct.means.prac2[i] + error.penalty.ms} - } else if (error.penalty==TRUE && error.penalty.ms=="2SD"){ - if(raw.correct.prac2[i,j] == "X" && !is.na(clean.latencies.prac2[i,j])) {clean.latencies.prac2[i,j] = clean.correct.means.prac2[i] + 2*clean.std.correct.prac2[i]} - } else if (error.penalty==FALSE){ - if(raw.correct.prac2[i,j] == "X" && !is.na(clean.latencies.prac2[i,j])) {clean.latencies.prac2[i,j] = clean.latencies.prac2[i,j]} + for (i in 1:nrow(clean.latencies.prac2)) { + for (j in 1:ncol(clean.latencies.prac2)) { + if (!is.na(raw.correct.prac2[i, j])) { + if (error.penalty == TRUE && is.numeric(error.penalty.ms)) { + if (raw.correct.prac2[i, j] == "X" && !is.na(clean.latencies.prac2[i, j])) { + clean.latencies.prac2[i, j] <- clean.correct.means.prac2[i] + error.penalty.ms + } + } else if (error.penalty == TRUE && error.penalty.ms == "2SD") { + if (raw.correct.prac2[i, j] == "X" && !is.na(clean.latencies.prac2[i, j])) { + clean.latencies.prac2[i, j] <- clean.correct.means.prac2[i] + 2 * clean.std.correct.prac2[i] + } + } else if (error.penalty == FALSE) { + if (raw.correct.prac2[i, j] == "X" && !is.na(clean.latencies.prac2[i, j])) { + clean.latencies.prac2[i, j] <- clean.latencies.prac2[i, j] + } + } + if (raw.correct.prac2[i, j] == "C") { + clean.latencies.prac2[i, j] <- clean.correct.latencies.prac2[i, j] } - if(raw.correct.prac2[i,j] == "C") {clean.latencies.prac2[i,j] = clean.correct.latencies.prac2[i,j]} } - if(is.na(raw.correct.prac2[i,j])){clean.latencies.prac2[i,j] <- NA} #should already be NA because they were dropped or missing but just to be safe + if (is.na(raw.correct.prac2[i, j])) { + clean.latencies.prac2[i, j] <- NA + } # should already be NA because they were dropped or missing but just to be safe } } - #crit2 - clean.correct.means.crit2 <- rowMeans(clean.correct.latencies.crit2, na.rm=TRUE) + # crit2 + clean.correct.means.crit2 <- rowMeans(clean.correct.latencies.crit2, na.rm = TRUE) clean.correct.means.crit2[is.nan(clean.correct.means.crit2)] <- NA - for (i in 1:nrow(clean.latencies.crit2)){ - for (j in 1:ncol(clean.latencies.crit2)){ - if(!is.na(raw.correct.crit2[i,j])){ - if(error.penalty==TRUE && is.numeric(error.penalty.ms)){ - if(raw.correct.crit2[i,j] == "X" && !is.na(clean.latencies.crit2[i,j])) {clean.latencies.crit2[i,j] = clean.correct.means.crit2[i] + error.penalty.ms} - } else if (error.penalty==TRUE && error.penalty.ms=="2SD"){ - if(raw.correct.crit2[i,j] == "X" && !is.na(clean.latencies.crit2[i,j])) {clean.latencies.crit2[i,j] = clean.correct.means.crit2[i] + 2*clean.std.correct.crit2[i]} - } else if (error.penalty==FALSE){ - if(raw.correct.crit2[i,j] == "X" && !is.na(clean.latencies.crit2[i,j])) {clean.latencies.crit2[i,j] = clean.latencies.crit2[i,j]} + for (i in 1:nrow(clean.latencies.crit2)) { + for (j in 1:ncol(clean.latencies.crit2)) { + if (!is.na(raw.correct.crit2[i, j])) { + if (error.penalty == TRUE && is.numeric(error.penalty.ms)) { + if (raw.correct.crit2[i, j] == "X" && !is.na(clean.latencies.crit2[i, j])) { + clean.latencies.crit2[i, j] <- clean.correct.means.crit2[i] + error.penalty.ms + } + } else if (error.penalty == TRUE && error.penalty.ms == "2SD") { + if (raw.correct.crit2[i, j] == "X" && !is.na(clean.latencies.crit2[i, j])) { + clean.latencies.crit2[i, j] <- clean.correct.means.crit2[i] + 2 * clean.std.correct.crit2[i] + } + } else if (error.penalty == FALSE) { + if (raw.correct.crit2[i, j] == "X" && !is.na(clean.latencies.crit2[i, j])) { + clean.latencies.crit2[i, j] <- clean.latencies.crit2[i, j] + } + } + if (raw.correct.crit2[i, j] == "C") { + clean.latencies.crit2[i, j] <- clean.correct.latencies.crit2[i, j] } - if(raw.correct.crit2[i,j] == "C") {clean.latencies.crit2[i,j] = clean.correct.latencies.crit2[i,j]} } - if(is.na(raw.correct.crit2[i,j])){clean.latencies.crit2[i,j] <- NA} #should already be NA because they were dropped or missing but just to be safe + if (is.na(raw.correct.crit2[i, j])) { + clean.latencies.crit2[i, j] <- NA + } # should already be NA because they were dropped or missing but just to be safe } } ## saves clean blocks means - clean.means.prac1 <- rowMeans(clean.latencies.prac1, na.rm=TRUE) + clean.means.prac1 <- rowMeans(clean.latencies.prac1, na.rm = TRUE) clean.means.prac1[is.nan(clean.means.prac1)] <- NA - clean.means.crit1 <- rowMeans(clean.latencies.crit1, na.rm=TRUE) + clean.means.crit1 <- rowMeans(clean.latencies.crit1, na.rm = TRUE) clean.means.crit1[is.nan(clean.means.crit1)] <- NA - clean.means.prac2 <- rowMeans(clean.latencies.prac2, na.rm=TRUE) + clean.means.prac2 <- rowMeans(clean.latencies.prac2, na.rm = TRUE) clean.means.prac2[is.nan(clean.means.prac2)] <- NA - clean.means.crit2 <- rowMeans(clean.latencies.crit2, na.rm=TRUE) + clean.means.crit2 <- rowMeans(clean.latencies.crit2, na.rm = TRUE) clean.means.crit2[is.nan(clean.means.crit2)] <- NA ## generate inclusive SD for D score; use apply for rowSDs. Get a grand SD for psychometrics testing - inclusive.sd.prac <- apply(cbind(clean.latencies.prac1, clean.latencies.prac2), 1, sd, na.rm=T) - inclusive.sd.crit <- apply(cbind(clean.latencies.crit1, clean.latencies.crit2), 1, sd, na.rm=T) - grand.sd <- apply(cbind(clean.latencies.prac1, clean.latencies.prac2, clean.latencies.crit1, clean.latencies.crit2), 1, sd, na.rm=T) + inclusive.sd.prac <- apply(cbind(clean.latencies.prac1, clean.latencies.prac2), 1, sd, na.rm = T) + inclusive.sd.crit <- apply(cbind(clean.latencies.crit1, clean.latencies.crit2), 1, sd, na.rm = T) + grand.sd <- apply(cbind(clean.latencies.prac1, clean.latencies.prac2, clean.latencies.crit1, clean.latencies.crit2), 1, sd, na.rm = T) ## final total for calculations num.clean.trials <- num.clean.trials.prac1 + num.clean.trials.crit1 + num.clean.trials.prac2 + num.clean.trials.crit2 # save error rate on non-eliminated trials error.rate <- cbind(clean.correct.prac1, clean.correct.crit1, clean.correct.prac2, clean.correct.crit2) - error.rate[error.rate=="C"] <- 0 - error.rate[error.rate=="X"] <- 1 - for (j in 1:ncol(error.rate)){ - error.rate[,j] <- as.numeric(error.rate[,j]) + error.rate[error.rate == "C"] <- 0 + error.rate[error.rate == "X"] <- 1 + for (j in 1:ncol(error.rate)) { + error.rate[, j] <- as.numeric(error.rate[, j]) } - error.num <- rowSums(error.rate, na.rm=T) + error.num <- rowSums(error.rate, na.rm = T) error.num[skipped] <- NA # drop skips! - error.rate <- error.num/ num.clean.trials - error.rate[error.num == 0] <- 0 # make zero for people with no errors - error.num[drop.participant==TRUE] <- NA - error.rate[drop.participant==TRUE] <- NA + error.rate <- error.num / num.clean.trials + error.rate[error.num == 0] <- 0 # make zero for people with no errors + error.num[drop.participant == TRUE] <- NA + error.rate[drop.participant == TRUE] <- NA error.rate[error.rate == Inf] <- NA - #rename for use as prt variable + # rename for use as prt variable error.num.prt <- error.num error.rate.prt <- error.rate - #calcualte for whole sample - error.rate <- sum(error.num, na.rm=T) / sum(num.clean.trials, na.rm=T) + # calcualte for whole sample + error.rate <- sum(error.num, na.rm = T) / sum(num.clean.trials, na.rm = T) # save error rate on non-eliminated trials - prac1 error.rate.prac1 <- cbind(clean.correct.prac1) - error.rate.prac1[error.rate.prac1=="C"] <- 0 - error.rate.prac1[error.rate.prac1=="X"] <- 1 - for (j in 1:ncol(error.rate.prac1)){ - error.rate.prac1[,j] <- as.numeric(error.rate.prac1[,j]) + error.rate.prac1[error.rate.prac1 == "C"] <- 0 + error.rate.prac1[error.rate.prac1 == "X"] <- 1 + for (j in 1:ncol(error.rate.prac1)) { + error.rate.prac1[, j] <- as.numeric(error.rate.prac1[, j]) } - error.num.prac1 <- rowSums(error.rate.prac1, na.rm=T) + error.num.prac1 <- rowSums(error.rate.prac1, na.rm = T) error.num.prac1[skipped] <- NA # drop skips! - error.rate.prac1 <- error.num.prac1/ num.clean.trials.prac1 - error.rate.prac1[error.num.prac1 == 0] <- 0 # make zero for people with no errors - error.num.prac1[drop.participant==TRUE] <- NA - error.rate.prac1[drop.participant==TRUE] <- NA + error.rate.prac1 <- error.num.prac1 / num.clean.trials.prac1 + error.rate.prac1[error.num.prac1 == 0] <- 0 # make zero for people with no errors + error.num.prac1[drop.participant == TRUE] <- NA + error.rate.prac1[drop.participant == TRUE] <- NA error.rate.prac1[error.rate.prac1 == Inf] <- NA - error.rate.prac1 <- sum(error.num.prac1, na.rm=T) / sum(num.clean.trials.prac1, na.rm=T) + error.rate.prac1 <- sum(error.num.prac1, na.rm = T) / sum(num.clean.trials.prac1, na.rm = T) # save error rate on non-eliminated trials - crit1 error.rate.crit1 <- cbind(clean.correct.crit1) - error.rate.crit1[error.rate.crit1=="C"] <- 0 - error.rate.crit1[error.rate.crit1=="X"] <- 1 - for (j in 1:ncol(error.rate.crit1)){ - error.rate.crit1[,j] <- as.numeric(error.rate.crit1[,j]) + error.rate.crit1[error.rate.crit1 == "C"] <- 0 + error.rate.crit1[error.rate.crit1 == "X"] <- 1 + for (j in 1:ncol(error.rate.crit1)) { + error.rate.crit1[, j] <- as.numeric(error.rate.crit1[, j]) } - error.num.crit1 <- rowSums(error.rate.crit1, na.rm=T) + error.num.crit1 <- rowSums(error.rate.crit1, na.rm = T) error.num.crit1[skipped] <- NA # drop skips! - error.rate.crit1 <- error.num.crit1/ num.clean.trials.crit1 - error.rate.crit1[error.num.crit1 == 0] <- 0 # make zero for people with no errors - error.num.crit1[drop.participant==TRUE] <- NA - error.rate.crit1[drop.participant==TRUE] <- NA + error.rate.crit1 <- error.num.crit1 / num.clean.trials.crit1 + error.rate.crit1[error.num.crit1 == 0] <- 0 # make zero for people with no errors + error.num.crit1[drop.participant == TRUE] <- NA + error.rate.crit1[drop.participant == TRUE] <- NA error.rate.crit1[error.rate.crit1 == Inf] <- NA - error.rate.crit1 <- sum(error.num.crit1, na.rm=T) / sum(num.clean.trials.crit1, na.rm=T) + error.rate.crit1 <- sum(error.num.crit1, na.rm = T) / sum(num.clean.trials.crit1, na.rm = T) # save error rate on non-eliminated trials - prac2 error.rate.prac2 <- cbind(clean.correct.prac2) - error.rate.prac2[error.rate.prac2=="C"] <- 0 - error.rate.prac2[error.rate.prac2=="X"] <- 1 - for (j in 1:ncol(error.rate.prac2)){ - error.rate.prac2[,j] <- as.numeric(error.rate.prac2[,j]) + error.rate.prac2[error.rate.prac2 == "C"] <- 0 + error.rate.prac2[error.rate.prac2 == "X"] <- 1 + for (j in 1:ncol(error.rate.prac2)) { + error.rate.prac2[, j] <- as.numeric(error.rate.prac2[, j]) } - error.num.prac2 <- rowSums(error.rate.prac2, na.rm=T) + error.num.prac2 <- rowSums(error.rate.prac2, na.rm = T) error.num.prac2[skipped] <- NA # drop skips! - error.rate.prac2 <- error.num.prac2/ num.clean.trials.prac2 - error.rate.prac2[error.num.prac2 == 0] <- 0 # make zero for people with no errors - error.num.prac2[drop.participant==TRUE] <- NA - error.rate.prac2[drop.participant==TRUE] <- NA + error.rate.prac2 <- error.num.prac2 / num.clean.trials.prac2 + error.rate.prac2[error.num.prac2 == 0] <- 0 # make zero for people with no errors + error.num.prac2[drop.participant == TRUE] <- NA + error.rate.prac2[drop.participant == TRUE] <- NA error.rate.prac2[error.rate.prac2 == Inf] <- NA - error.rate.prac2 <- sum(error.num.prac2, na.rm=T) / sum(num.clean.trials.prac2, na.rm=T) + error.rate.prac2 <- sum(error.num.prac2, na.rm = T) / sum(num.clean.trials.prac2, na.rm = T) # save error rate on non-eliminated trials - crit2 error.rate.crit2 <- cbind(clean.correct.crit2) - error.rate.crit2[error.rate.crit2=="C"] <- 0 - error.rate.crit2[error.rate.crit2=="X"] <- 1 - for (j in 1:ncol(error.rate.crit2)){ - error.rate.crit2[,j] <- as.numeric(error.rate.crit2[,j]) + error.rate.crit2[error.rate.crit2 == "C"] <- 0 + error.rate.crit2[error.rate.crit2 == "X"] <- 1 + for (j in 1:ncol(error.rate.crit2)) { + error.rate.crit2[, j] <- as.numeric(error.rate.crit2[, j]) } - error.num.crit2 <- rowSums(error.rate.crit2, na.rm=T) + error.num.crit2 <- rowSums(error.rate.crit2, na.rm = T) error.num.crit2[skipped] <- NA # drop skips! - error.rate.crit2 <- error.num.crit2/ num.clean.trials.crit2 - error.rate.crit2[error.num.crit2 == 0] <- 0 # make zero for people with no errors - error.num.crit2[drop.participant==TRUE] <- NA - error.rate.crit2[drop.participant==TRUE] <- NA + error.rate.crit2 <- error.num.crit2 / num.clean.trials.crit2 + error.rate.crit2[error.num.crit2 == 0] <- 0 # make zero for people with no errors + error.num.crit2[drop.participant == TRUE] <- NA + error.rate.crit2[drop.participant == TRUE] <- NA error.rate.crit2[error.rate.crit2 == Inf] <- NA - error.rate.crit2 <- sum(error.num.crit2, na.rm=T) / sum(num.clean.trials.crit2, na.rm=T) + error.rate.crit2 <- sum(error.num.crit2, na.rm = T) / sum(num.clean.trials.crit2, na.rm = T) ## Dscore - diff.prac <- clean.means.prac2-clean.means.prac1 - diff.crit <- clean.means.crit2-clean.means.crit1 + diff.prac <- clean.means.prac2 - clean.means.prac1 + diff.crit <- clean.means.crit2 - clean.means.crit1 D.prac <- diff.prac / inclusive.sd.prac D.crit <- diff.crit / inclusive.sd.crit D <- (D.prac + D.crit) / 2 #### FOR TESTING ONLY--DO NOT USE IN ACTUAL ANALYSEES ### - if(inclusive.sd==FALSE){ - + if (inclusive.sd == FALSE) { ## generate within-block SDs for pooling based on final clean data - #prac1 - num.clean.trials.prac1 <- clean.latencies.prac1 # skip handling: make NA + # prac1 + num.clean.trials.prac1 <- clean.latencies.prac1 # skip handling: make NA num.clean.trials.prac1[!is.na(num.clean.trials.prac1)] <- 1 - num.clean.trials.prac1 <- rowSums(num.clean.trials.prac1, na.rm=TRUE) + num.clean.trials.prac1 <- rowSums(num.clean.trials.prac1, na.rm = TRUE) num.clean.trials.prac1[skipped.prac1] <- NA clean.std.prac1 <- numeric() - for(i in 1:nrow(clean.latencies.prac1)){ - row <- clean.latencies.prac1[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.trials.prac1[i] - clean.std.prac1[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.trials.prac1[i]-1)) + for (i in 1:nrow(clean.latencies.prac1)) { + row <- clean.latencies.prac1[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.trials.prac1[i] + clean.std.prac1[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.trials.prac1[i] - 1)) } - clean.std.prac1[clean.std.prac1==0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut - clean.std.prac1[clean.std.prac1==Inf] <- NA + clean.std.prac1[clean.std.prac1 == 0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut + clean.std.prac1[clean.std.prac1 == Inf] <- NA clean.std.prac1[is.nan(clean.std.prac1)] <- NA - #crit1 - num.clean.trials.crit1 <- clean.latencies.crit1 # skip handling: make NA + # crit1 + num.clean.trials.crit1 <- clean.latencies.crit1 # skip handling: make NA num.clean.trials.crit1[!is.na(num.clean.trials.crit1)] <- 1 - num.clean.trials.crit1 <- rowSums(num.clean.trials.crit1, na.rm=TRUE) + num.clean.trials.crit1 <- rowSums(num.clean.trials.crit1, na.rm = TRUE) num.clean.trials.crit1[skipped.crit1] <- NA clean.std.crit1 <- numeric() - for(i in 1:nrow(clean.latencies.crit1)){ - row <- clean.latencies.crit1[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.trials.crit1[i] - clean.std.crit1[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.trials.crit1[i]-1)) + for (i in 1:nrow(clean.latencies.crit1)) { + row <- clean.latencies.crit1[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.trials.crit1[i] + clean.std.crit1[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.trials.crit1[i] - 1)) } - clean.std.crit1[clean.std.crit1==0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut - clean.std.crit1[clean.std.crit1==Inf] <- NA + clean.std.crit1[clean.std.crit1 == 0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut + clean.std.crit1[clean.std.crit1 == Inf] <- NA clean.std.crit1[is.nan(clean.std.crit1)] <- NA - #prac2 - num.clean.trials.prac2 <- clean.latencies.prac2 # skip handling: make NA + # prac2 + num.clean.trials.prac2 <- clean.latencies.prac2 # skip handling: make NA num.clean.trials.prac2[!is.na(num.clean.trials.prac2)] <- 1 - num.clean.trials.prac2 <- rowSums(num.clean.trials.prac2, na.rm=TRUE) + num.clean.trials.prac2 <- rowSums(num.clean.trials.prac2, na.rm = TRUE) num.clean.trials.prac2[skipped.prac2] <- NA clean.std.prac2 <- numeric() - for(i in 1:nrow(clean.latencies.prac2)){ - row <- clean.latencies.prac2[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.trials.prac2[i] - clean.std.prac2[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.trials.prac2[i]-1)) + for (i in 1:nrow(clean.latencies.prac2)) { + row <- clean.latencies.prac2[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.trials.prac2[i] + clean.std.prac2[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.trials.prac2[i] - 1)) } - clean.std.prac2[clean.std.prac2==0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut - clean.std.prac2[clean.std.prac2==Inf] <- NA + clean.std.prac2[clean.std.prac2 == 0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut + clean.std.prac2[clean.std.prac2 == Inf] <- NA clean.std.prac2[is.nan(clean.std.prac2)] <- NA - #crit2 - num.clean.trials.crit2 <- clean.latencies.crit2 # skip handling: make NA + # crit2 + num.clean.trials.crit2 <- clean.latencies.crit2 # skip handling: make NA num.clean.trials.crit2[!is.na(num.clean.trials.crit2)] <- 1 - num.clean.trials.crit2 <- rowSums(num.clean.trials.crit2, na.rm=TRUE) + num.clean.trials.crit2 <- rowSums(num.clean.trials.crit2, na.rm = TRUE) num.clean.trials.crit2[skipped.crit2] <- NA clean.std.crit2 <- numeric() - for(i in 1:nrow(clean.latencies.crit2)){ - row <- clean.latencies.crit2[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.trials.crit2[i] - clean.std.crit2[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.trials.crit2[i]-1)) + for (i in 1:nrow(clean.latencies.crit2)) { + row <- clean.latencies.crit2[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.trials.crit2[i] + clean.std.crit2[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.trials.crit2[i] - 1)) } - clean.std.crit2[clean.std.crit2==0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut - clean.std.crit2[clean.std.crit2==Inf] <- NA + clean.std.crit2[clean.std.crit2 == 0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut + clean.std.crit2[clean.std.crit2 == Inf] <- NA clean.std.crit2[is.nan(clean.std.crit2)] <- NA - pool.sd.prac <- sqrt((clean.std.prac1^2 * (num.clean.trials.prac1-1) + clean.std.prac2^2 * (num.clean.trials.prac2-1)) / (num.clean.trials.prac1-1 + num.clean.trials.prac2-1)) - pool.sd.crit <- sqrt((clean.std.crit1^2 * (num.clean.trials.crit1-1) + clean.std.crit2^2 * (num.clean.trials.crit2-1)) / (num.clean.trials.crit1-1 + num.clean.trials.crit2-1)) + pool.sd.prac <- sqrt((clean.std.prac1^2 * (num.clean.trials.prac1 - 1) + clean.std.prac2^2 * (num.clean.trials.prac2 - 1)) / (num.clean.trials.prac1 - 1 + num.clean.trials.prac2 - 1)) + pool.sd.crit <- sqrt((clean.std.crit1^2 * (num.clean.trials.crit1 - 1) + clean.std.crit2^2 * (num.clean.trials.crit2 - 1)) / (num.clean.trials.crit1 - 1 + num.clean.trials.crit2 - 1)) D.prac <- diff.prac / pool.sd.prac D.crit <- diff.crit / pool.sd.crit D <- (D.prac + D.crit) / 2 } return(list( - skipped=skipped, - raw.latencies.prac1=raw.latencies.prac1, - raw.latencies.crit1=raw.latencies.crit1, - raw.latencies.prac2=raw.latencies.prac2, - raw.latencies.crit2=raw.latencies.crit2, - raw.stim.number.prac1=raw.stim.number.prac1, - raw.stim.number.crit1=raw.stim.number.crit1, - raw.stim.number.prac2=raw.stim.number.prac2, - raw.stim.number.crit2=raw.stim.number.crit2, - raw.correct.prac1=raw.correct.prac1, - raw.correct.crit1=raw.correct.crit1, - raw.correct.prac2=raw.correct.prac2, - raw.correct.crit2=raw.correct.crit2, - timeout.drop=timeout.drop, - timeout.ms=timeout.ms, - num.timeout.removed=num.timeout.removed, - timeout.rate=timeout.rate, - num.timeout.removed.prac1=num.timeout.removed.prac1, - num.timeout.removed.crit1=num.timeout.removed.crit1, - num.timeout.removed.prac2=num.timeout.removed.prac2, - num.timeout.removed.crit2=num.timeout.removed.crit2, - fasttrial.drop=fasttrial.drop, - fasttrial.ms=fasttrial.ms, - num.fasttrial.removed=num.fasttrial.removed, - fasttrial.rate=fasttrial.rate, - num.fasttrial.removed.prac1=num.fasttrial.removed.prac1, - num.fasttrial.removed.crit1=num.fasttrial.removed.crit1, - num.fasttrial.removed.prac2=num.fasttrial.removed.prac2, - num.fasttrial.removed.crit2=num.fasttrial.removed.crit2, - fastprt.drop=fastprt.drop, - fastprt.ms=fastprt.ms, - fastprt.percent=fastprt.percent, - drop.participant=drop.participant, - fastprt.count=fastprt.count, - fastprt.rate=fastprt.rate, - error.penalty=error.penalty, - error.num.prt=error.num.prt, - error.rate.prt=error.rate.prt, - error.rate=error.rate, - error.rate.prac1=error.rate.prac1, - error.rate.crit1=error.rate.crit1, - error.rate.prac2=error.rate.prac2, - error.rate.crit2=error.rate.crit2, - clean.latencies.prac1=clean.latencies.prac1, - clean.latencies.crit1=clean.latencies.crit1, - clean.latencies.prac2=clean.latencies.prac2, - clean.latencies.crit2=clean.latencies.crit2, - clean.stim.number.prac1=clean.stim.number.prac1, - clean.stim.number.crit1=clean.stim.number.crit1, - clean.stim.number.prac2=clean.stim.number.prac2, - clean.stim.number.crit2=clean.stim.number.crit2, - clean.correct.prac1=clean.correct.prac1, - clean.correct.crit1=clean.correct.crit1, - clean.correct.prac2=clean.correct.prac2, - clean.correct.crit2=clean.correct.crit2, - clean.means.prac1=clean.means.prac1, - clean.means.crit1=clean.means.crit1, - clean.means.prac2=clean.means.prac2, - clean.means.crit2=clean.means.crit2, - diff.prac=diff.prac, - diff.crit=diff.crit, - inclusive.sd.prac=inclusive.sd.prac, - inclusive.sd.crit=inclusive.sd.crit, - grand.sd=grand.sd, - D.prac=D.prac, - D.crit=D.crit, - D=D + skipped = skipped, + raw.latencies.prac1 = raw.latencies.prac1, + raw.latencies.crit1 = raw.latencies.crit1, + raw.latencies.prac2 = raw.latencies.prac2, + raw.latencies.crit2 = raw.latencies.crit2, + raw.stim.number.prac1 = raw.stim.number.prac1, + raw.stim.number.crit1 = raw.stim.number.crit1, + raw.stim.number.prac2 = raw.stim.number.prac2, + raw.stim.number.crit2 = raw.stim.number.crit2, + raw.correct.prac1 = raw.correct.prac1, + raw.correct.crit1 = raw.correct.crit1, + raw.correct.prac2 = raw.correct.prac2, + raw.correct.crit2 = raw.correct.crit2, + timeout.drop = timeout.drop, + timeout.ms = timeout.ms, + num.timeout.removed = num.timeout.removed, + timeout.rate = timeout.rate, + num.timeout.removed.prac1 = num.timeout.removed.prac1, + num.timeout.removed.crit1 = num.timeout.removed.crit1, + num.timeout.removed.prac2 = num.timeout.removed.prac2, + num.timeout.removed.crit2 = num.timeout.removed.crit2, + fasttrial.drop = fasttrial.drop, + fasttrial.ms = fasttrial.ms, + num.fasttrial.removed = num.fasttrial.removed, + fasttrial.rate = fasttrial.rate, + num.fasttrial.removed.prac1 = num.fasttrial.removed.prac1, + num.fasttrial.removed.crit1 = num.fasttrial.removed.crit1, + num.fasttrial.removed.prac2 = num.fasttrial.removed.prac2, + num.fasttrial.removed.crit2 = num.fasttrial.removed.crit2, + fastprt.drop = fastprt.drop, + fastprt.ms = fastprt.ms, + fastprt.percent = fastprt.percent, + drop.participant = drop.participant, + fastprt.count = fastprt.count, + fastprt.rate = fastprt.rate, + error.penalty = error.penalty, + error.num.prt = error.num.prt, + error.rate.prt = error.rate.prt, + error.rate = error.rate, + error.rate.prac1 = error.rate.prac1, + error.rate.crit1 = error.rate.crit1, + error.rate.prac2 = error.rate.prac2, + error.rate.crit2 = error.rate.crit2, + clean.latencies.prac1 = clean.latencies.prac1, + clean.latencies.crit1 = clean.latencies.crit1, + clean.latencies.prac2 = clean.latencies.prac2, + clean.latencies.crit2 = clean.latencies.crit2, + clean.stim.number.prac1 = clean.stim.number.prac1, + clean.stim.number.crit1 = clean.stim.number.crit1, + clean.stim.number.prac2 = clean.stim.number.prac2, + clean.stim.number.crit2 = clean.stim.number.crit2, + clean.correct.prac1 = clean.correct.prac1, + clean.correct.crit1 = clean.correct.crit1, + clean.correct.prac2 = clean.correct.prac2, + clean.correct.crit2 = clean.correct.crit2, + clean.means.prac1 = clean.means.prac1, + clean.means.crit1 = clean.means.crit1, + clean.means.prac2 = clean.means.prac2, + clean.means.crit2 = clean.means.crit2, + diff.prac = diff.prac, + diff.crit = diff.crit, + inclusive.sd.prac = inclusive.sd.prac, + inclusive.sd.crit = inclusive.sd.crit, + grand.sd = grand.sd, + D.prac = D.prac, + D.crit = D.crit, + D = D )) } diff --git a/R/cleanIAT.noprac.R b/R/cleanIAT.noprac.R index e0d575d..c7adf95 100755 --- a/R/cleanIAT.noprac.R +++ b/R/cleanIAT.noprac.R @@ -13,44 +13,52 @@ #' @param error.penalty.ms (Required if \code{error.penalty=TRUE}; set to \code{error.penalty.ms=600} by default). Following the D600 procedure, IAT errors are scored as the correct-trial block mean plus an error penalty of 600 ms. Can be manually set to any desired value. One can also use the 2SD penalty [Greenwald et al., 2003, p 214, right column] by setting \code{error.penalty.ms="2SD"}. Ignored if \code{error.penalty=FALSE}. #' @param inclusive.sd Unused parameter. #' @importFrom stats median sd +#' @importFrom stringr str_count str_length str_locate str_replace_all str_sub #' @return Returns a list containing several important elements. #' @export #' @seealso See the help for \code{cleanIAT()}. #' @examples \dontrun{ #' ### Collapse IAT critical blocks down #### #' clean <- cleanIAT.noprac(dat$compatible.crit, dat$incompatible.crit) -#'} -cleanIAT.noprac <- function(crit1, crit2, timeout.drop=TRUE, timeout.ms=10000, fasttrial.drop=FALSE, fasttrial.ms=400, fastprt.drop=TRUE, fastprt.percent=.10, fastprt.ms=300, error.penalty=FALSE, error.penalty.ms=600, inclusive.sd=TRUE) { - - if (is.null(crit1)){stop("One of your input variables does not exist. Please check your data / variable names and try again.")} - if (is.null(crit2)){stop("One of your input variables does not exist. Please check your data / variable names and try again.")} +#' } +cleanIAT.noprac <- function(crit1, crit2, timeout.drop = TRUE, timeout.ms = 10000, fasttrial.drop = FALSE, fasttrial.ms = 400, fastprt.drop = TRUE, fastprt.percent = .10, fastprt.ms = 300, error.penalty = FALSE, error.penalty.ms = 600, inclusive.sd = TRUE) { + if (is.null(crit1)) { + stop("One of your input variables does not exist. Please check your data / variable names and try again.") + } + if (is.null(crit2)) { + stop("One of your input variables does not exist. Please check your data / variable names and try again.") + } - if (all(is.na(crit1))){stop("One of your input variables is empty")} - if (all(is.na(crit2))){stop("One of your input variables is empty")} + if (all(is.na(crit1))) { + stop("One of your input variables is empty") + } + if (all(is.na(crit2))) { + stop("One of your input variables is empty") + } ## Declare local function to add leading zeros. Needed if the first two characters contain C or X add.leading.zeros <- function(temp) { - if (stringr::str_count(stringr::str_sub(temp,1,2),"C") == 1 | stringr::str_count(stringr::str_sub(temp,1,2),"X") == 1){ - temp <- paste("0", temp, sep="") + if (stringr::str_count(stringr::str_sub(temp, 1, 2), "C") == 1 | stringr::str_count(stringr::str_sub(temp, 1, 2), "X") == 1) { + temp <- paste("0", temp, sep = "") } return(temp) } - #Check for people who skipped IAT or who have nonvalid data - #Are there 3 "END" characters at end of string? If not, did not complete IAT; mark skipped - p.crit1 <- substring(crit1, (stringr::str_length(crit1)-2), stringr::str_length(crit1)) != "END" - p.crit2 <- substring(crit2, (stringr::str_length(crit2)-2), stringr::str_length(crit2)) != "END" + # Check for people who skipped IAT or who have nonvalid data + # Are there 3 "END" characters at end of string? If not, did not complete IAT; mark skipped + p.crit1 <- substring(crit1, (stringr::str_length(crit1) - 2), stringr::str_length(crit1)) != "END" + p.crit2 <- substring(crit2, (stringr::str_length(crit2) - 2), stringr::str_length(crit2)) != "END" crit1[p.crit1] <- "" crit2[p.crit2] <- "" - #mark people who skipped IAT as such + # mark people who skipped IAT as such skipped.crit1 <- crit1 == "" skipped.crit2 <- crit2 == "" - #check integrity of people who completed IAT + # check integrity of people who completed IAT p.crit1 <- (p.crit1 & !skipped.crit1) p.crit2 <- (p.crit2 & !skipped.crit2) - check.me <- function(temp){ + check.me <- function(temp) { temp <- stringr::str_replace_all(temp, "END", "") temp <- stringr::str_replace_all(temp, ",", "") temp <- stringr::str_replace_all(temp, "C", "") @@ -65,23 +73,26 @@ cleanIAT.noprac <- function(crit1, crit2, timeout.drop=TRUE, timeout.ms=10000, f temp <- stringr::str_replace_all(temp, "7", "") temp <- stringr::str_replace_all(temp, "8", "") temp <- stringr::str_replace_all(temp, "9", "") - return(!temp=="") + return(!temp == "") } p.crit1 <- as.logical(p.crit1 + check.me(crit1)) p.crit2 <- as.logical(p.crit2 + check.me(crit2)) p.prt <- as.logical(p.crit1 + p.crit2) - rm(p.crit1);rm(p.crit2) + rm(p.crit1) + rm(p.crit2) index.prt <- 1:length(p.prt) - flag<-index.prt[p.prt==TRUE]; rm(index.prt); rm(p.prt) + flag <- index.prt[p.prt == TRUE] + rm(index.prt) + rm(p.prt) crit1[flag] <- "" crit2[flag] <- "" - if(length(flag) > 0){ - for(i in 1:length(flag)){ - warning(paste("Participant ",flag[i],"'s web browser encountered an error during the survey. Their IAT data are not usable and not included in analysis.", sep="")) + if (length(flag) > 0) { + for (i in 1:length(flag)) { + warning(paste("Participant ", flag[i], "'s web browser encountered an error during the survey. Their IAT data are not usable and not included in analysis.", sep = "")) } } - #update skip counts to reflect number of validly completed IATs + # update skip counts to reflect number of validly completed IATs skipped.crit1 <- crit1 == "" skipped.crit2 <- crit2 == "" @@ -94,525 +105,562 @@ cleanIAT.noprac <- function(crit1, crit2, timeout.drop=TRUE, timeout.ms=10000, f ## POPULATE data frames. Make all NA if task skipped. - #crit1 - for(i in 1:length(crit1)){ + # crit1 + for (i in 1:length(crit1)) { source <- toString(crit1[i]) - num.raw.trials.crit1[i] <- stringr::str_count(source,",") - if (skipped.crit1[i]) {raw.crit1[i,] <- NA} else { - for(j in 1:num.raw.trials.crit1[i]) { - comma.location <- stringr::str_locate(source,",")[1] - raw.crit1[i,j] <- stringr::str_sub(source, 1, comma.location - 1) - source <- stringr::str_sub(source, comma.location+1, stringr::str_length(source)) + num.raw.trials.crit1[i] <- stringr::str_count(source, ",") + if (skipped.crit1[i]) { + raw.crit1[i, ] <- NA + } else { + for (j in 1:num.raw.trials.crit1[i]) { + comma.location <- stringr::str_locate(source, ",")[1] + raw.crit1[i, j] <- stringr::str_sub(source, 1, comma.location - 1) + source <- stringr::str_sub(source, comma.location + 1, stringr::str_length(source)) } } } - #crit2 - for(i in 1:length(crit2)){ + # crit2 + for (i in 1:length(crit2)) { source <- toString(crit2[i]) - num.raw.trials.crit2[i] <- stringr::str_count(source,",") - if (skipped.crit2[i]) {raw.crit2[i,] <- NA} else { - for(j in 1:num.raw.trials.crit2[i]) { - comma.location <- stringr::str_locate(source,",")[1] - raw.crit2[i,j] <- stringr::str_sub(source, 1, comma.location - 1) - source <- stringr::str_sub(source, comma.location+1, stringr::str_length(source)) + num.raw.trials.crit2[i] <- stringr::str_count(source, ",") + if (skipped.crit2[i]) { + raw.crit2[i, ] <- NA + } else { + for (j in 1:num.raw.trials.crit2[i]) { + comma.location <- stringr::str_locate(source, ",")[1] + raw.crit2[i, j] <- stringr::str_sub(source, 1, comma.location - 1) + source <- stringr::str_sub(source, comma.location + 1, stringr::str_length(source)) } } } ## ADD leading zeros on non-empty cells. Do for non-empty cells only. - #crit1 - for (i in 1:nrow(raw.crit1)){ - for (j in 1:ncol(raw.crit1)){ - if (!is.na(raw.crit1[i,j])) {raw.crit1[i,j] <- add.leading.zeros(raw.crit1[i,j])} + # crit1 + for (i in 1:nrow(raw.crit1)) { + for (j in 1:ncol(raw.crit1)) { + if (!is.na(raw.crit1[i, j])) { + raw.crit1[i, j] <- add.leading.zeros(raw.crit1[i, j]) + } } } - #crit2 - for (i in 1:nrow(raw.crit2)){ - for (j in 1:ncol(raw.crit2)){ - if (!is.na(raw.crit2[i,j])) {raw.crit2[i,j] <- add.leading.zeros(raw.crit2[i,j])} + # crit2 + for (i in 1:nrow(raw.crit2)) { + for (j in 1:ncol(raw.crit2)) { + if (!is.na(raw.crit2[i, j])) { + raw.crit2[i, j] <- add.leading.zeros(raw.crit2[i, j]) + } } } temp.crit1 <- median(num.raw.trials.crit1[num.raw.trials.crit1 != 0]) temp.crit2 <- median(num.raw.trials.crit2[num.raw.trials.crit2 != 0]) - raw.crit1 <- raw.crit1[,1:temp.crit1] - raw.crit2 <- raw.crit2[,1:temp.crit2] + raw.crit1 <- raw.crit1[, 1:temp.crit1] + raw.crit2 <- raw.crit2[, 1:temp.crit2] num.raw.trials.crit1[num.raw.trials.crit1 > temp.crit1] <- temp.crit1 num.raw.trials.crit2[num.raw.trials.crit2 > temp.crit2] <- temp.crit2 - rm(temp.crit1); rm(temp.crit2) + rm(temp.crit1) + rm(temp.crit2) ## SAVE stimuli numbers as a data frame. NA handled naturally. - #crit1 + # crit1 raw.stim.number.crit1 <- raw.crit1 - for (i in 1:nrow(raw.stim.number.crit1)){ - for (j in 1:ncol(raw.stim.number.crit1)){ - raw.stim.number.crit1[i,j] <- as.numeric(stringr::str_sub(raw.stim.number.crit1[i,j], 1, 2)) + for (i in 1:nrow(raw.stim.number.crit1)) { + for (j in 1:ncol(raw.stim.number.crit1)) { + raw.stim.number.crit1[i, j] <- as.numeric(stringr::str_sub(raw.stim.number.crit1[i, j], 1, 2)) } - } #not returning numeric -- this fixes it - for (j in 1:ncol(raw.stim.number.crit1)){ - raw.stim.number.crit1[,j] <- as.numeric(raw.stim.number.crit1[,j]) + } # not returning numeric -- this fixes it + for (j in 1:ncol(raw.stim.number.crit1)) { + raw.stim.number.crit1[, j] <- as.numeric(raw.stim.number.crit1[, j]) } - #crit2 + # crit2 raw.stim.number.crit2 <- raw.crit2 - for (i in 1:nrow(raw.stim.number.crit2)){ - for (j in 1:ncol(raw.stim.number.crit2)){ - raw.stim.number.crit2[i,j] <- as.numeric(stringr::str_sub(raw.stim.number.crit2[i,j], 1, 2)) + for (i in 1:nrow(raw.stim.number.crit2)) { + for (j in 1:ncol(raw.stim.number.crit2)) { + raw.stim.number.crit2[i, j] <- as.numeric(stringr::str_sub(raw.stim.number.crit2[i, j], 1, 2)) } - } #not returning numeric -- this fixes it - for (j in 1:ncol(raw.stim.number.crit2)){ - raw.stim.number.crit2[,j] <- as.numeric(raw.stim.number.crit2[,j]) + } # not returning numeric -- this fixes it + for (j in 1:ncol(raw.stim.number.crit2)) { + raw.stim.number.crit2[, j] <- as.numeric(raw.stim.number.crit2[, j]) } ## SAVE trial status (correct v incorrect) as a data frame. NA handled naturally. - #crit1 + # crit1 raw.correct.crit1 <- raw.crit1 - for (i in 1:nrow(raw.correct.crit1)){ - for (j in 1:ncol(raw.correct.crit1)){ - raw.correct.crit1[i,j] <- stringr::str_sub(raw.correct.crit1[i,j], 3, 3) + for (i in 1:nrow(raw.correct.crit1)) { + for (j in 1:ncol(raw.correct.crit1)) { + raw.correct.crit1[i, j] <- stringr::str_sub(raw.correct.crit1[i, j], 3, 3) } } - #crit2 + # crit2 raw.correct.crit2 <- raw.crit2 - for (i in 1:nrow(raw.correct.crit2)){ - for (j in 1:ncol(raw.correct.crit2)){ - raw.correct.crit2[i,j] <- stringr::str_sub(raw.correct.crit2[i,j], 3, 3) + for (i in 1:nrow(raw.correct.crit2)) { + for (j in 1:ncol(raw.correct.crit2)) { + raw.correct.crit2[i, j] <- stringr::str_sub(raw.correct.crit2[i, j], 3, 3) } } ## SAVE latencies as a data frame, convert to numeric. NA handled naturally - #crit1 + # crit1 raw.latencies.crit1 <- raw.crit1 - for (i in 1:nrow(raw.latencies.crit1)){ - for (j in 1:ncol(raw.latencies.crit1)){ - end <- nchar(raw.latencies.crit1[i,j]) - raw.latencies.crit1[i,j] <- stringr::str_sub(raw.latencies.crit1[i,j], 4, end) + for (i in 1:nrow(raw.latencies.crit1)) { + for (j in 1:ncol(raw.latencies.crit1)) { + end <- nchar(raw.latencies.crit1[i, j]) + raw.latencies.crit1[i, j] <- stringr::str_sub(raw.latencies.crit1[i, j], 4, end) } } - for (j in 1:ncol(raw.latencies.crit1)){ - raw.latencies.crit1[,j] <- as.numeric(raw.latencies.crit1[,j]) + for (j in 1:ncol(raw.latencies.crit1)) { + raw.latencies.crit1[, j] <- as.numeric(raw.latencies.crit1[, j]) } - #crit2 + # crit2 raw.latencies.crit2 <- raw.crit2 - for (i in 1:nrow(raw.latencies.crit2)){ - for (j in 1:ncol(raw.latencies.crit2)){ - end <- nchar(raw.latencies.crit2[i,j]) - raw.latencies.crit2[i,j] <- stringr::str_sub(raw.latencies.crit2[i,j], 4, end) + for (i in 1:nrow(raw.latencies.crit2)) { + for (j in 1:ncol(raw.latencies.crit2)) { + end <- nchar(raw.latencies.crit2[i, j]) + raw.latencies.crit2[i, j] <- stringr::str_sub(raw.latencies.crit2[i, j], 4, end) } } - for (j in 1:ncol(raw.latencies.crit2)){ - raw.latencies.crit2[,j] <- as.numeric(raw.latencies.crit2[,j]) + for (j in 1:ncol(raw.latencies.crit2)) { + raw.latencies.crit2[, j] <- as.numeric(raw.latencies.crit2[, j]) } ## CREATE containers for clean versions - clean.latencies.crit1 <-raw.latencies.crit1 + clean.latencies.crit1 <- raw.latencies.crit1 clean.correct.crit1 <- raw.correct.crit1 clean.stim.number.crit1 <- raw.stim.number.crit1 - clean.latencies.crit2 <-raw.latencies.crit2 + clean.latencies.crit2 <- raw.latencies.crit2 clean.correct.crit2 <- raw.correct.crit2 clean.stim.number.crit2 <- raw.stim.number.crit2 ## DROP trials that are too long - num.timeout.removed.crit1 <- 0 #create a count of timeout responses removed - num.timeout.removed.crit2 <- 0 #create a count of timeout responses removed + num.timeout.removed.crit1 <- 0 # create a count of timeout responses removed + num.timeout.removed.crit2 <- 0 # create a count of timeout responses removed - if (timeout.drop==TRUE){ + if (timeout.drop == TRUE) { # if enabled, removes trials over 10k ms # NA handling: only performs comparison logic if not NA - #crit1 - for (i in 1:nrow(clean.latencies.crit1)){ - for (j in 1:ncol(clean.latencies.crit1)){ - if (!is.na(clean.latencies.crit1[i,j])){ - if(clean.latencies.crit1[i,j] > timeout.ms) { - clean.latencies.crit1[i,j] <- NA - clean.correct.crit1[i,j] <- NA - clean.stim.number.crit1[i,j] <- NA - num.timeout.removed.crit1 <- num.timeout.removed.crit1 + 1 #counter of total removals for sample for rate analysis + # crit1 + for (i in 1:nrow(clean.latencies.crit1)) { + for (j in 1:ncol(clean.latencies.crit1)) { + if (!is.na(clean.latencies.crit1[i, j])) { + if (clean.latencies.crit1[i, j] > timeout.ms) { + clean.latencies.crit1[i, j] <- NA + clean.correct.crit1[i, j] <- NA + clean.stim.number.crit1[i, j] <- NA + num.timeout.removed.crit1 <- num.timeout.removed.crit1 + 1 # counter of total removals for sample for rate analysis } } } } - #crit2 - for (i in 1:nrow(clean.latencies.crit2)){ - for (j in 1:ncol(clean.latencies.crit2)){ - if (!is.na(clean.latencies.crit2[i,j])){ - if(clean.latencies.crit2[i,j] > timeout.ms) { - clean.latencies.crit2[i,j] <- NA - clean.correct.crit2[i,j] <- NA - clean.stim.number.crit2[i,j] <- NA - num.timeout.removed.crit2 <- num.timeout.removed.crit2 + 1 #counter of total removals for sample for rate analysis + # crit2 + for (i in 1:nrow(clean.latencies.crit2)) { + for (j in 1:ncol(clean.latencies.crit2)) { + if (!is.na(clean.latencies.crit2[i, j])) { + if (clean.latencies.crit2[i, j] > timeout.ms) { + clean.latencies.crit2[i, j] <- NA + clean.correct.crit2[i, j] <- NA + clean.stim.number.crit2[i, j] <- NA + num.timeout.removed.crit2 <- num.timeout.removed.crit2 + 1 # counter of total removals for sample for rate analysis } } } } } - #SUM total for final reporting - num.timeout.removed <- sum(c(num.timeout.removed.crit1, num.timeout.removed.crit2), na.rm=T) + # SUM total for final reporting + num.timeout.removed <- sum(c(num.timeout.removed.crit1, num.timeout.removed.crit2), na.rm = T) ## DROP trials that are too short (for some algorithms) num.fasttrial.removed.crit1 <- 0 num.fasttrial.removed.crit2 <- 0 - if (fasttrial.drop == T){ + if (fasttrial.drop == T) { # removes trials under a given threshold # NA handling: only performs comparison logic if not NA - #crit1 - for (i in 1:nrow(clean.latencies.crit1)){ - for (j in 1:ncol(clean.latencies.crit1)){ - if (!is.na(clean.latencies.crit1[i,j])){ - if(clean.latencies.crit1[i,j] < fasttrial.ms) { - clean.latencies.crit1[i,j] <- NA - clean.correct.crit1[i,j] <- NA - clean.stim.number.crit1[i,j] <- NA - num.fasttrial.removed.crit1 <- num.fasttrial.removed.crit1 + 1 #counter of total removals for sample for rate analysis + # crit1 + for (i in 1:nrow(clean.latencies.crit1)) { + for (j in 1:ncol(clean.latencies.crit1)) { + if (!is.na(clean.latencies.crit1[i, j])) { + if (clean.latencies.crit1[i, j] < fasttrial.ms) { + clean.latencies.crit1[i, j] <- NA + clean.correct.crit1[i, j] <- NA + clean.stim.number.crit1[i, j] <- NA + num.fasttrial.removed.crit1 <- num.fasttrial.removed.crit1 + 1 # counter of total removals for sample for rate analysis } } } } - #crit2 - for (i in 1:nrow(clean.latencies.crit2)){ - for (j in 1:ncol(clean.latencies.crit2)){ - if (!is.na(clean.latencies.crit2[i,j])){ - if(clean.latencies.crit2[i,j] < fasttrial.ms) { - clean.latencies.crit2[i,j] <- NA - clean.correct.crit2[i,j] <- NA - clean.stim.number.crit2[i,j] <- NA - num.fasttrial.removed.crit2 <- num.fasttrial.removed.crit2 + 1 #counter of total removals for sample for rate analysis + # crit2 + for (i in 1:nrow(clean.latencies.crit2)) { + for (j in 1:ncol(clean.latencies.crit2)) { + if (!is.na(clean.latencies.crit2[i, j])) { + if (clean.latencies.crit2[i, j] < fasttrial.ms) { + clean.latencies.crit2[i, j] <- NA + clean.correct.crit2[i, j] <- NA + clean.stim.number.crit2[i, j] <- NA + num.fasttrial.removed.crit2 <- num.fasttrial.removed.crit2 + 1 # counter of total removals for sample for rate analysis } } } } - } - #SUM total for final reporting - num.fasttrial.removed <- sum(c(num.fasttrial.removed.crit1, num.fasttrial.removed.crit2), na.rm=T) + # SUM total for final reporting + num.fasttrial.removed <- sum(c(num.fasttrial.removed.crit1, num.fasttrial.removed.crit2), na.rm = T) ## DROP PARTICIPANT IF OVERLY FAST # generate large combo dataset fastprt.trials <- cbind(clean.latencies.crit1, clean.latencies.crit2) - raw.latencies.combo <- cbind(raw.latencies.crit1, raw.latencies.crit2) #fast trials may already be dropped. This compares against raw latencies to ensure we don't keep someone because we have already dropped their fast trials. + raw.latencies.combo <- cbind(raw.latencies.crit1, raw.latencies.crit2) # fast trials may already be dropped. This compares against raw latencies to ensure we don't keep someone because we have already dropped their fast trials. - #also need a num.raw.trials for this dataset + # also need a num.raw.trials for this dataset num.raw.trials <- num.raw.trials.crit1 + num.raw.trials.crit2 - #create a counter variable for overly fast trials + # create a counter variable for overly fast trials fastprt.trials[is.na(fastprt.trials)] <- 0 # convert all NAs (e.g., for skips, dropped trials) to zeros // else comparison fails raw.latencies.combo[is.na(raw.latencies.combo)] <- 0 # convert all NAs (e.g., for skips) to zeros // else comparison fails - for (i in 1:nrow(fastprt.trials)){ - for (j in 1:ncol(fastprt.trials)){ - if(raw.latencies.combo[i,j] < fastprt.ms){fastprt.trials[i,j] = 1} else {fastprt.trials[i,j] = 0} + for (i in 1:nrow(fastprt.trials)) { + for (j in 1:ncol(fastprt.trials)) { + if (raw.latencies.combo[i, j] < fastprt.ms) { + fastprt.trials[i, j] <- 1 + } else { + fastprt.trials[i, j] <- 0 + } } } rm(raw.latencies.combo) - if (fastprt.drop == TRUE){ - number.fastprt <- rowSums(fastprt.trials, na.rm=TRUE) + if (fastprt.drop == TRUE) { + number.fastprt <- rowSums(fastprt.trials, na.rm = TRUE) drop.participant <- (number.fastprt > (num.raw.trials * fastprt.percent)) - #If we are goign to drop, drop from both practice and critical blocks - - clean.latencies.crit1[drop.participant,] <- NA - clean.correct.crit1[drop.participant,] <- NA - clean.stim.number.crit1[drop.participant,] <- NA - clean.latencies.crit2[drop.participant,] <- NA - clean.correct.crit2[drop.participant,] <- NA - clean.stim.number.crit2[drop.participant,] <- NA + # If we are goign to drop, drop from both practice and critical blocks + clean.latencies.crit1[drop.participant, ] <- NA + clean.correct.crit1[drop.participant, ] <- NA + clean.stim.number.crit1[drop.participant, ] <- NA + clean.latencies.crit2[drop.participant, ] <- NA + clean.correct.crit2[drop.participant, ] <- NA + clean.stim.number.crit2[drop.participant, ] <- NA } else { - drop.participant <- rep(FALSE,nrow(fastprt.trials)) # say we're not dropping anyone + drop.participant <- rep(FALSE, nrow(fastprt.trials)) # say we're not dropping anyone } # the above would flag anyone as dropped who simply skipped the task. Adjust. - skipped <- skipped.crit1 | skipped.crit2 #if any block is skipped, flag as skipped - fastprt.trials[skipped,] <- NA - if(fastprt.drop==T) {number.fastprt[skipped] <- NA} + skipped <- skipped.crit1 | skipped.crit2 # if any block is skipped, flag as skipped + fastprt.trials[skipped, ] <- NA + if (fastprt.drop == T) { + number.fastprt[skipped] <- NA + } drop.participant[skipped] <- NA # calculate rates of dropping - timeout.rate <- num.timeout.removed / sum(num.raw.trials.crit1, num.raw.trials.crit2, na.rm=T) - fasttrial.rate <- num.fasttrial.removed / sum(num.raw.trials.crit1, num.raw.trials.crit2, na.rm=T) - fastprt.count <- sum(drop.participant, na.rm=T) - fastprt.rate <- sum(drop.participant, na.rm=T) / sum(!skipped, na.rm=T) + timeout.rate <- num.timeout.removed / sum(num.raw.trials.crit1, num.raw.trials.crit2, na.rm = T) + fasttrial.rate <- num.fasttrial.removed / sum(num.raw.trials.crit1, num.raw.trials.crit2, na.rm = T) + fastprt.count <- sum(drop.participant, na.rm = T) + fastprt.rate <- sum(drop.participant, na.rm = T) / sum(!skipped, na.rm = T) ########## # Now that all trials / prts that needed dropping are dropped: - #1) grab SD without error penalty applied - #2) save a correct latencies files from correct index file - #3) add error penalty into incorrect trials and add into clean latencies - #4) calculate means and SDs + # 1) grab SD without error penalty applied + # 2) save a correct latencies files from correct index file + # 3) add error penalty into incorrect trials and add into clean latencies + # 4) calculate means and SDs ## this replicates order done in greenwald et al. syntax ## grab SD for all clean trials (without error penalty applied) for use in some penalty algorithms - #same for crit1 - num.clean.trials.crit1 <- clean.latencies.crit1 # skip handling: make NA + # same for crit1 + num.clean.trials.crit1 <- clean.latencies.crit1 # skip handling: make NA num.clean.trials.crit1[!is.na(num.clean.trials.crit1)] <- 1 - num.clean.trials.crit1 <- rowSums(num.clean.trials.crit1, na.rm=TRUE) + num.clean.trials.crit1 <- rowSums(num.clean.trials.crit1, na.rm = TRUE) num.clean.trials.crit1[skipped.crit1] <- NA std.nopenalty.crit1 <- numeric() - for(i in 1:nrow(clean.latencies.crit1)){ - row <- clean.latencies.crit1[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.trials.crit1[i] - std.nopenalty.crit1[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.trials.crit1[i]-1)) + for (i in 1:nrow(clean.latencies.crit1)) { + row <- clean.latencies.crit1[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.trials.crit1[i] + std.nopenalty.crit1[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.trials.crit1[i] - 1)) } - std.nopenalty.crit1[std.nopenalty.crit1==0] <- NA # anyone who has all trials cut will have a zero SD. - std.nopenalty.crit1[std.nopenalty.crit1==Inf] <- NA + std.nopenalty.crit1[std.nopenalty.crit1 == 0] <- NA # anyone who has all trials cut will have a zero SD. + std.nopenalty.crit1[std.nopenalty.crit1 == Inf] <- NA std.nopenalty.crit1[is.nan(std.nopenalty.crit1)] <- NA - #crit2 - num.clean.trials.crit2 <- clean.latencies.crit2 # skip handling: make NA + # crit2 + num.clean.trials.crit2 <- clean.latencies.crit2 # skip handling: make NA num.clean.trials.crit2[!is.na(num.clean.trials.crit2)] <- 1 - num.clean.trials.crit2 <- rowSums(num.clean.trials.crit2, na.rm=TRUE) + num.clean.trials.crit2 <- rowSums(num.clean.trials.crit2, na.rm = TRUE) num.clean.trials.crit2[skipped.crit2] <- NA std.nopenalty.crit2 <- numeric() - for(i in 1:nrow(clean.latencies.crit2)){ - row <- clean.latencies.crit2[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.trials.crit2[i] - std.nopenalty.crit2[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.trials.crit2[i]-1)) + for (i in 1:nrow(clean.latencies.crit2)) { + row <- clean.latencies.crit2[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.trials.crit2[i] + std.nopenalty.crit2[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.trials.crit2[i] - 1)) } - std.nopenalty.crit2[std.nopenalty.crit2==0] <- NA # anyone who has all trials cut will have a zero SD. - std.nopenalty.crit2[std.nopenalty.crit2==Inf] <- NA + std.nopenalty.crit2[std.nopenalty.crit2 == 0] <- NA # anyone who has all trials cut will have a zero SD. + std.nopenalty.crit2[std.nopenalty.crit2 == Inf] <- NA std.nopenalty.crit2[is.nan(std.nopenalty.crit2)] <- NA ## grab correct latencies, but ignore NA - #crit1 - clean.correct.latencies.crit1 <-clean.latencies.crit1 - for (i in 1:nrow(clean.correct.latencies.crit1)){ - for (j in 1:ncol(clean.correct.latencies.crit1)){ - if (!is.na(clean.correct.latencies.crit1[i,j])){ #cannot have NA in comparisons - if(raw.correct.crit1[i,j] == "X") {clean.correct.latencies.crit1[i,j] <- NA} + # crit1 + clean.correct.latencies.crit1 <- clean.latencies.crit1 + for (i in 1:nrow(clean.correct.latencies.crit1)) { + for (j in 1:ncol(clean.correct.latencies.crit1)) { + if (!is.na(clean.correct.latencies.crit1[i, j])) { # cannot have NA in comparisons + if (raw.correct.crit1[i, j] == "X") { + clean.correct.latencies.crit1[i, j] <- NA + } } } } - #crit2 - clean.correct.latencies.crit2 <-clean.latencies.crit2 - for (i in 1:nrow(clean.correct.latencies.crit2)){ - for (j in 1:ncol(clean.correct.latencies.crit2)){ - if (!is.na(clean.correct.latencies.crit2[i,j])){ #cannot have NA in comparisons - if(raw.correct.crit2[i,j] == "X") {clean.correct.latencies.crit2[i,j] <- NA} + # crit2 + clean.correct.latencies.crit2 <- clean.latencies.crit2 + for (i in 1:nrow(clean.correct.latencies.crit2)) { + for (j in 1:ncol(clean.correct.latencies.crit2)) { + if (!is.na(clean.correct.latencies.crit2[i, j])) { # cannot have NA in comparisons + if (raw.correct.crit2[i, j] == "X") { + clean.correct.latencies.crit2[i, j] <- NA + } } } } ## GRAB SD of pre-penalty correct responses for imposing error the 2-SD error penalty - #crit1 - num.clean.correct.crit1 <- clean.correct.latencies.crit1 # skip handling: make NA + # crit1 + num.clean.correct.crit1 <- clean.correct.latencies.crit1 # skip handling: make NA num.clean.correct.crit1[!is.na(num.clean.correct.crit1)] <- 1 - num.clean.correct.crit1 <- rowSums(num.clean.correct.crit1, na.rm=TRUE) + num.clean.correct.crit1 <- rowSums(num.clean.correct.crit1, na.rm = TRUE) num.clean.correct.crit1[skipped.crit1] <- NA clean.std.correct.crit1 <- numeric() - for(i in 1:nrow(clean.correct.latencies.crit1)){ - row <- clean.correct.latencies.crit1[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.correct.crit1[i] - clean.std.correct.crit1[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.correct.crit1[i]-1)) + for (i in 1:nrow(clean.correct.latencies.crit1)) { + row <- clean.correct.latencies.crit1[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.correct.crit1[i] + clean.std.correct.crit1[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.correct.crit1[i] - 1)) } - clean.std.correct.crit1[clean.std.correct.crit1==0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut - clean.std.correct.crit1[clean.std.correct.crit1==Inf] <- NA + clean.std.correct.crit1[clean.std.correct.crit1 == 0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut + clean.std.correct.crit1[clean.std.correct.crit1 == Inf] <- NA clean.std.correct.crit1[is.nan(clean.std.correct.crit1)] <- NA - #crit2 - num.clean.correct.crit2 <- clean.correct.latencies.crit2 # skip handling: make NA + # crit2 + num.clean.correct.crit2 <- clean.correct.latencies.crit2 # skip handling: make NA num.clean.correct.crit2[!is.na(num.clean.correct.crit2)] <- 1 - num.clean.correct.crit2 <- rowSums(num.clean.correct.crit2, na.rm=TRUE) + num.clean.correct.crit2 <- rowSums(num.clean.correct.crit2, na.rm = TRUE) num.clean.correct.crit2[skipped.crit2] <- NA clean.std.correct.crit2 <- numeric() - for(i in 1:nrow(clean.correct.latencies.crit2)){ - row <- clean.correct.latencies.crit2[i,] - avg <- sum(row, na.rm=TRUE) / num.clean.correct.crit2[i] - clean.std.correct.crit2[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (num.clean.correct.crit2[i]-1)) + for (i in 1:nrow(clean.correct.latencies.crit2)) { + row <- clean.correct.latencies.crit2[i, ] + avg <- sum(row, na.rm = TRUE) / num.clean.correct.crit2[i] + clean.std.correct.crit2[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (num.clean.correct.crit2[i] - 1)) } - clean.std.correct.crit2[clean.std.correct.crit2==0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut - clean.std.correct.crit2[clean.std.correct.crit2==Inf] <- NA + clean.std.correct.crit2[clean.std.correct.crit2 == 0] <- NA # when fastprt.drop is off and fasttrial.drop is on, this may happen b/c all trials are cut + clean.std.correct.crit2[clean.std.correct.crit2 == Inf] <- NA clean.std.correct.crit2[is.nan(clean.std.correct.crit2)] <- NA ## grab means for correct, cleaned values and add error penalty # NA handling: only performs calculations for non-missing values # NOTE: replacing values with means and penalties may accidentally resurrect dropped trials. logic now only replaces for nonmissing values. - #crit1 - clean.correct.means.crit1 <- rowMeans(clean.correct.latencies.crit1, na.rm=TRUE) + # crit1 + clean.correct.means.crit1 <- rowMeans(clean.correct.latencies.crit1, na.rm = TRUE) clean.correct.means.crit1[is.nan(clean.correct.means.crit1)] <- NA - for (i in 1:nrow(clean.latencies.crit1)){ - for (j in 1:ncol(clean.latencies.crit1)){ - if(!is.na(raw.correct.crit1[i,j])){ - if(error.penalty==TRUE && is.numeric(error.penalty.ms)){ - if(raw.correct.crit1[i,j] == "X" && !is.na(clean.latencies.crit1[i,j])) {clean.latencies.crit1[i,j] = clean.correct.means.crit1[i] + error.penalty.ms} - } else if (error.penalty==TRUE && error.penalty.ms=="2SD"){ - if(raw.correct.crit1[i,j] == "X" && !is.na(clean.latencies.crit1[i,j])) {clean.latencies.crit1[i,j] = clean.correct.means.crit1[i] + 2*clean.std.correct.crit1[i]} - } else if (error.penalty==FALSE){ - if(raw.correct.crit1[i,j] == "X" && !is.na(clean.latencies.crit1[i,j])) {clean.latencies.crit1[i,j] = clean.latencies.crit1[i,j]} + for (i in 1:nrow(clean.latencies.crit1)) { + for (j in 1:ncol(clean.latencies.crit1)) { + if (!is.na(raw.correct.crit1[i, j])) { + if (error.penalty == TRUE && is.numeric(error.penalty.ms)) { + if (raw.correct.crit1[i, j] == "X" && !is.na(clean.latencies.crit1[i, j])) { + clean.latencies.crit1[i, j] <- clean.correct.means.crit1[i] + error.penalty.ms + } + } else if (error.penalty == TRUE && error.penalty.ms == "2SD") { + if (raw.correct.crit1[i, j] == "X" && !is.na(clean.latencies.crit1[i, j])) { + clean.latencies.crit1[i, j] <- clean.correct.means.crit1[i] + 2 * clean.std.correct.crit1[i] + } + } else if (error.penalty == FALSE) { + if (raw.correct.crit1[i, j] == "X" && !is.na(clean.latencies.crit1[i, j])) { + clean.latencies.crit1[i, j] <- clean.latencies.crit1[i, j] + } + } + if (raw.correct.crit1[i, j] == "C") { + clean.latencies.crit1[i, j] <- clean.correct.latencies.crit1[i, j] } - if(raw.correct.crit1[i,j] == "C") {clean.latencies.crit1[i,j] = clean.correct.latencies.crit1[i,j]} } - if(is.na(raw.correct.crit1[i,j])){clean.latencies.crit1[i,j] <- NA} #should already be NA because they were dropped or missing but just to be safe + if (is.na(raw.correct.crit1[i, j])) { + clean.latencies.crit1[i, j] <- NA + } # should already be NA because they were dropped or missing but just to be safe } } - #crit2 - clean.correct.means.crit2 <- rowMeans(clean.correct.latencies.crit2, na.rm=TRUE) + # crit2 + clean.correct.means.crit2 <- rowMeans(clean.correct.latencies.crit2, na.rm = TRUE) clean.correct.means.crit2[is.nan(clean.correct.means.crit2)] <- NA - for (i in 1:nrow(clean.latencies.crit2)){ - for (j in 1:ncol(clean.latencies.crit2)){ - if(!is.na(raw.correct.crit2[i,j])){ - if(error.penalty==TRUE && is.numeric(error.penalty.ms)){ - if(raw.correct.crit2[i,j] == "X" && !is.na(clean.latencies.crit2[i,j])) {clean.latencies.crit2[i,j] = clean.correct.means.crit2[i] + error.penalty.ms} - } else if (error.penalty==TRUE && error.penalty.ms=="2SD"){ - if(raw.correct.crit2[i,j] == "X" && !is.na(clean.latencies.crit2[i,j])) {clean.latencies.crit2[i,j] = clean.correct.means.crit2[i] + 2*clean.std.correct.crit2[i]} - } else if (error.penalty==FALSE){ - if(raw.correct.crit2[i,j] == "X" && !is.na(clean.latencies.crit2[i,j])) {clean.latencies.crit2[i,j] = clean.latencies.crit2[i,j]} + for (i in 1:nrow(clean.latencies.crit2)) { + for (j in 1:ncol(clean.latencies.crit2)) { + if (!is.na(raw.correct.crit2[i, j])) { + if (error.penalty == TRUE && is.numeric(error.penalty.ms)) { + if (raw.correct.crit2[i, j] == "X" && !is.na(clean.latencies.crit2[i, j])) { + clean.latencies.crit2[i, j] <- clean.correct.means.crit2[i] + error.penalty.ms + } + } else if (error.penalty == TRUE && error.penalty.ms == "2SD") { + if (raw.correct.crit2[i, j] == "X" && !is.na(clean.latencies.crit2[i, j])) { + clean.latencies.crit2[i, j] <- clean.correct.means.crit2[i] + 2 * clean.std.correct.crit2[i] + } + } else if (error.penalty == FALSE) { + if (raw.correct.crit2[i, j] == "X" && !is.na(clean.latencies.crit2[i, j])) { + clean.latencies.crit2[i, j] <- clean.latencies.crit2[i, j] + } + } + if (raw.correct.crit2[i, j] == "C") { + clean.latencies.crit2[i, j] <- clean.correct.latencies.crit2[i, j] } - if(raw.correct.crit2[i,j] == "C") {clean.latencies.crit2[i,j] = clean.correct.latencies.crit2[i,j]} } - if(is.na(raw.correct.crit2[i,j])){clean.latencies.crit2[i,j] <- NA} #should already be NA because they were dropped or missing but just to be safe + if (is.na(raw.correct.crit2[i, j])) { + clean.latencies.crit2[i, j] <- NA + } # should already be NA because they were dropped or missing but just to be safe } } ## saves clean blocks means - clean.means.crit1 <- rowMeans(clean.latencies.crit1, na.rm=TRUE) + clean.means.crit1 <- rowMeans(clean.latencies.crit1, na.rm = TRUE) clean.means.crit1[is.nan(clean.means.crit1)] <- NA - clean.means.crit2 <- rowMeans(clean.latencies.crit2, na.rm=TRUE) + clean.means.crit2 <- rowMeans(clean.latencies.crit2, na.rm = TRUE) clean.means.crit2[is.nan(clean.means.crit2)] <- NA ## generate inclusive SD for D score; use apply for rowSDs. Get a grand SD for psychometrics testing - inclusive.sd.crit <- apply(cbind(clean.latencies.crit1, clean.latencies.crit2), 1, sd, na.rm=T) - grand.sd <- apply(cbind(clean.latencies.crit1, clean.latencies.crit2), 1, sd, na.rm=T) + inclusive.sd.crit <- apply(cbind(clean.latencies.crit1, clean.latencies.crit2), 1, sd, na.rm = T) + grand.sd <- apply(cbind(clean.latencies.crit1, clean.latencies.crit2), 1, sd, na.rm = T) ## final total for calculations num.clean.trials <- num.clean.trials.crit1 + num.clean.trials.crit2 # save error rate on non-eliminated trials error.rate <- cbind(clean.correct.crit1, clean.correct.crit2) - error.rate[error.rate=="C"] <- 0 - error.rate[error.rate=="X"] <- 1 - for (j in 1:ncol(error.rate)){ - error.rate[,j] <- as.numeric(error.rate[,j]) + error.rate[error.rate == "C"] <- 0 + error.rate[error.rate == "X"] <- 1 + for (j in 1:ncol(error.rate)) { + error.rate[, j] <- as.numeric(error.rate[, j]) } - error.num <- rowSums(error.rate, na.rm=T) + error.num <- rowSums(error.rate, na.rm = T) error.num[skipped] <- NA # drop skips! - error.rate <- error.num/ num.clean.trials - error.rate[error.num == 0] <- 0 # make zero for people with no errors - error.num[drop.participant==TRUE] <- NA - error.rate[drop.participant==TRUE] <- NA + error.rate <- error.num / num.clean.trials + error.rate[error.num == 0] <- 0 # make zero for people with no errors + error.num[drop.participant == TRUE] <- NA + error.rate[drop.participant == TRUE] <- NA error.rate[error.rate == Inf] <- NA - #rename for use as prt variable + # rename for use as prt variable error.num.prt <- error.num error.rate.prt <- error.rate - #calcualte for whole sample - error.rate <- sum(error.num, na.rm=T) / sum(num.clean.trials, na.rm=T) + # calcualte for whole sample + error.rate <- sum(error.num, na.rm = T) / sum(num.clean.trials, na.rm = T) # save error rate on non-eliminated trials - crit1 error.rate.crit1 <- cbind(clean.correct.crit1) - error.rate.crit1[error.rate.crit1=="C"] <- 0 - error.rate.crit1[error.rate.crit1=="X"] <- 1 - for (j in 1:ncol(error.rate.crit1)){ - error.rate.crit1[,j] <- as.numeric(error.rate.crit1[,j]) + error.rate.crit1[error.rate.crit1 == "C"] <- 0 + error.rate.crit1[error.rate.crit1 == "X"] <- 1 + for (j in 1:ncol(error.rate.crit1)) { + error.rate.crit1[, j] <- as.numeric(error.rate.crit1[, j]) } - error.num.crit1 <- rowSums(error.rate.crit1, na.rm=T) + error.num.crit1 <- rowSums(error.rate.crit1, na.rm = T) error.num.crit1[skipped] <- NA # drop skips! - error.rate.crit1 <- error.num.crit1/ num.clean.trials.crit1 - error.rate.crit1[error.num.crit1 == 0] <- 0 # make zero for people with no errors - error.num.crit1[drop.participant==TRUE] <- NA - error.rate.crit1[drop.participant==TRUE] <- NA + error.rate.crit1 <- error.num.crit1 / num.clean.trials.crit1 + error.rate.crit1[error.num.crit1 == 0] <- 0 # make zero for people with no errors + error.num.crit1[drop.participant == TRUE] <- NA + error.rate.crit1[drop.participant == TRUE] <- NA error.rate.crit1[error.rate.crit1 == Inf] <- NA - error.rate.crit1 <- sum(error.num.crit1, na.rm=T) / sum(num.clean.trials.crit1, na.rm=T) + error.rate.crit1 <- sum(error.num.crit1, na.rm = T) / sum(num.clean.trials.crit1, na.rm = T) # save error rate on non-eliminated trials - crit2 error.rate.crit2 <- cbind(clean.correct.crit2) - error.rate.crit2[error.rate.crit2=="C"] <- 0 - error.rate.crit2[error.rate.crit2=="X"] <- 1 - for (j in 1:ncol(error.rate.crit2)){ - error.rate.crit2[,j] <- as.numeric(error.rate.crit2[,j]) + error.rate.crit2[error.rate.crit2 == "C"] <- 0 + error.rate.crit2[error.rate.crit2 == "X"] <- 1 + for (j in 1:ncol(error.rate.crit2)) { + error.rate.crit2[, j] <- as.numeric(error.rate.crit2[, j]) } - error.num.crit2 <- rowSums(error.rate.crit2, na.rm=T) + error.num.crit2 <- rowSums(error.rate.crit2, na.rm = T) error.num.crit2[skipped] <- NA # drop skips! - error.rate.crit2 <- error.num.crit2/ num.clean.trials.crit2 - error.rate.crit2[error.num.crit2 == 0] <- 0 # make zero for people with no errors - error.num.crit2[drop.participant==TRUE] <- NA - error.rate.crit2[drop.participant==TRUE] <- NA + error.rate.crit2 <- error.num.crit2 / num.clean.trials.crit2 + error.rate.crit2[error.num.crit2 == 0] <- 0 # make zero for people with no errors + error.num.crit2[drop.participant == TRUE] <- NA + error.rate.crit2[drop.participant == TRUE] <- NA error.rate.crit2[error.rate.crit2 == Inf] <- NA - error.rate.crit2 <- sum(error.num.crit2, na.rm=T) / sum(num.clean.trials.crit2, na.rm=T) + error.rate.crit2 <- sum(error.num.crit2, na.rm = T) / sum(num.clean.trials.crit2, na.rm = T) ## Dscore - diff.crit <- clean.means.crit2-clean.means.crit1 + diff.crit <- clean.means.crit2 - clean.means.crit1 D <- diff.crit / inclusive.sd.crit return(list( - skipped=skipped, - raw.latencies.crit1=raw.latencies.crit1, - raw.latencies.crit2=raw.latencies.crit2, - raw.stim.number.crit1=raw.stim.number.crit1, - raw.stim.number.crit2=raw.stim.number.crit2, - raw.correct.crit1=raw.correct.crit1, - raw.correct.crit2=raw.correct.crit2, - timeout.drop=timeout.drop, - timeout.ms=timeout.ms, - num.timeout.removed=num.timeout.removed, - timeout.rate=timeout.rate, - num.timeout.removed.crit1=num.timeout.removed.crit1, - num.timeout.removed.crit2=num.timeout.removed.crit2, - fasttrial.drop=fasttrial.drop, - fasttrial.ms=fasttrial.ms, - num.fasttrial.removed=num.fasttrial.removed, - fasttrial.rate=fasttrial.rate, - num.fasttrial.removed.crit1=num.fasttrial.removed.crit1, - num.fasttrial.removed.crit2=num.fasttrial.removed.crit2, - fastprt.drop=fastprt.drop, - fastprt.ms=fastprt.ms, - fastprt.percent=fastprt.percent, - drop.participant=drop.participant, - fastprt.count=fastprt.count, - fastprt.rate=fastprt.rate, - error.penalty=error.penalty, - error.num.prt=error.num.prt, - error.rate.prt=error.rate.prt, - error.rate=error.rate, - error.rate.crit1=error.rate.crit1, - error.rate.crit2=error.rate.crit2, - clean.latencies.crit1=clean.latencies.crit1, - clean.latencies.crit2=clean.latencies.crit2, - clean.stim.number.crit1=clean.stim.number.crit1, - clean.stim.number.crit2=clean.stim.number.crit2, - clean.correct.crit1=clean.correct.crit1, - clean.correct.crit2=clean.correct.crit2, - clean.means.crit1=clean.means.crit1, - clean.means.crit2=clean.means.crit2, - diff.crit=diff.crit, - inclusive.sd.crit=inclusive.sd.crit, - grand.sd=grand.sd, - D=D + skipped = skipped, + raw.latencies.crit1 = raw.latencies.crit1, + raw.latencies.crit2 = raw.latencies.crit2, + raw.stim.number.crit1 = raw.stim.number.crit1, + raw.stim.number.crit2 = raw.stim.number.crit2, + raw.correct.crit1 = raw.correct.crit1, + raw.correct.crit2 = raw.correct.crit2, + timeout.drop = timeout.drop, + timeout.ms = timeout.ms, + num.timeout.removed = num.timeout.removed, + timeout.rate = timeout.rate, + num.timeout.removed.crit1 = num.timeout.removed.crit1, + num.timeout.removed.crit2 = num.timeout.removed.crit2, + fasttrial.drop = fasttrial.drop, + fasttrial.ms = fasttrial.ms, + num.fasttrial.removed = num.fasttrial.removed, + fasttrial.rate = fasttrial.rate, + num.fasttrial.removed.crit1 = num.fasttrial.removed.crit1, + num.fasttrial.removed.crit2 = num.fasttrial.removed.crit2, + fastprt.drop = fastprt.drop, + fastprt.ms = fastprt.ms, + fastprt.percent = fastprt.percent, + drop.participant = drop.participant, + fastprt.count = fastprt.count, + fastprt.rate = fastprt.rate, + error.penalty = error.penalty, + error.num.prt = error.num.prt, + error.rate.prt = error.rate.prt, + error.rate = error.rate, + error.rate.crit1 = error.rate.crit1, + error.rate.crit2 = error.rate.crit2, + clean.latencies.crit1 = clean.latencies.crit1, + clean.latencies.crit2 = clean.latencies.crit2, + clean.stim.number.crit1 = clean.stim.number.crit1, + clean.stim.number.crit2 = clean.stim.number.crit2, + clean.correct.crit1 = clean.correct.crit1, + clean.correct.crit2 = clean.correct.crit2, + clean.means.crit1 = clean.means.crit1, + clean.means.crit2 = clean.means.crit2, + diff.crit = diff.crit, + inclusive.sd.crit = inclusive.sd.crit, + grand.sd = grand.sd, + D = D )) } diff --git a/R/combineIATfourblocks.R b/R/combineIATfourblocks.R index e17495f..fb3c15d 100644 --- a/R/combineIATfourblocks.R +++ b/R/combineIATfourblocks.R @@ -1,12 +1,10 @@ -requireNamespace("stringr") - #' Data analysis function: Collapses IAT permutations down prior to cleaning and analysis #' @description The first step after importing IAT data is collapsing the IAT data into two variables, typically labeled “compatible” and “incompatible.” Data analysis for the IAT requires comparing responses in the "compatible" blocks against performance in the "incompatible" blocks. However, the Qualtrics IAT runs four permutations of the IAT, counterbalancing left/right starting positions of both targets and categories (although research has consistently failed to find any left/right bias on the IAT; e.g., Greenwald et al., 1998; Nosek et al., 2005). As a result of these four permutations, any one block of trials (e.g., the compatible critical block) is distributed across four variables. Thus, it must be combined back together. This is done with the \code{combineIATfourblocks} function. Typically, four variables are of interest (compatible practice, incompatible practice, compatible critical, incompatible critical; see Greenwald et al., 2003; Nosek et al., 2005). Thus, we must create these four variables. The positioning of this information varies depending on the permutation. For example, if Target A starts on the right initially paired with the positive category (RP permutation), then the compatible block comes first and block 3 (RP.3) and block 4 (RP.4) contain compatible practice and critical blocks. However, if Target A starts on the right initially paired with negative (RN permutation), then the incompatible block comes first and this same information comes in blocks 6 and 7 (RN.6 and RN.7). The IAT analysis script (and examples below) have done the work of locating this information for you and are ready to run (so long as users do not alter variable names in the Qualtrics survey). -#' @param name1 A vector of responses representing a critical block (either compatible or incompatible) of trials for one of the four IAT permutations. -#' @param name2 A vector of responses representing a critical block (either compatible or incompatible) of trials for another of the four IAT permutations. -#' @param name3 A vector of responses representing a critical block (either compatible or incompatible) of trials for another of the four IAT permutations. -#' @param name4 A vector of responses representing a critical block (either compatible or incompatible) of trials for another of the four IAT permutations. -#' @return Returns a single vector of responses that contains all four permutations collapsed into one vector. +#' @param name1 A vector of responses representing a critical block (either compatible or incompatible) of trials for one of the four IAT permutations. +#' @param name2 A vector of responses representing a critical block (either compatible or incompatible) of trials for another of the four IAT permutations. +#' @param name3 A vector of responses representing a critical block (either compatible or incompatible) of trials for another of the four IAT permutations. +#' @param name4 A vector of responses representing a critical block (either compatible or incompatible) of trials for another of the four IAT permutations. +#' @return Returns a single vector of responses that contains all four permutations collapsed into one vector. #' @export #' @seealso See www.iatgen.wordpress.com for tutorials and files. #' @references Greenwald, A. G., McGhee, D. E., & Schwartz, J. L. K. (1998). Measuring individual differences in implicit cognition: The Implicit Association Test. \emph{Journal of Personality and Social Psychology, 74}, 1464–1480. https://doi.org/10.1037/0022-3514.74.6.1464 @@ -16,31 +14,32 @@ requireNamespace("stringr") #' ### Collapse IAT critical blocks down #### #' dat$compatible.crit <- combineIATfourblocks(dat$Q4.RP4, dat$Q18.LP4, dat$Q14.RN7, dat$Q28.LN7) #' dat$incompatible.crit <- combineIATfourblocks(dat$Q7.RP7, dat$Q21.LP7, dat$Q11.RN4, dat$Q25.LN4) -#' +#' #' ### Collapse IAT practice blocks #### #' dat$compatible.prac <- combineIATfourblocks(dat$Q3.RP3, dat$Q17.LP3, dat$Q13.RN6, dat$Q27.LN6) #' dat$incompatible.prac <- combineIATfourblocks(dat$Q6.RP6, dat$Q20.LP6, dat$Q10.RN3, dat$Q24.LN3) -#'} - -combineIATfourblocks <- function(name1, name2, name3, name4){ +#' } +combineIATfourblocks <- function(name1, name2, name3, name4) { name1 <- as.character(name1) name2 <- as.character(name2) name3 <- as.character(name3) name4 <- as.character(name4) - if ( all(is.na(name1)) | all(is.na(name2)) | all(is.na(name3)) | all(is.na(name4))){warning("One or more of your input variables contained no data. Please check your variable names and raw data. This function is alerting you to the problem; portions of the IAT may not be scored.")} - + if (all(is.na(name1)) | all(is.na(name2)) | all(is.na(name3)) | all(is.na(name4))) { + warning("One or more of your input variables contained no data. Please check your variable names and raw data. This function is alerting you to the problem; portions of the IAT may not be scored.") + } + name1[is.na(name1)] <- "" name2[is.na(name2)] <- "" name3[is.na(name3)] <- "" name4[is.na(name4)] <- "" - name1[name1==" "] <- "" - name2[name2==" "] <- "" - name3[name3==" "] <- "" - name4[name4==" "] <- "" + name1[name1 == " "] <- "" + name2[name2 == " "] <- "" + name3[name3 == " "] <- "" + name4[name4 == " "] <- "" namecombined <- name1 - namecombined[name1==""] <- as.character(name2[name1==""]) # for blank ones, use alts - namecombined[name1=="" & name2==""] <- as.character(name3[name1=="" & name2==""]) # for blank ones, use alts - namecombined[name1=="" & name2=="" & name3==""] <- as.character(name4[name1=="" & name2=="" & name3==""]) # for blank ones, use alts + namecombined[name1 == ""] <- as.character(name2[name1 == ""]) # for blank ones, use alts + namecombined[name1 == "" & name2 == ""] <- as.character(name3[name1 == "" & name2 == ""]) # for blank ones, use alts + namecombined[name1 == "" & name2 == "" & name3 == ""] <- as.character(name4[name1 == "" & name2 == "" & name3 == ""]) # for blank ones, use alts namecombined[is.na(namecombined)] <- "" return(namecombined) } @@ -50,35 +49,30 @@ combineIATfourblocks <- function(name1, name2, name3, name4){ ### TWO IAT VERSION .... KEEPING FOR COMPATIBILITY BUT NOT USED #' Data analysis function: Collapses IAT permutations down prior to cleaning and analysis (two-permutation version) -#' @description This function is a variation of \code{combineIATfourblocks()} but using two permutations as inputs instead of four. Some users may opt to reduce the number of permutations of the IAT (e.g., fixing one category or target to the left side and the other to the right across participants). This was used in intial testing of iatgen and was retained should it be of interest. -#' @param name1 A vector of responses representing a critical block (either compatible or incompatible) of trials for one of the IAT permutations. -#' @param name2 A vector of responses representing a critical block (either compatible or incompatible) of trials for the other IAT permutation. -#' @return Returns a single vector of responses that contains all four permutations collapsed into one variable. +#' @description This function is a variation of \code{combineIATfourblocks()} but using two permutations as inputs instead of four. Some users may opt to reduce the number of permutations of the IAT (e.g., fixing one category or target to the left side and the other to the right across participants). This was used in intial testing of iatgen and was retained should it be of interest. +#' @param name1 A vector of responses representing a critical block (either compatible or incompatible) of trials for one of the IAT permutations. +#' @param name2 A vector of responses representing a critical block (either compatible or incompatible) of trials for the other IAT permutation. +#' @return Returns a single vector of responses that contains all four permutations collapsed into one variable. #' @export #' @examples \dontrun{ #' ### Example with only Target A on the right and Target B on the left #### #' dat$compatible <- combineIATtwoblocks(dat$Q4.RP4, dat$Q14.RN7) #' dat$incompatible <- combineIATtwoblocks(dat$Q7.RP7, dat$Q11.RN4) #' } -combineIATtwoblocks <- function(name1, name2){ +combineIATtwoblocks <- function(name1, name2) { name1 <- as.character(name1) name2 <- as.character(name2) name1[is.na(name1)] <- "" name2[is.na(name2)] <- "" - name1[name1==" "] <- "" - name2[name2==" "] <- "" - - if ( all(is.na(name1)) | all(is.na(name2)) ){warning("One or more of your input variables contained no data. Please check your variable names and raw data. This function is alerting you to the problem; portions of the IAT may not be scored.")} - + name1[name1 == " "] <- "" + name2[name2 == " "] <- "" + + if (all(is.na(name1)) | all(is.na(name2))) { + warning("One or more of your input variables contained no data. Please check your variable names and raw data. This function is alerting you to the problem; portions of the IAT may not be scored.") + } + namecombined <- name1 - namecombined[name1==""] <- as.character(name2[name1==""]) # for blank ones, use alts + namecombined[name1 == ""] <- as.character(name2[name1 == ""]) # for blank ones, use alts namecombined[is.na(namecombined)] <- "" return(namecombined) } - - - - - - - diff --git a/R/parcelIAT.R b/R/parcelIAT.R index 210c79b..521aab1 100644 --- a/R/parcelIAT.R +++ b/R/parcelIAT.R @@ -9,66 +9,66 @@ #' @examples \dontrun{ #' ### Collapse IAT critical blocks down #### #' parcel <- parcelIAT(clean) -#'} -parcelIAT <- function(input){ - if(ncol(input$clean.latencies.prac1) %% 4 != 0){ +#' } +parcelIAT <- function(input) { + if (ncol(input$clean.latencies.prac1) %% 4 != 0) { stop("The number of trials in the practice block must be divisible by four") } - if(ncol(input$clean.latencies.crit1) %% 4 != 0){ + if (ncol(input$clean.latencies.crit1) %% 4 != 0) { stop("The number of trials in the critical block must be divisible by four") } - if(ncol(input$clean.latencies.prac2) %% 4 != 0){ + if (ncol(input$clean.latencies.prac2) %% 4 != 0) { stop("The number of trials in the practice block must be divisible by four") } - if(ncol(input$clean.latencies.crit2) %% 4 != 0){ + if (ncol(input$clean.latencies.crit2) %% 4 != 0) { stop("The number of trials in the critical block must be divisible by four") } - #break number of trials in 4, generate vectors of columns for each parcel + # break number of trials in 4, generate vectors of columns for each parcel # start with practice trials trials <- ncol(input$clean.latencies.prac1) - p1.trials <- 1:(trials/4) - p2.trials <- (1:(trials/4))+max(p1.trials) - p3.trials <- (1:(trials/4))+max(p2.trials) - p4.trials <- (1:(trials/4))+max(p3.trials) + p1.trials <- 1:(trials / 4) + p2.trials <- (1:(trials / 4)) + max(p1.trials) + p3.trials <- (1:(trials / 4)) + max(p2.trials) + p4.trials <- (1:(trials / 4)) + max(p3.trials) - #grab trials for each parcel from compatible and incompatible blocks - p1.1 <- input$clean.latencies.prac1[,p1.trials] - p1.2 <- input$clean.latencies.prac2[,p1.trials] + # grab trials for each parcel from compatible and incompatible blocks + p1.1 <- input$clean.latencies.prac1[, p1.trials] + p1.2 <- input$clean.latencies.prac2[, p1.trials] - p2.1 <- input$clean.latencies.prac1[,p2.trials] - p2.2 <- input$clean.latencies.prac2[,p2.trials] + p2.1 <- input$clean.latencies.prac1[, p2.trials] + p2.2 <- input$clean.latencies.prac2[, p2.trials] - p3.1 <- input$clean.latencies.prac1[,p3.trials] - p3.2 <- input$clean.latencies.prac2[,p3.trials] + p3.1 <- input$clean.latencies.prac1[, p3.trials] + p3.2 <- input$clean.latencies.prac2[, p3.trials] - p4.1 <- input$clean.latencies.prac1[,p4.trials] - p4.2 <- input$clean.latencies.prac2[,p4.trials] + p4.1 <- input$clean.latencies.prac1[, p4.trials] + p4.2 <- input$clean.latencies.prac2[, p4.trials] # now critical trials trials <- ncol(input$clean.latencies.crit1) - c1.trials <- 1:(trials/4) - c2.trials <- (1:(trials/4))+max(c1.trials) - c3.trials <- (1:(trials/4))+max(c2.trials) - c4.trials <- (1:(trials/4))+max(c3.trials) + c1.trials <- 1:(trials / 4) + c2.trials <- (1:(trials / 4)) + max(c1.trials) + c3.trials <- (1:(trials / 4)) + max(c2.trials) + c4.trials <- (1:(trials / 4)) + max(c3.trials) - #grab trials for each parcel from compatible and incompatible blocks - c1.1 <- input$clean.latencies.crit1[,c1.trials] - c1.2 <- input$clean.latencies.crit2[,c1.trials] + # grab trials for each parcel from compatible and incompatible blocks + c1.1 <- input$clean.latencies.crit1[, c1.trials] + c1.2 <- input$clean.latencies.crit2[, c1.trials] - c2.1 <- input$clean.latencies.crit1[,c2.trials] - c2.2 <- input$clean.latencies.crit2[,c2.trials] + c2.1 <- input$clean.latencies.crit1[, c2.trials] + c2.2 <- input$clean.latencies.crit2[, c2.trials] - c3.1 <- input$clean.latencies.crit1[,c3.trials] - c3.2 <- input$clean.latencies.crit2[,c3.trials] + c3.1 <- input$clean.latencies.crit1[, c3.trials] + c3.2 <- input$clean.latencies.crit2[, c3.trials] - c4.1 <- input$clean.latencies.crit1[,c4.trials] - c4.2 <- input$clean.latencies.crit2[,c4.trials] + c4.1 <- input$clean.latencies.crit1[, c4.trials] + c4.2 <- input$clean.latencies.crit2[, c4.trials] - #combine them: each parcel-half should typically hvae 5 prac and 10 crit trials + # combine them: each parcel-half should typically hvae 5 prac and 10 crit trials parcel1.1 <- cbind(p1.1, c1.1) parcel1.2 <- cbind(p1.2, c1.2) @@ -81,8 +81,8 @@ parcelIAT <- function(input){ parcel4.1 <- cbind(p4.1, c4.1) parcel4.2 <- cbind(p4.2, c4.2) - clean.means <- function(x){ - out <- rowMeans(x, na.rm=TRUE) + clean.means <- function(x) { + out <- rowMeans(x, na.rm = TRUE) out[is.nan(out)] <- NA return(out) } @@ -96,25 +96,29 @@ parcelIAT <- function(input){ clean.means.4.1 <- clean.means(parcel4.1) clean.means.4.2 <- clean.means(parcel4.2) - #get inclusive SD across all combined blocks - inclusive.trials <- cbind(input$clean.latencies.prac1, input$clean.latencies.crit1, - input$clean.latencies.prac2, input$clean.latencies.crit2) + # get inclusive SD across all combined blocks + inclusive.trials <- cbind( + input$clean.latencies.prac1, input$clean.latencies.crit1, + input$clean.latencies.prac2, input$clean.latencies.crit2 + ) inclusive.sd.x <- numeric() inclusive.num <- rowSums(!is.na(inclusive.trials)) - inclusive.num[inclusive.num==0] <- NA - for(i in 1:nrow(inclusive.trials)){ - row <- inclusive.trials[i,] - avg <- sum(row, na.rm=TRUE) / (inclusive.num[i]) - inclusive.sd.x[i] <- sqrt(sum((row - avg)^2, na.rm=TRUE) / (inclusive.num[i]-1)) + inclusive.num[inclusive.num == 0] <- NA + for (i in 1:nrow(inclusive.trials)) { + row <- inclusive.trials[i, ] + avg <- sum(row, na.rm = TRUE) / (inclusive.num[i]) + inclusive.sd.x[i] <- sqrt(sum((row - avg)^2, na.rm = TRUE) / (inclusive.num[i] - 1)) } - D.1 <- (clean.means.1.1-clean.means.1.2) / inclusive.sd.x - D.2 <- (clean.means.2.1-clean.means.2.2) / inclusive.sd.x - D.3 <- (clean.means.3.1-clean.means.3.2) / inclusive.sd.x - D.4 <- (clean.means.4.1-clean.means.4.2) / inclusive.sd.x - - return(data.frame(D.1=D.1, - D.2=D.2, - D.3=D.3, - D.4=D.4)) + D.1 <- (clean.means.1.1 - clean.means.1.2) / inclusive.sd.x + D.2 <- (clean.means.2.1 - clean.means.2.2) / inclusive.sd.x + D.3 <- (clean.means.3.1 - clean.means.3.2) / inclusive.sd.x + D.4 <- (clean.means.4.1 - clean.means.4.2) / inclusive.sd.x + + return(data.frame( + D.1 = D.1, + D.2 = D.2, + D.3 = D.3, + D.4 = D.4 + )) } diff --git a/R/writeIATfull.R b/R/writeIATfull.R index 754360d..440e091 100644 --- a/R/writeIATfull.R +++ b/R/writeIATfull.R @@ -1,20 +1,28 @@ ############## WRITE IAT STIMULI POOLS AND CODE ############## -# requireNamespace("stringr") -# requireNamespace("jsonlite") - -writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, catType, nPos, nNeg, poswords, negwords, tgtType, nA, nB, Awords, Bwords, - tgtCol="black", catCol="green", norepeat=FALSE, write.me, out){ - +writeIATstim <- function(type, combined.type = "alternating", n, posside, Aside, catType, nPos, nNeg, poswords, negwords, tgtType, nA, nB, Awords, Bwords, + tgtCol = "black", catCol = "green", norepeat = FALSE, write.me, out) { ## Misspecification errors: - if ( n %% 2 != 0 ) {stop("The number of trials per block must be even in all IAT blocks in Iatgen. This allows an equal distribution of left-hand and right-hand stimuli.")} + if (n %% 2 != 0) { + stop("The number of trials per block must be even in all IAT blocks in Iatgen. This allows an equal distribution of left-hand and right-hand stimuli.") + } - if (type == "combined"){ - if ( n %% 4 != 0 ) {stop("The number of trials per combined block must be divisible by four in Iatgen. This allows an equal distribution of Positive, Negative, Target A, and Target B stimuli.")} - if (combined.type != "random" && combined.type != "alternating") {stop("Type must be 'random' or 'alternating.'")} + if (type == "combined") { + if (n %% 4 != 0) { + stop("The number of trials per combined block must be divisible by four in Iatgen. This allows an equal distribution of Positive, Negative, Target A, and Target B stimuli.") + } + if (combined.type != "random" && combined.type != "alternating") { + stop("Type must be 'random' or 'alternating.'") + } + } + if (type != "combined" && type != "target" && type != "category") { + stop("The type of block must be either combined or target. Type is misspecified.") + } + if (catType != "words" && catType != "images") { + stop("Category must be either words or images.") + } + if (tgtType != "words" && tgtType != "images") { + stop("Targets must be either words or images.") } - if (type != "combined" && type != "target" && type != "category") {stop("The type of block must be either combined or target. Type is misspecified.")} - if (catType != "words" && catType != "images") {stop("Category must be either words or images.")} - if (tgtType != "words" && tgtType != "images") {stop("Targets must be either words or images.")} ### DEFINE ELEMENTS startpos <- "\tposstim = [" @@ -25,149 +33,204 @@ writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, c end <- "\t];" ### IMAGE NUMBER INDEXING - if (tgtType == "images" && catType =="images"){ - nums.pos <- c(0:(nPos-1)) - nums.neg <- c(nPos:(nPos+nNeg-1)) - nums.A <- c( (nPos + nNeg) : (nPos + nNeg + nA - 1)) - nums.B <- c( (nPos + nNeg + nA) : (nPos + nNeg + nA + nB - 1) ) + if (tgtType == "images" && catType == "images") { + nums.pos <- c(0:(nPos - 1)) + nums.neg <- c(nPos:(nPos + nNeg - 1)) + nums.A <- c((nPos + nNeg):(nPos + nNeg + nA - 1)) + nums.B <- c((nPos + nNeg + nA):(nPos + nNeg + nA + nB - 1)) } - if (tgtType == "words" && catType =="images"){ - nums.pos <- c(0:(nPos-1)) - nums.neg <- c(nPos:(nPos+nNeg-1)) + if (tgtType == "words" && catType == "images") { + nums.pos <- c(0:(nPos - 1)) + nums.neg <- c(nPos:(nPos + nNeg - 1)) } - if (tgtType == "images" && catType =="words"){ - nums.A <- c( 0 : (nA - 1)) - nums.B <- c( nA : (nA + nB - 1) ) + if (tgtType == "images" && catType == "words") { + nums.A <- c(0:(nA - 1)) + nums.B <- c(nA:(nA + nB - 1)) } ### BUILD POSITIVE STIMULI POOL # build posbody - if (catType=="words"){length.pos <- length(poswords)} - if (catType=="images"){length.pos <- nPos} + if (catType == "words") { + length.pos <- length(poswords) + } + if (catType == "images") { + length.pos <- nPos + } body <- character() - for (i in 1:length.pos) {body <- rbind(body, mid)} # add more sections to body - body[length(body)] <- gsub("}," , "}", body[length(body)]) #remove last comma + for (i in 1:length.pos) { + body <- rbind(body, mid) + } # add more sections to body + body[length(body)] <- gsub("},", "}", body[length(body)]) # remove last comma body <- rbind(startpos, body, end) finpos <- body # pos stimuli builder - if (catType=="words"){ - stim.pos <- paste('\"', poswords, '"' , sep="") + if (catType == "words") { + stim.pos <- paste('\"", poswords, '"', sep = "") } else { - stim.pos <- paste('images[',nums.pos, ']' , sep="") + stim.pos <- paste("images[", nums.pos, "]", sep = "") } # add content to finpos - for (i in 2:(length.pos+1)){ #loops through row numbers containing stimuli=normal count + 1. Use i-1 to get normal count. - finpos[i] <- gsub("INSERTSTIM", stim.pos[(i-1)], finpos[i]) - if (posside == "right") {finpos[i] <- gsub("INSERTCOR", 73, finpos[i])} - if (posside == "left") {finpos[i] <- gsub("INSERTCOR", 69, finpos[i])} - if (posside == "none") {finpos[i] <- gsub("INSERTCOR", "\"NA\"", finpos[i])} - finpos[i] <- gsub("INSERTINDEX", i-1, finpos[i]) + for (i in 2:(length.pos + 1)) { # loops through row numbers containing stimuli=normal count + 1. Use i-1 to get normal count. + finpos[i] <- gsub("INSERTSTIM", stim.pos[(i - 1)], finpos[i]) + if (posside == "right") { + finpos[i] <- gsub("INSERTCOR", 73, finpos[i]) + } + if (posside == "left") { + finpos[i] <- gsub("INSERTCOR", 69, finpos[i]) + } + if (posside == "none") { + finpos[i] <- gsub("INSERTCOR", "\"NA\"", finpos[i]) + } + finpos[i] <- gsub("INSERTINDEX", i - 1, finpos[i]) } ### BUILD NEGATIVE STIMULI POOL # build negbody - if (catType=="words"){length.neg <- length(negwords)} - if (catType=="images"){length.neg <- nNeg} + if (catType == "words") { + length.neg <- length(negwords) + } + if (catType == "images") { + length.neg <- nNeg + } body <- character() - for (i in 1:length.neg) {body <- rbind(body, mid)} # add more sections to body - body[length(body)] <- gsub("}," , "}", body[length(body)]) #remove last comma + for (i in 1:length.neg) { + body <- rbind(body, mid) + } # add more sections to body + body[length(body)] <- gsub("},", "}", body[length(body)]) # remove last comma body <- rbind(startneg, body, end) finneg <- body # neg stimuli builder - if (catType=="words"){ - stim.neg <- paste('\"', negwords, '"' , sep="") + if (catType == "words") { + stim.neg <- paste('\"", negwords, '"', sep = "") } else { - stim.neg <- paste('images[',nums.neg, ']' , sep="") + stim.neg <- paste("images[", nums.neg, "]", sep = "") } # add content to finneg - for (i in 2:(length.neg+1)){ #loops through row numbers containing stimuli=normal count + 1. Use i-1 to get normal count. - finneg[i] <- gsub("INSERTSTIM", stim.neg[(i-1)], finneg[i]) - if (posside == "left") {finneg[i] <- gsub("INSERTCOR", 73, finneg[i])} - if (posside == "right") {finneg[i] <- gsub("INSERTCOR", 69, finneg[i])} - if (posside == "none") {finneg[i] <- gsub("INSERTCOR", "\"NA\"", finneg[i])} + for (i in 2:(length.neg + 1)) { # loops through row numbers containing stimuli=normal count + 1. Use i-1 to get normal count. + finneg[i] <- gsub("INSERTSTIM", stim.neg[(i - 1)], finneg[i]) + if (posside == "left") { + finneg[i] <- gsub("INSERTCOR", 73, finneg[i]) + } + if (posside == "right") { + finneg[i] <- gsub("INSERTCOR", 69, finneg[i]) + } + if (posside == "none") { + finneg[i] <- gsub("INSERTCOR", "\"NA\"", finneg[i]) + } finneg[i] <- gsub("INSERTINDEX", i + length.pos - 1, finneg[i]) } ### BUILD A STIMULI POOL # build Abody - if (tgtType=="words"){length.A <- length(Awords)} - if (tgtType=="images"){length.A <- nA} + if (tgtType == "words") { + length.A <- length(Awords) + } + if (tgtType == "images") { + length.A <- nA + } body <- character() - for (i in 1:length.A) {body <- rbind(body, mid)} # add more sections to body - body[length(body)] <- gsub("}," , "}", body[length(body)]) #remove last comma + for (i in 1:length.A) { + body <- rbind(body, mid) + } # add more sections to body + body[length(body)] <- gsub("},", "}", body[length(body)]) # remove last comma body <- rbind(startA, body, end) finA <- body # A stimuli builder - if (tgtType=="words"){ - stim.A <- paste('\"', Awords, '"' , sep="") + if (tgtType == "words") { + stim.A <- paste('\"", Awords, '"', sep = "") } else { - stim.A <- paste('images[',nums.A, ']' , sep="") + stim.A <- paste("images[", nums.A, "]", sep = "") } # add content to finA - for (i in 2:(length.A+1)){ #loops through row numbers containing stimuli=normal count + 1. Use i-1 to get normal count. - finA[i] <- gsub("INSERTSTIM", stim.A[(i-1)], finA[i]) - if (Aside == "right") {finA[i] <- gsub("INSERTCOR", 73, finA[i])} - if (Aside == "left") {finA[i] <- gsub("INSERTCOR", 69, finA[i])} - if (Aside == "none") {finA[i] <- gsub("INSERTCOR", "\"NA\"", finA[i])} - finA[i] <- gsub("INSERTINDEX", (i+length.pos+length.neg-1), finA[i]) + for (i in 2:(length.A + 1)) { # loops through row numbers containing stimuli=normal count + 1. Use i-1 to get normal count. + finA[i] <- gsub("INSERTSTIM", stim.A[(i - 1)], finA[i]) + if (Aside == "right") { + finA[i] <- gsub("INSERTCOR", 73, finA[i]) + } + if (Aside == "left") { + finA[i] <- gsub("INSERTCOR", 69, finA[i]) + } + if (Aside == "none") { + finA[i] <- gsub("INSERTCOR", "\"NA\"", finA[i]) + } + finA[i] <- gsub("INSERTINDEX", (i + length.pos + length.neg - 1), finA[i]) } ### BUILD B STIMULI POOL # build Bbody - if (tgtType=="words"){length.B <- length(Bwords)} - if (tgtType=="images"){length.B <- nB} + if (tgtType == "words") { + length.B <- length(Bwords) + } + if (tgtType == "images") { + length.B <- nB + } body <- character() - for (i in 1:length.B) {body <- rbind(body, mid)} # add more sections to body - body[length(body)] <- gsub("}," , "}", body[length(body)]) #remove last comma + for (i in 1:length.B) { + body <- rbind(body, mid) + } # add more sections to body + body[length(body)] <- gsub("},", "}", body[length(body)]) # remove last comma body <- rbind(startB, body, end) finB <- body # B stimuli builder - if (tgtType=="words"){ - stim.B <- paste('\"', Bwords, '"' , sep="") + if (tgtType == "words") { + stim.B <- paste('\"", Bwords, '"', sep = "") } else { - stim.B <- paste('images[',nums.B, ']' , sep="") + stim.B <- paste("images[", nums.B, "]", sep = "") } # add content to finB - for (i in 2:(length.B+1)){ #loops through row numbers containing stimuli=normal count + 1. Use i-1 to get normal count. - finB[i] <- gsub("INSERTSTIM", stim.B[(i-1)], finB[i]) - if (Aside == "left") {finB[i] <- gsub("INSERTCOR", 73, finB[i])} - if (Aside == "right") {finB[i] <- gsub("INSERTCOR", 69, finB[i])} - if (Aside == "none") {finB[i] <- gsub("INSERTCOR", "\"NA\"", finB[i])} + for (i in 2:(length.B + 1)) { # loops through row numbers containing stimuli=normal count + 1. Use i-1 to get normal count. + finB[i] <- gsub("INSERTSTIM", stim.B[(i - 1)], finB[i]) + if (Aside == "left") { + finB[i] <- gsub("INSERTCOR", 73, finB[i]) + } + if (Aside == "right") { + finB[i] <- gsub("INSERTCOR", 69, finB[i]) + } + if (Aside == "none") { + finB[i] <- gsub("INSERTCOR", "\"NA\"", finB[i]) + } finB[i] <- gsub("INSERTINDEX", (i + length.pos + length.neg + length.A - 1), finB[i]) } ## MID SECTION IS EITHER EMPTY OR CONTAINS INTERMEDIATE CODE FOR ALTERNATING-TRIAL COMBINED BLOCKS - if (type == "target") {altsection <- ""} - if (type == "category") {altsection <- ""} - if (type == "combined" && combined.type=="random") {altsection <- ""} - if (type == "combined" && combined.type=="alternating") { - + if (type == "target") { + altsection <- "" + } + if (type == "category") { + altsection <- "" + } + if (type == "combined" && combined.type == "random") { + altsection <- "" + } + if (type == "combined" && combined.type == "alternating") { starttgts <- "\ttgts = [" startcats <- "\tcats = [" - midalt<- "\t\t{stimulus: \"\", correct: \"\", index: \"\"}," + midalt <- "\t\t{stimulus: \"\", correct: \"\", index: \"\"}," lastalt <- "\t\t{stimulus: \"\", correct: \"\", index: \"\"}" endalt <- "\t];" bodyalt <- character() - for (i in 1:(n/2)) {bodyalt <- rbind(bodyalt, midalt)} # add more sections to body - bodyalt[length(bodyalt)] <- lastalt #replace last row with row w/o ending comma + for (i in 1:(n / 2)) { + bodyalt <- rbind(bodyalt, midalt) + } # add more sections to body + bodyalt[length(bodyalt)] <- lastalt # replace last row with row w/o ending comma - #CATS + # CATS headercats <- "\t//EMPTY SET OF CATEGORY STIMULI - USED FOR ALTERNATING TRIALS FORMAT ONLY" bodycats <- rbind(headercats, startcats, bodyalt, endalt) - #TGTS + # TGTS headertgts <- "\t//EMPTY SET OF TARGET STIMULI - USED FOR ALTERNATING TRIALS FORMAT ONLY" bodytgts <- rbind(headertgts, starttgts, bodyalt, endalt) @@ -176,31 +239,31 @@ writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, c ## ADD CODE TO TAKE CONTENTS FROM THESE POOLS TO FINAL STIMULI OBJECT # default version randomly samples w/o replacement and randomizes order; otherwise they can be displayed without - if (norepeat==FALSE) { - altcode <- rbind( - "\t//ASSEMBLE TGTS AND CATS FOR ALTERNATING TRIAL FORMAT", - "\tvar half = tgts.length / 2; //SAME FOR TGTS AND CATS", - "\tvar cutoffs = [0, half, tgts.length];", - "\tstimBuilder(Astim, tgts, cutoffs[0], cutoffs[1]);", - "\tstimBuilder(Bstim, tgts, cutoffs[1], cutoffs[2]);", - "\tstimBuilder(posstim, cats, cutoffs[0], cutoffs[1]);", - "\tstimBuilder(negstim, cats, cutoffs[1], cutoffs[2]);", - "\tshuffle(tgts);", - "\tshuffle(tgts);", - "\tshuffle(cats);", - "\tshuffle(cats);" - ) - altsection <- rbind(bodycats, "", bodytgts, "", altcode, "") - } else { - altcode <- rbind( - "\t//ASSEMBLE TGTS AND CATS FOR ALTERNATING TRIAL FORMAT - WILL NOT DISPLAY REPEATS UNTIL ALL TGT/CAT STIMULI ARE SHOWN", - "\tvar tgtcombo = Astim.concat(Bstim);", - "\tvar catcombo = posstim.concat(negstim);", - "\tstimBuilder(tgtcombo, tgts, 0, tgts.length);", - "\tstimBuilder(catcombo, cats, 0, cats.length);" - ) - altsection <- rbind(bodycats, "", bodytgts, "", altcode, "") - } + if (norepeat == FALSE) { + altcode <- rbind( + "\t//ASSEMBLE TGTS AND CATS FOR ALTERNATING TRIAL FORMAT", + "\tvar half = tgts.length / 2; //SAME FOR TGTS AND CATS", + "\tvar cutoffs = [0, half, tgts.length];", + "\tstimBuilder(Astim, tgts, cutoffs[0], cutoffs[1]);", + "\tstimBuilder(Bstim, tgts, cutoffs[1], cutoffs[2]);", + "\tstimBuilder(posstim, cats, cutoffs[0], cutoffs[1]);", + "\tstimBuilder(negstim, cats, cutoffs[1], cutoffs[2]);", + "\tshuffle(tgts);", + "\tshuffle(tgts);", + "\tshuffle(cats);", + "\tshuffle(cats);" + ) + altsection <- rbind(bodycats, "", bodytgts, "", altcode, "") + } else { + altcode <- rbind( + "\t//ASSEMBLE TGTS AND CATS FOR ALTERNATING TRIAL FORMAT - WILL NOT DISPLAY REPEATS UNTIL ALL TGT/CAT STIMULI ARE SHOWN", + "\tvar tgtcombo = Astim.concat(Bstim);", + "\tvar catcombo = posstim.concat(negstim);", + "\tstimBuilder(tgtcombo, tgts, 0, tgts.length);", + "\tstimBuilder(catcombo, cats, 0, cats.length);" + ) + altsection <- rbind(bodycats, "", bodytgts, "", altcode, "") + } } @@ -212,20 +275,22 @@ writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, c endstim <- "\t];" body <- character() - for (i in 1:n) {body <- rbind(body, midstim)} # add more sections to body + for (i in 1:n) { + body <- rbind(body, midstim) + } # add more sections to body body <- rbind(startstim, body) - body[length(body)] <- laststim #replace last row with row w/o ending comma + body[length(body)] <- laststim # replace last row with row w/o ending comma stimheader <- "\t//EMPTY SET OF TRIALS - LOADS FROM POOLS ABOVE" finstim <- rbind(stimheader, body, endstim) ### COMPILE TRIALS CODE - trials <- rbind(finpos, "", finneg, "", finA, "", finB, "", altsection, "" , finstim) + trials <- rbind(finpos, "", finneg, "", finA, "", finB, "", altsection, "", finstim) ### JAVASCRIPT CODE THAT ADDS CONTENT TO STIMULI - if (type=="combined" && combined.type=="random"){ + if (type == "combined" && combined.type == "random") { call <- rbind( "\tvar quarter = stimuli.length / 4;", "\tvar cutoffs = [0, quarter, quarter*2, quarter*3, stimuli.length];", @@ -242,7 +307,7 @@ writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, c # The reverse is needed for 'norepeat' variants; stimuli displayer pulls from end. Doesn't impact standard variatn as it's random order anywayß - if(type=="combined" & combined.type=="alternating"){ + if (type == "combined" & combined.type == "alternating") { call <- rbind( "\taltStimuil();", "\tstimuli.reverse();" @@ -250,7 +315,7 @@ writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, c } - if (type=="target" & norepeat==FALSE){ + if (type == "target" & norepeat == FALSE) { call <- rbind( "\tvar half = stimuli.length / 2;", "\tvar cutoffs = [0, half, stimuli.length];", @@ -263,7 +328,7 @@ writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, c ) } - if (type=="target" & norepeat==TRUE){ + if (type == "target" & norepeat == TRUE) { call <- rbind( "\tvar tgtcombo = Astim.concat(Bstim);", "\tstimBuilder(tgtcombo, stimuli, 0, stimuli.length);", @@ -272,7 +337,7 @@ writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, c } - if (type=="category" & norepeat==FALSE){ + if (type == "category" & norepeat == FALSE) { call <- rbind( "\tvar half = stimuli.length / 2;", "\tvar cutoffs = [0, half, stimuli.length];", @@ -283,9 +348,9 @@ writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, c "\tshuffle(stimuli);", "\tshuffle(stimuli);" ) - } + } - if (type=="category" & norepeat==TRUE){ + if (type == "category" & norepeat == TRUE) { call <- rbind( "\tvar catcombo = posstim.concat(negstim);", "\tstimBuilder(catcombo, stimuli, 0, stimuli.length);", @@ -295,9 +360,9 @@ writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, c fin <- rbind(trials, "", "", "\t//BUILD TRIALS", "", call) - if (write.me){ - con <- file(out, open="wb") - writeLines(fin, con=out, sep="\n") + if (write.me) { + con <- file(out, open = "wb") + writeLines(fin, con = out, sep = "\n") close(con) } return(fin) @@ -307,63 +372,70 @@ writeIATstim <- function(type, combined.type="alternating", n, posside, Aside, c ############## WRITE IAT JAVASCRIPT FILE ############## -writeIATjs <- function(type, combined.type="alternating", n, posside, Aside, catType, catCol="green", nPos, nNeg, - poswords, negwords, tgtType, tgtCol="black", nA, nB, Awords, Bwords, - pause=250, errorpause=300, correct.error=F, note=F, norepeat=FALSE, +writeIATjs <- function(type, combined.type = "alternating", n, posside, Aside, catType, catCol = "green", nPos, nNeg, + poswords, negwords, tgtType, tgtCol = "black", nA, nB, Awords, Bwords, + pause = 250, errorpause = 300, correct.error = F, note = F, norepeat = FALSE, imgs, out) { - - apath <- system.file("codefiles", "codeA.txt", package="iatgen") - codeA <- as.matrix(readLines(apath, warn=F)) + apath <- system.file("codefiles", "codeA.txt", package = "iatgen") + codeA <- as.matrix(readLines(apath, warn = F)) ## if IAT uses images, build an image_srcs array - if (tgtType == "images" || catType == "images"){ + if (tgtType == "images" || catType == "images") { codeimage <- "\timage_srcs = [" for (i in 1:length(imgs)) { - codeimage <- rbind(codeimage, paste('\t\t\"',imgs[i],'\",', sep="")) + codeimage <- rbind(codeimage, paste('\t\t\"', imgs[i], '\",', sep = "")) } codeimage[length(codeimage)] <- gsub(",$", "", codeimage[length(codeimage)]) # remove comma from last line - codeimage <- rbind(codeimage,"\t];") + codeimage <- rbind(codeimage, "\t];") } else { codeimage <- "\timage_srcs = [];" } - bpath <- system.file("codefiles", "codeB.txt", package="iatgen") - codeB <- as.matrix(readLines(bpath, warn=F)) - codestim <- writeIATstim(type=type, combined.type=combined.type, n=n, catType=catType, catCol=catCol, nPos=nPos, nNeg=nNeg, - poswords=poswords, negwords=negwords, posside=posside, tgtType=tgtType, - tgtCol=tgtCol, nA=nA, nB=nB, Awords=Awords, Bwords=Bwords, Aside=Aside, norepeat=norepeat, write.me=FALSE) - cpath <- system.file("codefiles", "codeC.txt", package="iatgen") - codeC <- as.matrix(readLines(cpath, warn=F)) + bpath <- system.file("codefiles", "codeB.txt", package = "iatgen") + codeB <- as.matrix(readLines(bpath, warn = F)) + codestim <- writeIATstim( + type = type, combined.type = combined.type, n = n, catType = catType, catCol = catCol, nPos = nPos, nNeg = nNeg, + poswords = poswords, negwords = negwords, posside = posside, tgtType = tgtType, + tgtCol = tgtCol, nA = nA, nB = nB, Awords = Awords, Bwords = Bwords, Aside = Aside, norepeat = norepeat, write.me = FALSE + ) + cpath <- system.file("codefiles", "codeC.txt", package = "iatgen") + codeC <- as.matrix(readLines(cpath, warn = F)) temp <- rbind(codeA, codeimage, codeB, codestim, codeC) - #for forced error correction, change the keycheck function call and remover - if(correct.error==T){ - temp <- gsub(", keyCheck, false);", - ", keyCheckForcedError, false);", - temp) + # for forced error correction, change the keycheck function call and remover + if (correct.error == T) { + temp <- gsub( + ", keyCheck, false);", + ", keyCheckForcedError, false);", + temp + ) } - #add note below IAT window - if(correct.error==T && note==T){ - temp <- gsub("note.innerHTML = \"\";", - "note.innerHTML = \"Press E or I to advance to the next word/image. Correct mistakes by pressing the other key.\";", - temp) + # add note below IAT window + if (correct.error == T && note == T) { + temp <- gsub( + "note.innerHTML = \"\";", + "note.innerHTML = \"Press E or I to advance to the next word/image. Correct mistakes by pressing the other key.\";", + temp + ) } - if(correct.error==F && note==T){ - temp <- gsub("note.innerHTML = \"\";", - "note.innerHTML = \"Press E or I to advance to the next word/image.\";", - temp) + if (correct.error == F && note == T) { + temp <- gsub( + "note.innerHTML = \"\";", + "note.innerHTML = \"Press E or I to advance to the next word/image.\";", + temp + ) } - #replace the default 250 ms intertrial pause with one set by user. Greenwald et al 1998 settled on 250 ms + # replace the default 250 ms intertrial pause with one set by user. Greenwald et al 1998 settled on 250 ms temp <- gsub(250, pause, temp) - #replace the default 300 ms error pause with one set by the user. Greenwald et al 1998 settled on 300 ms + # replace the default 300 ms error pause with one set by the user. Greenwald et al 1998 settled on 300 ms temp <- gsub(300, errorpause, temp) - con <- file(out, open="wb") - writeLines(temp, con, sep="\n") + con <- file(out, open = "wb") + writeLines(temp, con, sep = "\n") close(con) } @@ -388,24 +460,22 @@ writeIATjs <- function(type, combined.type="alternating", n, posside, Aside, cat ############## WRITE IAT BLOCKS TO WORKING DIRECTORY FILE ############## -writeIATblocks <- function(startqid=1, combined.type="alternating", foldernum=1, posname, negname, Aname, Bname, posstart, Astart, IATname="IAT", n=c(20, 20, 20, 40, 40, 20, 40), - catType, catCol="green", poswords, negwords, nPos, nNeg, posimgs, negimgs, tgtType, tgtCol="black", nA, nB, Awords, Bwords, Aimgs, Bimgs, - easy.img=F, pause=250, errorpause=300, correct.error=F, note=F, norepeat=FALSE, swap="category", imgs -) { - +writeIATblocks <- function(startqid = 1, combined.type = "alternating", foldernum = 1, posname, negname, Aname, Bname, posstart, Astart, IATname = "IAT", n = c(20, 20, 20, 40, 40, 20, 40), + catType, catCol = "green", poswords, negwords, nPos, nNeg, posimgs, negimgs, tgtType, tgtCol = "black", nA, nB, Awords, Bwords, Aimgs, Bimgs, + easy.img = F, pause = 250, errorpause = 300, correct.error = F, note = F, norepeat = FALSE, swap = "category", imgs) { # add error message if tgtType and catType are not both either "images" or "words - if (easy.img==T) { - #easy.img inferrs the nA and nB from the number of images in the vector. I prefer the manual control. Might this cause issues? + if (easy.img == T) { + # easy.img inferrs the nA and nB from the number of images in the vector. I prefer the manual control. Might this cause issues? - if(tgtType == "images" && catType == "words") { + if (tgtType == "images" && catType == "words") { # add error message if there are not appropriately specified images imgs <- c(Aimgs, Bimgs) nA <- length(Aimgs) nB <- length(Bimgs) } - if(tgtType == "images" && catType == "images") { + if (tgtType == "images" && catType == "images") { # add error message if there are not appropriately specified images imgs <- c(posimgs, negimgs, Aimgs, Bimgs) nA <- length(Aimgs) @@ -414,9 +484,9 @@ writeIATblocks <- function(startqid=1, combined.type="alternating", foldernum=1, nNeg <- length(negimgs) } - if(tgtType == "words" && catType == "words") {} + if (tgtType == "words" && catType == "words") {} - if(tgtType == "words" && catType == "images") { + if (tgtType == "words" && catType == "images") { # add error message if there are not appropriately specified images imgs <- c(posimgs, negimgs) nPos <- length(posimgs) @@ -424,256 +494,288 @@ writeIATblocks <- function(startqid=1, combined.type="alternating", foldernum=1, } } - if (easy.img==F){ - if (tgtType == "images" || catType == "images"){ - if (sum(c(nPos, nNeg, nA, nB), na.rm=T) != length(imgs)){warning("The number of image URLs provided did not match the number of images listed.")} + if (easy.img == F) { + if (tgtType == "images" || catType == "images") { + if (sum(c(nPos, nNeg, nA, nB), na.rm = T) != length(imgs)) { + warning("The number of image URLs provided did not match the number of images listed.") + } } } - #create matrices that show what goes where - if(swap=="category"){ - possides <- cbind(matrix(c("none", "right", "right", "right", "left", "left", "left")), - matrix(c("none", "left", "left", "left", "right", "right", "right"))) - colnames(possides) <- c("right","left") # name columns for the STARTING valence position + # create matrices that show what goes where + if (swap == "category") { + possides <- cbind( + matrix(c("none", "right", "right", "right", "left", "left", "left")), + matrix(c("none", "left", "left", "left", "right", "right", "right")) + ) + colnames(possides) <- c("right", "left") # name columns for the STARTING valence position - Asides <- cbind(matrix(c("right", "none", "right", "right", "none", "right", "right")), - matrix(c("left", "none", "left", "left", "none", "left", "left"))) - colnames(Asides) <- c("right","left") # name columns for the STARTING valence position + Asides <- cbind( + matrix(c("right", "none", "right", "right", "none", "right", "right")), + matrix(c("left", "none", "left", "left", "none", "left", "left")) + ) + colnames(Asides) <- c("right", "left") # name columns for the STARTING valence position } - if(swap=="target"){ - possides <- cbind(matrix(c("none", "right", "right", "right", "none", "right", "right")), - matrix(c("none", "left", "left", "left", "none", "left", "left"))) - colnames(possides) <- c("right","left") # name columns for the STARTING valence position + if (swap == "target") { + possides <- cbind( + matrix(c("none", "right", "right", "right", "none", "right", "right")), + matrix(c("none", "left", "left", "left", "none", "left", "left")) + ) + colnames(possides) <- c("right", "left") # name columns for the STARTING valence position - Asides <- cbind(matrix(c("right", "none", "right", "right", "left", "left", "left")), - matrix(c("left", "none", "left", "left", "right", "right", "right"))) - colnames(Asides) <- c("right","left") # name columns for the STARTING valence position + Asides <- cbind( + matrix(c("right", "none", "right", "right", "left", "left", "left")), + matrix(c("left", "none", "left", "left", "right", "right", "right")) + ) + colnames(Asides) <- c("right", "left") # name columns for the STARTING valence position } - if (Astart == "right" && posstart == "right") { suffix <- "rp" } # SUFFIX ALWAYS REFLECTS STATUS OF TGT A - if (Astart == "left" && posstart == "right") { suffix <- "ln" } # SUFFIX ALWAYS REFLECTS STATUS OF TGT A - if (Astart == "right" && posstart == "left") { suffix <- "rn" } # SUFFIX ALWAYS REFLECTS STATUS OF TGT A - if (Astart == "left" && posstart == "left") { suffix <- "lp" } # SUFFIX ALWAYS REFLECTS STATUS OF TGT A + if (Astart == "right" && posstart == "right") { + suffix <- "rp" + } # SUFFIX ALWAYS REFLECTS STATUS OF TGT A + if (Astart == "left" && posstart == "right") { + suffix <- "ln" + } # SUFFIX ALWAYS REFLECTS STATUS OF TGT A + if (Astart == "right" && posstart == "left") { + suffix <- "rn" + } # SUFFIX ALWAYS REFLECTS STATUS OF TGT A + if (Astart == "left" && posstart == "left") { + suffix <- "lp" + } # SUFFIX ALWAYS REFLECTS STATUS OF TGT A qids <- 0:6 + startqid mainDir <- getwd() - subDir <- paste(foldernum, " ",IATname,"_",suffix,sep="") + subDir <- paste(foldernum, " ", IATname, "_", suffix, sep = "") - if (!file.exists(subDir)){ + if (!file.exists(subDir)) { dir.create(file.path(mainDir, subDir)) } # move files to current folder. Note that tgtswap variants have the target changing sides instead of the category. Copy everything, then later delete what's unused - file.copy(system.file("codefiles", "html_1.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "html_2.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "html_3.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "html_4.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "html_5.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "html_6.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "html_7.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "html_5_tgtswap.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "html_6_tgtswap.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "html_7_tgtswap.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "codeA.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "codeB.txt", package="iatgen"), file.path(mainDir, subDir)) - file.copy(system.file("codefiles", "codeC.txt", package="iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "html_1.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "html_2.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "html_3.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "html_4.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "html_5.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "html_6.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "html_7.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "html_5_tgtswap.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "html_6_tgtswap.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "html_7_tgtswap.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "codeA.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "codeB.txt", package = "iatgen"), file.path(mainDir, subDir)) + file.copy(system.file("codefiles", "codeC.txt", package = "iatgen"), file.path(mainDir, subDir)) setwd(file.path(mainDir, subDir)) - #we only want html_1.txt-html_7.txt. If we have the tgtswap versions (swap="target), delete the non-swap versions and rename. - if(swap=="target"){ + # we only want html_1.txt-html_7.txt. If we have the tgtswap versions (swap="target), delete the non-swap versions and rename. + if (swap == "target") { file.remove("html_5.txt") file.remove("html_6.txt") file.remove("html_7.txt") - file.rename(from="html_5_tgtswap.txt", to="html_5.txt") - file.rename(from="html_6_tgtswap.txt", to="html_6.txt") - file.rename(from="html_7_tgtswap.txt", to="html_7.txt") + file.rename(from = "html_5_tgtswap.txt", to = "html_5.txt") + file.rename(from = "html_6_tgtswap.txt", to = "html_6.txt") + file.rename(from = "html_7_tgtswap.txt", to = "html_7.txt") } - if(swap=="category"){ + if (swap == "category") { file.remove("html_5_tgtswap.txt") file.remove("html_6_tgtswap.txt") file.remove("html_7_tgtswap.txt") } - writeIATjs(type = "target", - combined.type=combined.type, - n=n[1], - tgtType = tgtType, - tgtCol = tgtCol, - catType = catType, - catCol = catCol, - Aside = Asides[1,Astart], - posside = possides[1,posstart], - nA = nA, - nB = nA, - Awords = Awords, - Bwords = Bwords, - poswords = poswords, - negwords = negwords, - nPos = nPos, - nNeg = nNeg, - imgs=imgs, - pause=pause, - note=note, - errorpause=errorpause, - correct.error=correct.error, - norepeat=norepeat, - out = paste("Q",qids[1], " JavaScript_1.txt",sep="")) - - writeIATjs(type = "category", - combined.type=combined.type, - n = n[2], - tgtType = tgtType, - tgtCol = tgtCol, - catType = catType, - catCol = catCol, - posside = possides[2,posstart], - Aside = Asides[2,Astart], - poswords = poswords, - negwords = negwords, - nPos = nPos, - nNeg = nNeg, - Awords = Awords, - Bwords = Bwords, - nA = nA, - nB = nB, - imgs=imgs, - pause=pause, - note=note, - errorpause=errorpause, - correct.error=correct.error, - norepeat=norepeat, - out = paste("Q",qids[2], " JavaScript_2.txt",sep="")) - - writeIATjs(type = "combined", - combined.type=combined.type, - n = n[3], - tgtType = tgtType, - tgtCol = tgtCol, - catType = catType, - catCol = catCol, - posside=possides[3,posstart], - Aside = Asides[3,Astart], - poswords = poswords, - negwords = negwords, - nPos = nPos, - nNeg = nNeg, - nA = nA, - nB = nA, - Awords = Awords, - Bwords = Bwords, - imgs=imgs, - pause=pause, - note=note, - errorpause=errorpause, - correct.error=correct.error, - norepeat=norepeat, - out = paste("Q",qids[3], " JavaScript_3.txt",sep="")) - - writeIATjs(type = "combined", - combined.type=combined.type, - n = n[4], - tgtType = tgtType, - tgtCol = tgtCol, - catType = catType, - catCol = catCol, - posside=possides[4,posstart], - Aside = Asides[4,Astart], - poswords = poswords, - negwords = negwords, - nPos = nPos, - nNeg = nNeg, - nA = nA, - nB = nA, - Awords = Awords, - Bwords = Bwords, - imgs=imgs, - pause=pause, - note=note, - errorpause=errorpause, - correct.error=correct.error, - norepeat=norepeat, - out = paste("Q",qids[4], " JavaScript_4.txt",sep="")) - - #whatever swaps here--garget or category--is what block 5 type should be. Populates stimuli builder - writeIATjs(type = swap, - combined.type=combined.type, - n = n[5], - tgtType = tgtType, - tgtCol = tgtCol, - catType = catType, - catCol = catCol, - posside = possides[5,posstart], - Aside = Asides[5,Astart], - poswords = poswords, - negwords = negwords, - nPos = nPos, - nNeg = nNeg, - Awords = Awords, - Bwords = Bwords, - nA = nA, - nB = nB, - imgs=imgs, - pause=pause, - note=note, - errorpause=errorpause, - correct.error=correct.error, - norepeat=norepeat, - out = paste("Q",qids[5], " JavaScript_5.txt",sep="")) - - writeIATjs(type = "combined", - combined.type=combined.type, - n = n[6], - tgtType = tgtType, - tgtCol = tgtCol, - catType = catType, - catCol = catCol, - posside=possides[6,posstart], - Aside = Asides[6,Astart], - poswords = poswords, - negwords = negwords, - nPos = nPos, - nNeg = nNeg, - nA = nA, - nB = nA, - Awords = Awords, - Bwords = Bwords, - imgs=imgs, - pause=pause, - note=note, - errorpause=errorpause, - correct.error=correct.error, - norepeat=norepeat, - out = paste("Q",qids[6], " JavaScript_6.txt",sep="")) - - writeIATjs(type = "combined", - combined.type=combined.type, - n = n[7], - tgtType = tgtType, - tgtCol = tgtCol, - catType = catType, - catCol = catCol, - posside=possides[7,posstart], - Aside = Asides[7,Astart], - poswords = poswords, - negwords = negwords, - nPos = nPos, - nNeg = nNeg, - nA = nA, - nB = nA, - Awords = Awords, - Bwords = Bwords, - imgs=imgs, - pause=pause, - note=note, - errorpause=errorpause, - correct.error=correct.error, - norepeat=norepeat, - out = paste("Q",qids[7], " JavaScript_7.txt",sep="")) + writeIATjs( + type = "target", + combined.type = combined.type, + n = n[1], + tgtType = tgtType, + tgtCol = tgtCol, + catType = catType, + catCol = catCol, + Aside = Asides[1, Astart], + posside = possides[1, posstart], + nA = nA, + nB = nA, + Awords = Awords, + Bwords = Bwords, + poswords = poswords, + negwords = negwords, + nPos = nPos, + nNeg = nNeg, + imgs = imgs, + pause = pause, + note = note, + errorpause = errorpause, + correct.error = correct.error, + norepeat = norepeat, + out = paste("Q", qids[1], " JavaScript_1.txt", sep = "") + ) + + writeIATjs( + type = "category", + combined.type = combined.type, + n = n[2], + tgtType = tgtType, + tgtCol = tgtCol, + catType = catType, + catCol = catCol, + posside = possides[2, posstart], + Aside = Asides[2, Astart], + poswords = poswords, + negwords = negwords, + nPos = nPos, + nNeg = nNeg, + Awords = Awords, + Bwords = Bwords, + nA = nA, + nB = nB, + imgs = imgs, + pause = pause, + note = note, + errorpause = errorpause, + correct.error = correct.error, + norepeat = norepeat, + out = paste("Q", qids[2], " JavaScript_2.txt", sep = "") + ) + + writeIATjs( + type = "combined", + combined.type = combined.type, + n = n[3], + tgtType = tgtType, + tgtCol = tgtCol, + catType = catType, + catCol = catCol, + posside = possides[3, posstart], + Aside = Asides[3, Astart], + poswords = poswords, + negwords = negwords, + nPos = nPos, + nNeg = nNeg, + nA = nA, + nB = nA, + Awords = Awords, + Bwords = Bwords, + imgs = imgs, + pause = pause, + note = note, + errorpause = errorpause, + correct.error = correct.error, + norepeat = norepeat, + out = paste("Q", qids[3], " JavaScript_3.txt", sep = "") + ) + + writeIATjs( + type = "combined", + combined.type = combined.type, + n = n[4], + tgtType = tgtType, + tgtCol = tgtCol, + catType = catType, + catCol = catCol, + posside = possides[4, posstart], + Aside = Asides[4, Astart], + poswords = poswords, + negwords = negwords, + nPos = nPos, + nNeg = nNeg, + nA = nA, + nB = nA, + Awords = Awords, + Bwords = Bwords, + imgs = imgs, + pause = pause, + note = note, + errorpause = errorpause, + correct.error = correct.error, + norepeat = norepeat, + out = paste("Q", qids[4], " JavaScript_4.txt", sep = "") + ) + + # whatever swaps here--garget or category--is what block 5 type should be. Populates stimuli builder + writeIATjs( + type = swap, + combined.type = combined.type, + n = n[5], + tgtType = tgtType, + tgtCol = tgtCol, + catType = catType, + catCol = catCol, + posside = possides[5, posstart], + Aside = Asides[5, Astart], + poswords = poswords, + negwords = negwords, + nPos = nPos, + nNeg = nNeg, + Awords = Awords, + Bwords = Bwords, + nA = nA, + nB = nB, + imgs = imgs, + pause = pause, + note = note, + errorpause = errorpause, + correct.error = correct.error, + norepeat = norepeat, + out = paste("Q", qids[5], " JavaScript_5.txt", sep = "") + ) + + writeIATjs( + type = "combined", + combined.type = combined.type, + n = n[6], + tgtType = tgtType, + tgtCol = tgtCol, + catType = catType, + catCol = catCol, + posside = possides[6, posstart], + Aside = Asides[6, Astart], + poswords = poswords, + negwords = negwords, + nPos = nPos, + nNeg = nNeg, + nA = nA, + nB = nA, + Awords = Awords, + Bwords = Bwords, + imgs = imgs, + pause = pause, + note = note, + errorpause = errorpause, + correct.error = correct.error, + norepeat = norepeat, + out = paste("Q", qids[6], " JavaScript_6.txt", sep = "") + ) + + writeIATjs( + type = "combined", + combined.type = combined.type, + n = n[7], + tgtType = tgtType, + tgtCol = tgtCol, + catType = catType, + catCol = catCol, + posside = possides[7, posstart], + Aside = Asides[7, Astart], + poswords = poswords, + negwords = negwords, + nPos = nPos, + nNeg = nNeg, + nA = nA, + nB = nA, + Awords = Awords, + Bwords = Bwords, + imgs = imgs, + pause = pause, + note = note, + errorpause = errorpause, + correct.error = correct.error, + norepeat = norepeat, + out = paste("Q", qids[7], " JavaScript_7.txt", sep = "") + ) ### change the html text blocknames <- c("html_1.txt", "html_2.txt", "html_3.txt", "html_4.txt", "html_5.txt", "html_6.txt", "html_7.txt") @@ -681,9 +783,9 @@ writeIATblocks <- function(startqid=1, combined.type="alternating", foldernum=1, ## NOTE: HTML files are hard-coded with the defaults (green for targets, black for categories). Thus, these just need to be swapped out for tgtCol and catCol regardless of configuration. ## Keep the A starts right, good format from the source files - if (suffix == "rp"){ - for (i in 1:length(blocknames)){ - bltemp <- readLines(blocknames[i], warn=F) + if (suffix == "rp") { + for (i in 1:length(blocknames)) { + bltemp <- readLines(blocknames[i], warn = F) bltemp <- gsub("tgtA", Aname, bltemp) bltemp <- gsub("tgtCol", tgtCol, bltemp) bltemp <- gsub("tgtB", Bname, bltemp) @@ -694,20 +796,20 @@ writeIATblocks <- function(startqid=1, combined.type="alternating", foldernum=1, if (tolower(tgtCol) != "black" || tolower(catCol) != "black") { bltemp <- gsub("", "The label/item colors may help you identify the appropriate category.", bltemp) } - if (correct.error==T) { + if (correct.error == T) { bltemp <- gsub("", "Correct errors by hitting the other key.", bltemp) } - con <- file(paste("Q",qids[i], " ",blocknames[i],sep=""), open="wb") - writeLines(as.matrix(bltemp), con,sep="\n") + con <- file(paste("Q", qids[i], " ", blocknames[i], sep = ""), open = "wb") + writeLines(as.matrix(bltemp), con, sep = "\n") close(con) } } # A starts right, bad - if (suffix == "rn"){ - for (i in 1:length(blocknames)){ - bltemp <- readLines(blocknames[i], warn=F) + if (suffix == "rn") { + for (i in 1:length(blocknames)) { + bltemp <- readLines(blocknames[i], warn = F) bltemp <- gsub("tgtA", Aname, bltemp) bltemp <- gsub("tgtB", Bname, bltemp) bltemp <- gsub("tgtCol", tgtCol, bltemp) @@ -718,19 +820,19 @@ writeIATblocks <- function(startqid=1, combined.type="alternating", foldernum=1, if (tolower(tgtCol) != "black" || tolower(catCol) != "black") { bltemp <- gsub("", "The label/item colors may help you identify the appropriate category.", bltemp) } - if (correct.error==T) { + if (correct.error == T) { bltemp <- gsub("", "Correct errors by hitting the other key.", bltemp) } - con <- file(paste("Q",qids[i], " ",blocknames[i],sep=""), open="wb") - writeLines(as.matrix(bltemp), con,sep="\n") + con <- file(paste("Q", qids[i], " ", blocknames[i], sep = ""), open = "wb") + writeLines(as.matrix(bltemp), con, sep = "\n") close(con) } } # A starts left, bad - if (suffix == "ln"){ - for (i in 1:length(blocknames)){ - bltemp <- readLines(blocknames[i], warn=F) + if (suffix == "ln") { + for (i in 1:length(blocknames)) { + bltemp <- readLines(blocknames[i], warn = F) bltemp <- gsub("tgtA", Bname, bltemp) bltemp <- gsub("tgtB", Aname, bltemp) bltemp <- gsub("tgtCol", tgtCol, bltemp) @@ -741,19 +843,19 @@ writeIATblocks <- function(startqid=1, combined.type="alternating", foldernum=1, if (tolower(tgtCol) != "black" || tolower(catCol) != "black") { bltemp <- gsub("", "The label/item colors may help you identify the appropriate category.", bltemp) } - if (correct.error==T) { + if (correct.error == T) { bltemp <- gsub("", "Correct errors by hitting the other key.", bltemp) } - con <- file(paste("Q",qids[i], " ",blocknames[i],sep=""), open="wb") - writeLines(as.matrix(bltemp), con,sep="\n") + con <- file(paste("Q", qids[i], " ", blocknames[i], sep = ""), open = "wb") + writeLines(as.matrix(bltemp), con, sep = "\n") close(con) } } ## A starts left, good - if (suffix == "lp"){ - for (i in 1:length(blocknames)){ - bltemp <- readLines(blocknames[i], warn=F) + if (suffix == "lp") { + for (i in 1:length(blocknames)) { + bltemp <- readLines(blocknames[i], warn = F) bltemp <- gsub("tgtA", Bname, bltemp) bltemp <- gsub("tgtB", Aname, bltemp) bltemp <- gsub("tgtCol", tgtCol, bltemp) @@ -764,11 +866,11 @@ writeIATblocks <- function(startqid=1, combined.type="alternating", foldernum=1, if (tolower(tgtCol) != "black" || tolower(catCol) != "black") { bltemp <- gsub("", "The label/item colors may help you identify the appropriate category.", bltemp) } - if (correct.error==T) { + if (correct.error == T) { bltemp <- gsub("", "Correct errors by hitting the other key.", bltemp) } - con <- file(paste("Q",qids[i], " ",blocknames[i],sep=""), open="wb") - writeLines(as.matrix(bltemp), con,sep="\n") + con <- file(paste("Q", qids[i], " ", blocknames[i], sep = ""), open = "wb") + writeLines(as.matrix(bltemp), con, sep = "\n") close(con) } } @@ -783,7 +885,7 @@ writeIATblocks <- function(startqid=1, combined.type="alternating", foldernum=1, file.remove("html_5.txt") file.remove("html_6.txt") file.remove("html_7.txt") - setwd(mainDir) #revert WD back to original + setwd(mainDir) # revert WD back to original } @@ -830,277 +932,298 @@ writeIATblocks <- function(startqid=1, combined.type="alternating", foldernum=1, #' @examples \dontrun{ #' #' ### A words-only IAT with recommended settings. IAT examines insects vs. flowers -#' and is named "flowins". Recommended settings builds a QSF file automatically -#' with forced error correction and a note reminding participants of the instructions. -#' ## Note: the following are specified below for example purposes but are specified -#' by default automatically and can be omitted: coloring of stimuli, -#' number of trials per block, pause between trials. +#' # and is named "flowins". Recommended settings builds a QSF file automatically +#' # with forced error correction and a note reminding participants of the instructions. +#' ### Note: the following are specified below for example purposes but are specified +#' # by default automatically and can be omitted: coloring of stimuli, +#' # number of trials per block, pause between trials. #' -#' writeIATfull(IATname="flowins", -#' posname="Pleasant", -#' negname="Unpleasant", -#' Aname="Flowers", -#' Bname="Insects", -#' catType="words", -#' poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), -#' negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), -#' tgtType="words", -#' Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), -#' Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), +#' writeIATfull( +#' IATname = "flowins", +#' posname = "Pleasant", +#' negname = "Unpleasant", +#' Aname = "Flowers", +#' Bname = "Insects", +#' catType = "words", +#' poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), +#' negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), +#' tgtType = "words", +#' Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), +#' Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), #' -#' #advanced options with recommended IAT settings -#' n=c(20, 20, 20, 40, 40, 20, 40), -#' qsf=T, -#' note=T, -#' correct.error=T, -#' pause=250, -#' tgtCol="black", -#' catCol="green" +#' # advanced options with recommended IAT settings +#' n = c(20, 20, 20, 40, 40, 20, 40), +#' qsf = T, +#' note = T, +#' correct.error = T, +#' pause = 250, +#' tgtCol = "black", +#' catCol = "green" #' ) #' -#' ### Same IAT but with the persistent task directions disabled (\code{note=FALSE}), -#' forced error correction disabled (\code{correct.error=FALSE}) and a 300 ms pause -#' for the error message (\code{errorpause=300}). +#' ### Same IAT but with the persistent task directions disabled (\code{note=FALSE}), +#' # forced error correction disabled (\code{correct.error=FALSE}) and a 300 ms pause +#' # for the error message (\code{errorpause=300}). #' -#'writeIATfull(IATname="flowins", -#' posname="Pleasant", -#' negname="Unpleasant", -#' Aname="Flowers", -#' Bname="Insects", -#' catType="words", -#' poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), -#' negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), -#' tgtType="words", -#' Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), -#' Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), +#' writeIATfull( +#' IATname = "flowins", +#' posname = "Pleasant", +#' negname = "Unpleasant", +#' Aname = "Flowers", +#' Bname = "Insects", +#' catType = "words", +#' poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), +#' negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), +#' tgtType = "words", +#' Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), +#' Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), #' -#' #advanced options -#' n=c(20, 20, 20, 40, 40, 20, 40), -#' qsf=T, -#' note=F, -#' correct.error=F, -#' pause=250, -#' errorpause=300, -#' tgtCol="black", -#' catCol="green" -#') +#' # advanced options +#' n = c(20, 20, 20, 40, 40, 20, 40), +#' qsf = T, +#' note = F, +#' correct.error = F, +#' pause = 250, +#' errorpause = 300, +#' tgtCol = "black", +#' catCol = "green" +#' ) #' #' ### Same IAT as prior example but with 10 trials for all non-critical blocks -#' and 12 trials for all critical blocks. +#' # and 12 trials for all critical blocks. #' -#'writeIATfull(IATname="flowins", -#' posname="Pleasant", -#' negname="Unpleasant", -#' Aname="Flowers", -#' Bname="Insects", -#' catType="words", -#' poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), -#' negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), -#' tgtType="words", -#' Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), -#' Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), +#' writeIATfull( +#' IATname = "flowins", +#' posname = "Pleasant", +#' negname = "Unpleasant", +#' Aname = "Flowers", +#' Bname = "Insects", +#' catType = "words", +#' poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), +#' negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), +#' tgtType = "words", +#' Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), +#' Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), #' -#' #advanced options -#' n=c(10, 10, 10, 12, 10, 10, 12), -#' qsf=T, -#' note=F, -#' correct.error=F, -#' pause=250, -#' errorpause=300, -#' tgtCol="black", -#' catCol="green" -#') +#' # advanced options +#' n = c(10, 10, 10, 12, 10, 10, 12), +#' qsf = T, +#' note = F, +#' correct.error = F, +#' pause = 250, +#' errorpause = 300, +#' tgtCol = "black", +#' catCol = "green" +#' ) #' #' ### An images-only IAT with recommended settings. Note that image URL vectors -#' are specified first to simplify the code. -#' goodjpg <- c("www.website.com/gentle.jpg", -#' "www.website.com/enjoy.jpg", -#' "www.website.com/Heaven.jpg", -#' "www.website.com/Cheer.jpg") +#' # are specified first to simplify the code. +#' goodjpg <- c( +#' "www.website.com/gentle.jpg", +#' "www.website.com/enjoy.jpg", +#' "www.website.com/Heaven.jpg", +#' "www.website.com/Cheer.jpg" +#' ) #' -#' badjpg <- c("www.website.com/Poison.jpg", -#' "www.website.com/Evil.jpg.", -#' "www.website.com/Vomit.jpg", -#' "www.website.com/Ugly.jpg") +#' badjpg <- c( +#' "www.website.com/Poison.jpg", +#' "www.website.com/Evil.jpg.", +#' "www.website.com/Vomit.jpg", +#' "www.website.com/Ugly.jpg" +#' ) #' -#' Ajpg <- c("www.website.com/Orchid.jpg", -#' "www.website.com/Tulip.jpg", -#' "www.website.com/Rose.jpg", -#' "www.website.com/Daisy.jpg") +#' Ajpg <- c( +#' "www.website.com/Orchid.jpg", +#' "www.website.com/Tulip.jpg", +#' "www.website.com/Rose.jpg", +#' "www.website.com/Daisy.jpg" +#' ) #' -#' Bjpg <- c("www.website.com/Wasp.jpg", -#' "www.website.com/Flea.jpg", -#' "www.website.com/Moth.jpg", -#' "www.website.com/Bedbug.jpg") +#' Bjpg <- c( +#' "www.website.com/Wasp.jpg", +#' "www.website.com/Flea.jpg", +#' "www.website.com/Moth.jpg", +#' "www.website.com/Bedbug.jpg" +#' ) #' -#' writeIATfull(IATname="flowins", -#' posname="Pleasant", -#' negname="Unpleasant", -#' Aname="Flowers", -#' Bname="Insects", -#' catType="images", -#' posimgs = goodjpg, -#' negimgs = badjpg, -#' tgtType="images", -#' Aimgs = Ajpg, -#' Bimgs = Bjpg, +#' writeIATfull( +#' IATname = "flowins", +#' posname = "Pleasant", +#' negname = "Unpleasant", +#' Aname = "Flowers", +#' Bname = "Insects", +#' catType = "images", +#' posimgs = goodjpg, +#' negimgs = badjpg, +#' tgtType = "images", +#' Aimgs = Ajpg, +#' Bimgs = Bjpg, #' -#' #advanced options with recommended IAT settings -#' n=c(20, 20, 20, 40, 40, 20, 40), -#' qsf=T, -#' note=T, -#' correct.error=T, -#' pause=250, -#' tgtCol="black", -#' catCol="green" -#') +#' # advanced options with recommended IAT settings +#' n = c(20, 20, 20, 40, 40, 20, 40), +#' qsf = T, +#' note = T, +#' correct.error = T, +#' pause = 250, +#' tgtCol = "black", +#' catCol = "green" +#' ) #' #' ### Example IAT with images for categories and words for targets, with recommended settings. -#' goodjpg <- c("www.website.com/gentle.jpg", -#' "www.website.com/enjoy.jpg", -#' "www.website.com/Heaven.jpg", -#' "www.website.com/Cheer.jpg") +#' goodjpg <- c( +#' "www.website.com/gentle.jpg", +#' "www.website.com/enjoy.jpg", +#' "www.website.com/Heaven.jpg", +#' "www.website.com/Cheer.jpg" +#' ) #' -#' badjpg <- c("www.website.com/Poison.jpg", -#' "www.website.com/Evil.jpg.", -#' "www.website.com/Vomit.jpg", -#' "www.website.com/Ugly.jpg") +#' badjpg <- c( +#' "www.website.com/Poison.jpg", +#' "www.website.com/Evil.jpg.", +#' "www.website.com/Vomit.jpg", +#' "www.website.com/Ugly.jpg" +#' ) #' -#'writeIATfull(IATname="flowins", -#' posname="Pleasant", -#' negname="Unpleasant", -#' Aname="Flowers", -#' Bname="Insects", -#' catType="images", -#' posimgs = goodjpg, -#' negimgs = badjpg, -#' tgtType="words", -#' Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), -#' Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), +#' writeIATfull( +#' IATname = "flowins", +#' posname = "Pleasant", +#' negname = "Unpleasant", +#' Aname = "Flowers", +#' Bname = "Insects", +#' catType = "images", +#' posimgs = goodjpg, +#' negimgs = badjpg, +#' tgtType = "words", +#' Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), +#' Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), #' -#' #advanced options with recommended IAT settings -#' n=c(20, 20, 20, 40, 40, 20, 40), -#' qsf=T, -#' note=T, -#' correct.error=T, -#' pause=250, -#' tgtCol="black", -#' catCol="green" -#') +#' # advanced options with recommended IAT settings +#' n = c(20, 20, 20, 40, 40, 20, 40), +#' qsf = T, +#' note = T, +#' correct.error = T, +#' pause = 250, +#' tgtCol = "black", +#' catCol = "green" +#' ) #' #' ### Example IAT with images for targets and words for categories, with recommended settings. -#' Ajpg <- c("www.website.com/Orchid.jpg", -#' "www.website.com/Tulip.jpg", -#' "www.website.com/Rose.jpg", -#' "www.website.com/Daisy.jpg") +#' Ajpg <- c( +#' "www.website.com/Orchid.jpg", +#' "www.website.com/Tulip.jpg", +#' "www.website.com/Rose.jpg", +#' "www.website.com/Daisy.jpg" +#' ) #' -#' Bjpg <- c("www.website.com/Wasp.jpg", -#' "www.website.com/Flea.jpg", -#' "www.website.com/Moth.jpg", -#' "www.website.com/Bedbug.jpg") +#' Bjpg <- c( +#' "www.website.com/Wasp.jpg", +#' "www.website.com/Flea.jpg", +#' "www.website.com/Moth.jpg", +#' "www.website.com/Bedbug.jpg" +#' ) #' -#' writeIATfull(IATname="flowins", -#' posname="Pleasant", -#' negname="Unpleasant", -#' Aname="Flowers", -#' Bname="Insects", -#' catType="words", -#' poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), -#' negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), -#' tgtType="images", -#' Aimgs = Ajpg, -#' Bimgs = Bjpg, +#' writeIATfull( +#' IATname = "flowins", +#' posname = "Pleasant", +#' negname = "Unpleasant", +#' Aname = "Flowers", +#' Bname = "Insects", +#' catType = "words", +#' poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), +#' negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), +#' tgtType = "images", +#' Aimgs = Ajpg, +#' Bimgs = Bjpg, #' -#' #advanced options with recommended IAT settings -#' n=c(20, 20, 20, 40, 40, 20, 40), -#' qsf=T, -#' note=T, -#' correct.error=T, -#' pause=250, -#' tgtCol="black", -#' catCol="green" -#') +#' # advanced options with recommended IAT settings +#' n = c(20, 20, 20, 40, 40, 20, 40), +#' qsf = T, +#' note = T, +#' correct.error = T, +#' pause = 250, +#' tgtCol = "black", +#' catCol = "green" +#' ) #' #' ### EXAMPLE IAT USING 'norepeat=TRUE" TO SUPPRESS REPEAT STIMULI UNTIL ALL STIMULI -#' FROM THAT CATEGORY HAVE BEEN SEEN +#' # FROM THAT CATEGORY HAVE BEEN SEEN #' -#'#'writeIATfull(IATname="flowins", -#' posname="Pleasant", -#' negname="Unpleasant", -#' Aname="Flowers", -#' Bname="Insects", -#' catType="words", -#' poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), -#' negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), -#' tgtType="words", -#' Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), -#' Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), +#' writeIATfull( +#' IATname = "flowins", +#' posname = "Pleasant", +#' negname = "Unpleasant", +#' Aname = "Flowers", +#' Bname = "Insects", +#' catType = "words", +#' poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), +#' negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), +#' tgtType = "words", +#' Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), +#' Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), #' -#' #advanced options -#' n=c(20, 20, 20, 40, 40, 20, 40), -#' qsf=T, -#' note=F, -#' correct.error=F, -#' pause=250, -#' errorpause=300, -#' tgtCol="black", -#' catCol="green", -#' norepeat=TRUE -#') +#' # advanced options +#' n = c(20, 20, 20, 40, 40, 20, 40), +#' qsf = T, +#' note = F, +#' correct.error = F, +#' pause = 250, +#' errorpause = 300, +#' tgtCol = "black", +#' catCol = "green", +#' norepeat = TRUE +#' ) #' } -writeIATfull <- function(IATname="IAT", +writeIATfull <- function(IATname = "IAT", posname, negname, Aname, Bname, - n=c(20,20,20,40,40,20,40), + n = c(20, 20, 20, 40, 40, 20, 40), catType, - catCol="green", + catCol = "green", poswords, negwords, posimgs, negimgs, tgtType, - tgtCol="black", + tgtCol = "black", Awords, Bwords, Aimgs, Bimgs, - swap="target", - qsf=FALSE, - pause=250, - errorpause=300, - correct.error=TRUE, - note=FALSE, - norepeat=FALSE, - startqid = 1 -) { - - ##IF FORCED ERROR CORRECTION, MAKE ERRORPAUSE THE SAME AS THE REGULAR PAUSE + swap = "target", + qsf = FALSE, + pause = 250, + errorpause = 300, + correct.error = TRUE, + note = FALSE, + norepeat = FALSE, + startqid = 1) { + ## IF FORCED ERROR CORRECTION, MAKE ERRORPAUSE THE SAME AS THE REGULAR PAUSE # NOTE: ERRORPAUSE IS USED TO HANDLE ISI FOR ERROR TRIALS. IF FORCED ERROR CORRECTION, # WE WANT TO USE THE SAME PAUSE REGARDLESS OF ERROR OR NOT - if (correct.error==T){ + if (correct.error == T) { errorpause <- pause } - if ((tgtType != "images") & (tgtType != "words")){ + if ((tgtType != "images") & (tgtType != "words")) { stop("tgtType argument is not correctly specified.") } - if ((catType != "images") & (catType != "words")){ + if ((catType != "images") & (catType != "words")) { stop("catType argument is not correctly specified.") } - if (length(n) != 7){ + if (length(n) != 7) { stop("n argument is not correctly specified. You must provide the number of trials for all seven blocks.") } - if (swap!="target" & swap!="category") { + if (swap != "target" & swap != "category") { stop("the 'swap' argument is inccorectly specified. It must say either 'target' or 'category'") - } + } ## BY DEFAULT, IMPLEMENTS THE EASY IMAGE METHOD. nA, nB, nPos, and nNeg not specified by user in this version. Pulls that information from image URL vectors directly. - if(tgtType == "images" & catType == "words") { + if (tgtType == "images" & catType == "words") { # add error message if there are not appropriately specified images imgs <- c(Aimgs, Bimgs) nA <- length(Aimgs) @@ -1110,7 +1233,7 @@ writeIATfull <- function(IATname="IAT", } - if(tgtType == "images" & catType == "images") { + if (tgtType == "images" & catType == "images") { # add error message if there are not appropriately specified images imgs <- c(posimgs, negimgs, Aimgs, Bimgs) nA <- length(Aimgs) @@ -1119,14 +1242,14 @@ writeIATfull <- function(IATname="IAT", nNeg <- length(negimgs) } - if(tgtType == "words" & catType == "words") { + if (tgtType == "words" & catType == "words") { nA <- 0 nB <- 0 nPos <- 0 nNeg <- 0 } - if(tgtType == "words" & catType == "images") { + if (tgtType == "words" & catType == "images") { # add error message if there are not appropriately specified images imgs <- c(posimgs, negimgs) nPos <- length(posimgs) @@ -1135,62 +1258,68 @@ writeIATfull <- function(IATname="IAT", nB <- 0 } - #Enforce this to prevent errors + # Enforce this to prevent errors # May not be needed in v10 and up; keep for backwards compatibility - if(qsf==T){ + if (qsf == T) { startqid <- 1 } # not modifiable to user in v10. combined.type <- "alternating" - writeIATblocks(startqid=startqid, posstart="right", Astart="right", IATname=IATname, foldernum=1, n=n, - posname = posname, negname = negname, Aname = Aname, Bname = Bname, - catType = catType, catCol=catCol, poswords = poswords, negwords = negwords, nPos = nPos, nNeg = nNeg, - tgtType = tgtType, tgtCol=tgtCol, Awords = Awords, Bwords = Bwords, nA = nA, nB = nB, - swap=swap, - pause=pause, errorpause=errorpause, correct.error=correct.error, combined.type=combined.type, norepeat=norepeat, note=note, imgs = imgs) - - writeIATblocks(startqid=(startqid+7), posstart="left", Astart="right", IATname=IATname, foldernum=2, n=n, - posname = posname, negname = negname, Aname = Aname, Bname = Bname, - catType = catType, catCol=catCol, poswords = poswords, negwords = negwords, nPos = nPos, nNeg = nNeg, - tgtType = tgtType, tgtCol=tgtCol, Awords = Awords, Bwords = Bwords, nA = nA, nB = nB, - swap=swap, - pause=pause, errorpause=errorpause, correct.error=correct.error, combined.type=combined.type, norepeat=norepeat, note=note, imgs = imgs) - - writeIATblocks(startqid=(startqid+14), posstart="left", Astart="left", IATname=IATname, foldernum=3, n=n, - posname = posname, negname = negname, Aname = Aname, Bname = Bname, - catType = catType, catCol=catCol, poswords = poswords, negwords = negwords, nPos = nPos, nNeg = nNeg, - tgtType = tgtType, tgtCol=tgtCol, Awords = Awords, Bwords = Bwords, nA = nA, nB = nB, - swap=swap, - pause=pause, errorpause=errorpause, correct.error=correct.error, combined.type=combined.type, norepeat=norepeat, note=note, imgs = imgs) - - writeIATblocks(startqid=(startqid+21), posstart="right", Astart="left", IATname=IATname, foldernum=4, n=n, - posname = posname, negname = negname, Aname = Aname, Bname = Bname, - catType = catType, catCol=catCol, poswords = poswords, negwords = negwords, nPos = nPos, nNeg = nNeg, - tgtType = tgtType, tgtCol=tgtCol, Awords = Awords, Bwords = Bwords, nA = nA, nB = nB, - swap=swap, - pause=pause, errorpause=errorpause, correct.error=correct.error, combined.type=combined.type, norepeat=norepeat, note=note, imgs = imgs) + writeIATblocks( + startqid = startqid, posstart = "right", Astart = "right", IATname = IATname, foldernum = 1, n = n, + posname = posname, negname = negname, Aname = Aname, Bname = Bname, + catType = catType, catCol = catCol, poswords = poswords, negwords = negwords, nPos = nPos, nNeg = nNeg, + tgtType = tgtType, tgtCol = tgtCol, Awords = Awords, Bwords = Bwords, nA = nA, nB = nB, + swap = swap, + pause = pause, errorpause = errorpause, correct.error = correct.error, combined.type = combined.type, norepeat = norepeat, note = note, imgs = imgs + ) + + writeIATblocks( + startqid = (startqid + 7), posstart = "left", Astart = "right", IATname = IATname, foldernum = 2, n = n, + posname = posname, negname = negname, Aname = Aname, Bname = Bname, + catType = catType, catCol = catCol, poswords = poswords, negwords = negwords, nPos = nPos, nNeg = nNeg, + tgtType = tgtType, tgtCol = tgtCol, Awords = Awords, Bwords = Bwords, nA = nA, nB = nB, + swap = swap, + pause = pause, errorpause = errorpause, correct.error = correct.error, combined.type = combined.type, norepeat = norepeat, note = note, imgs = imgs + ) + + writeIATblocks( + startqid = (startqid + 14), posstart = "left", Astart = "left", IATname = IATname, foldernum = 3, n = n, + posname = posname, negname = negname, Aname = Aname, Bname = Bname, + catType = catType, catCol = catCol, poswords = poswords, negwords = negwords, nPos = nPos, nNeg = nNeg, + tgtType = tgtType, tgtCol = tgtCol, Awords = Awords, Bwords = Bwords, nA = nA, nB = nB, + swap = swap, + pause = pause, errorpause = errorpause, correct.error = correct.error, combined.type = combined.type, norepeat = norepeat, note = note, imgs = imgs + ) + + writeIATblocks( + startqid = (startqid + 21), posstart = "right", Astart = "left", IATname = IATname, foldernum = 4, n = n, + posname = posname, negname = negname, Aname = Aname, Bname = Bname, + catType = catType, catCol = catCol, poswords = poswords, negwords = negwords, nPos = nPos, nNeg = nNeg, + tgtType = tgtType, tgtCol = tgtCol, Awords = Awords, Bwords = Bwords, nA = nA, nB = nB, + swap = swap, + pause = pause, errorpause = errorpause, correct.error = correct.error, combined.type = combined.type, norepeat = norepeat, note = note, imgs = imgs + ) ## if qsf argument is true, make a qsf file ## Thanks to Michal Kouril for this incredible code! - if(qsf==T){ - - - #code below uses lowercase + if (qsf == T) { + # code below uses lowercase iatname <- IATname - #copy the template file to the wd - file.copy(system.file("codefiles", "FullTemplate_-_For_Shiny_V11.qsf", package="iatgen"), file.path(getwd())) + # copy the template file to the wd + file.copy(system.file("codefiles", "FullTemplate_-_For_Shiny_V11.qsf", package = "iatgen"), file.path(getwd())) - filename = function() { - paste('iat-', iatname, '.qsf', sep='') + filename <- function() { + paste("iat-", iatname, ".qsf", sep = "") } - qsfTemplate="FullTemplate_-_For_Shiny_V11.qsf" + qsfTemplate <- "FullTemplate_-_For_Shiny_V11.qsf" # library(jsonlite) # require(jsonlite) @@ -1199,18 +1328,20 @@ writeIATfull <- function(IATname="IAT", q$SurveyName <- iatname q$SurveyEntry$SurveyName <- iatname - files=c(paste("1 ",iatname,"_rp", sep=''), - paste("2 ",iatname,"_rn", sep=''), - paste("3 ",iatname,"_lp", sep=''), - paste("4 ",iatname,"_ln", sep='')) + files <- c( + paste("1 ", iatname, "_rp", sep = ""), + paste("2 ", iatname, "_rn", sep = ""), + paste("3 ", iatname, "_lp", sep = ""), + paste("4 ", iatname, "_ln", sep = "") + ) filecontent <- c() - txtfiles <- list.files(path=files, pattern="*.txt", full.names=T, recursive=T) + txtfiles <- list.files(path = files, pattern = "*.txt", full.names = T, recursive = T) cat(toJSON(txtfiles)) lapply(txtfiles, function(x) { - cat(paste("reading file:",x,"\n")) - t <- readChar(x,file.info(x)$size) # load file + cat(paste("reading file:", x, "\n")) + t <- readChar(x, file.info(x)$size) # load file k <- gsub("^.*/(Q[0-9]+) ([hJ]).*$", "\\1\\2", x) filecontent[[k]] <<- t }) @@ -1225,9 +1356,9 @@ writeIATfull <- function(IATname="IAT", if (!(m == 0)) { # q$SurveyElements$Payload[i][[1]]$DataExportTag qnumber <- gsub("^(Q[0-9]+) [RL][NP][0-9]$", "\\1", q$SurveyElements$Payload[i][[1]]$DataExportTag) - qnumberhtml <- paste(qnumber,'h',sep="") - qnumberjs <- paste(qnumber,'J',sep="") - paste(qnumberhtml,qnumberjs) + qnumberhtml <- paste(qnumber, "h", sep = "") + qnumberjs <- paste(qnumber, "J", sep = "") + paste(qnumberhtml, qnumberjs) q$SurveyElements$Payload[i][[1]]$QuestionText <- filecontent[[qnumberhtml]] q$SurveyElements$Payload[i][[1]]$QuestionJS <- filecontent[[qnumberjs]] } else { @@ -1241,9 +1372,9 @@ writeIATfull <- function(IATname="IAT", m <- length(grep("Q[0-9]+ [RL][NP][0-9]", q$SurveyElements$Payload$DataExportTag[i])) if (!(m == 0)) { qnumber <- gsub("^(Q[0-9]+) [RL][NP][0-9]$", "\\1", q$SurveyElements$Payload$DataExportTag[i]) - qnumberhtml <- paste(qnumber,'h',sep="") - qnumberjs <- paste(qnumber,'J',sep="") - paste(qnumberhtml,qnumberjs) + qnumberhtml <- paste(qnumber, "h", sep = "") + qnumberjs <- paste(qnumber, "J", sep = "") + paste(qnumberhtml, qnumberjs) q$SurveyElements$Payload$QuestionText[i] <- filecontent[[qnumberhtml]] q$SurveyElements$Payload$QuestionJS[i] <- filecontent[[qnumberjs]] } @@ -1251,38 +1382,20 @@ writeIATfull <- function(IATname="IAT", } cat("Generating JSON....\n") - qjson <- toJSON(q,null="null",auto_unbox=T) + qjson <- toJSON(q, null = "null", auto_unbox = T) minify(qjson) - con <- file(filename(), open="wb") + con <- file(filename(), open = "wb") write(qjson, con) close(con) - #remove template + # remove template file.remove("FullTemplate_-_For_Shiny_V11.qsf") - #remove HTML and JavaScript folders if QSF + # remove HTML and JavaScript folders if QSF unlink(files[1], recursive = T) unlink(files[2], recursive = T) unlink(files[3], recursive = T) unlink(files[4], recursive = T) } - } - - - - - - - - - - - - - - - - - diff --git a/man/cleanIAT.Rd b/man/cleanIAT.Rd index 8be634d..d295634 100644 --- a/man/cleanIAT.Rd +++ b/man/cleanIAT.Rd @@ -127,24 +127,29 @@ Prior to running, please see \code{combineIATfourblocks()}. This function proces \dontrun{ ### CLEAN THE IAT USING THE BUILT IN ERROR PENALTY FOR FORCED-ERROR CORRECTION ### -clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, - dat$incompatible.prac, dat$incompatible.crit) +clean <- cleanIAT( + dat$compatible.prac, dat$compatible.crit, + dat$incompatible.prac, dat$incompatible.crit +) ### CLEAN THE IAT USING THE D600 PROCEDURE ### clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, - dat$incompatible.prac, dat$incompatible.crit, - error.penalty=TRUE, error.penalty.ms=600) + dat$incompatible.prac, dat$incompatible.crit, + error.penalty = TRUE, error.penalty.ms = 600 +) ### CLEAN THE IAT USING THE D2SD PROCEDURE### clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, - dat$incompatible.prac, dat$incompatible.crit, - error.penalty=TRUE, error.penalty.ms = "2SD") + dat$incompatible.prac, dat$incompatible.crit, + error.penalty = TRUE, error.penalty.ms = "2SD" +) ### CLEAN THE IAT USING THE D2SD PROCEDURE WITH TRIALS UNDER 400 MS DROPPED ### clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, - dat$incompatible.prac, dat$incompatible.crit, - fastprt.drop=FALSE, fasttrial.drop=TRUE, fasttrial.ms=400, - error.penalty=TRUE, error.penalty.ms = "2SD") + dat$incompatible.prac, dat$incompatible.crit, + fastprt.drop = FALSE, fasttrial.drop = TRUE, fasttrial.ms = 400, + error.penalty = TRUE, error.penalty.ms = "2SD" +) ### EXAMINE CLEAN IAT SCORES clean$D diff --git a/man/writeIATfull.Rd b/man/writeIATfull.Rd index dfbe526..5142251 100644 --- a/man/writeIATfull.Rd +++ b/man/writeIATfull.Rd @@ -96,222 +96,245 @@ This is the primary function for building IATs. It has two modes. In automatic m \dontrun{ ### A words-only IAT with recommended settings. IAT examines insects vs. flowers - and is named "flowins". Recommended settings builds a QSF file automatically - with forced error correction and a note reminding participants of the instructions. -## Note: the following are specified below for example purposes but are specified - by default automatically and can be omitted: coloring of stimuli, - number of trials per block, pause between trials. - -writeIATfull(IATname="flowins", - posname="Pleasant", - negname="Unpleasant", - Aname="Flowers", - Bname="Insects", - catType="words", - poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), - negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), - tgtType="words", - Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), - Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), - - #advanced options with recommended IAT settings - n=c(20, 20, 20, 40, 40, 20, 40), - qsf=T, - note=T, - correct.error=T, - pause=250, - tgtCol="black", - catCol="green" +# and is named "flowins". Recommended settings builds a QSF file automatically +# with forced error correction and a note reminding participants of the instructions. +### Note: the following are specified below for example purposes but are specified +# by default automatically and can be omitted: coloring of stimuli, +# number of trials per block, pause between trials. + +writeIATfull( + IATname = "flowins", + posname = "Pleasant", + negname = "Unpleasant", + Aname = "Flowers", + Bname = "Insects", + catType = "words", + poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), + negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), + tgtType = "words", + Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), + Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), + + # advanced options with recommended IAT settings + n = c(20, 20, 20, 40, 40, 20, 40), + qsf = T, + note = T, + correct.error = T, + pause = 250, + tgtCol = "black", + catCol = "green" ) - ### Same IAT but with the persistent task directions disabled (\code{note=FALSE}), - forced error correction disabled (\code{correct.error=FALSE}) and a 300 ms pause - for the error message (\code{errorpause=300}). - -writeIATfull(IATname="flowins", - posname="Pleasant", - negname="Unpleasant", - Aname="Flowers", - Bname="Insects", - catType="words", - poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), - negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), - tgtType="words", - Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), - Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), - - #advanced options - n=c(20, 20, 20, 40, 40, 20, 40), - qsf=T, - note=F, - correct.error=F, - pause=250, - errorpause=300, - tgtCol="black", - catCol="green" +### Same IAT but with the persistent task directions disabled (\code{note=FALSE}), +# forced error correction disabled (\code{correct.error=FALSE}) and a 300 ms pause +# for the error message (\code{errorpause=300}). + +writeIATfull( + IATname = "flowins", + posname = "Pleasant", + negname = "Unpleasant", + Aname = "Flowers", + Bname = "Insects", + catType = "words", + poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), + negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), + tgtType = "words", + Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), + Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), + + # advanced options + n = c(20, 20, 20, 40, 40, 20, 40), + qsf = T, + note = F, + correct.error = F, + pause = 250, + errorpause = 300, + tgtCol = "black", + catCol = "green" ) ### Same IAT as prior example but with 10 trials for all non-critical blocks - and 12 trials for all critical blocks. - -writeIATfull(IATname="flowins", - posname="Pleasant", - negname="Unpleasant", - Aname="Flowers", - Bname="Insects", - catType="words", - poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), - negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), - tgtType="words", - Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), - Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), - - #advanced options - n=c(10, 10, 10, 12, 10, 10, 12), - qsf=T, - note=F, - correct.error=F, - pause=250, - errorpause=300, - tgtCol="black", - catCol="green" +# and 12 trials for all critical blocks. + +writeIATfull( + IATname = "flowins", + posname = "Pleasant", + negname = "Unpleasant", + Aname = "Flowers", + Bname = "Insects", + catType = "words", + poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), + negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), + tgtType = "words", + Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), + Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), + + # advanced options + n = c(10, 10, 10, 12, 10, 10, 12), + qsf = T, + note = F, + correct.error = F, + pause = 250, + errorpause = 300, + tgtCol = "black", + catCol = "green" ) ### An images-only IAT with recommended settings. Note that image URL vectors - are specified first to simplify the code. -goodjpg <- c("www.website.com/gentle.jpg", - "www.website.com/enjoy.jpg", - "www.website.com/Heaven.jpg", - "www.website.com/Cheer.jpg") - -badjpg <- c("www.website.com/Poison.jpg", - "www.website.com/Evil.jpg.", - "www.website.com/Vomit.jpg", - "www.website.com/Ugly.jpg") - -Ajpg <- c("www.website.com/Orchid.jpg", - "www.website.com/Tulip.jpg", - "www.website.com/Rose.jpg", - "www.website.com/Daisy.jpg") - -Bjpg <- c("www.website.com/Wasp.jpg", - "www.website.com/Flea.jpg", - "www.website.com/Moth.jpg", - "www.website.com/Bedbug.jpg") - -writeIATfull(IATname="flowins", - posname="Pleasant", - negname="Unpleasant", - Aname="Flowers", - Bname="Insects", - catType="images", - posimgs = goodjpg, - negimgs = badjpg, - tgtType="images", - Aimgs = Ajpg, - Bimgs = Bjpg, - - #advanced options with recommended IAT settings - n=c(20, 20, 20, 40, 40, 20, 40), - qsf=T, - note=T, - correct.error=T, - pause=250, - tgtCol="black", - catCol="green" +# are specified first to simplify the code. +goodjpg <- c( + "www.website.com/gentle.jpg", + "www.website.com/enjoy.jpg", + "www.website.com/Heaven.jpg", + "www.website.com/Cheer.jpg" +) + +badjpg <- c( + "www.website.com/Poison.jpg", + "www.website.com/Evil.jpg.", + "www.website.com/Vomit.jpg", + "www.website.com/Ugly.jpg" +) + +Ajpg <- c( + "www.website.com/Orchid.jpg", + "www.website.com/Tulip.jpg", + "www.website.com/Rose.jpg", + "www.website.com/Daisy.jpg" +) + +Bjpg <- c( + "www.website.com/Wasp.jpg", + "www.website.com/Flea.jpg", + "www.website.com/Moth.jpg", + "www.website.com/Bedbug.jpg" +) + +writeIATfull( + IATname = "flowins", + posname = "Pleasant", + negname = "Unpleasant", + Aname = "Flowers", + Bname = "Insects", + catType = "images", + posimgs = goodjpg, + negimgs = badjpg, + tgtType = "images", + Aimgs = Ajpg, + Bimgs = Bjpg, + + # advanced options with recommended IAT settings + n = c(20, 20, 20, 40, 40, 20, 40), + qsf = T, + note = T, + correct.error = T, + pause = 250, + tgtCol = "black", + catCol = "green" ) ### Example IAT with images for categories and words for targets, with recommended settings. -goodjpg <- c("www.website.com/gentle.jpg", - "www.website.com/enjoy.jpg", - "www.website.com/Heaven.jpg", - "www.website.com/Cheer.jpg") - -badjpg <- c("www.website.com/Poison.jpg", - "www.website.com/Evil.jpg.", - "www.website.com/Vomit.jpg", - "www.website.com/Ugly.jpg") - -writeIATfull(IATname="flowins", - posname="Pleasant", - negname="Unpleasant", - Aname="Flowers", - Bname="Insects", - catType="images", - posimgs = goodjpg, - negimgs = badjpg, - tgtType="words", - Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), - Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), - - #advanced options with recommended IAT settings - n=c(20, 20, 20, 40, 40, 20, 40), - qsf=T, - note=T, - correct.error=T, - pause=250, - tgtCol="black", - catCol="green" +goodjpg <- c( + "www.website.com/gentle.jpg", + "www.website.com/enjoy.jpg", + "www.website.com/Heaven.jpg", + "www.website.com/Cheer.jpg" +) + +badjpg <- c( + "www.website.com/Poison.jpg", + "www.website.com/Evil.jpg.", + "www.website.com/Vomit.jpg", + "www.website.com/Ugly.jpg" +) + +writeIATfull( + IATname = "flowins", + posname = "Pleasant", + negname = "Unpleasant", + Aname = "Flowers", + Bname = "Insects", + catType = "images", + posimgs = goodjpg, + negimgs = badjpg, + tgtType = "words", + Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), + Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), + + # advanced options with recommended IAT settings + n = c(20, 20, 20, 40, 40, 20, 40), + qsf = T, + note = T, + correct.error = T, + pause = 250, + tgtCol = "black", + catCol = "green" ) ### Example IAT with images for targets and words for categories, with recommended settings. -Ajpg <- c("www.website.com/Orchid.jpg", - "www.website.com/Tulip.jpg", - "www.website.com/Rose.jpg", - "www.website.com/Daisy.jpg") - -Bjpg <- c("www.website.com/Wasp.jpg", - "www.website.com/Flea.jpg", - "www.website.com/Moth.jpg", - "www.website.com/Bedbug.jpg") - -writeIATfull(IATname="flowins", - posname="Pleasant", - negname="Unpleasant", - Aname="Flowers", - Bname="Insects", - catType="words", - poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), - negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), - tgtType="images", - Aimgs = Ajpg, - Bimgs = Bjpg, - - #advanced options with recommended IAT settings - n=c(20, 20, 20, 40, 40, 20, 40), - qsf=T, - note=T, - correct.error=T, - pause=250, - tgtCol="black", - catCol="green" +Ajpg <- c( + "www.website.com/Orchid.jpg", + "www.website.com/Tulip.jpg", + "www.website.com/Rose.jpg", + "www.website.com/Daisy.jpg" +) + +Bjpg <- c( + "www.website.com/Wasp.jpg", + "www.website.com/Flea.jpg", + "www.website.com/Moth.jpg", + "www.website.com/Bedbug.jpg" +) + +writeIATfull( + IATname = "flowins", + posname = "Pleasant", + negname = "Unpleasant", + Aname = "Flowers", + Bname = "Insects", + catType = "words", + poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), + negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), + tgtType = "images", + Aimgs = Ajpg, + Bimgs = Bjpg, + + # advanced options with recommended IAT settings + n = c(20, 20, 20, 40, 40, 20, 40), + qsf = T, + note = T, + correct.error = T, + pause = 250, + tgtCol = "black", + catCol = "green" ) ### EXAMPLE IAT USING 'norepeat=TRUE" TO SUPPRESS REPEAT STIMULI UNTIL ALL STIMULI - FROM THAT CATEGORY HAVE BEEN SEEN - -#'writeIATfull(IATname="flowins", - posname="Pleasant", - negname="Unpleasant", - Aname="Flowers", - Bname="Insects", - catType="words", - poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), - negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), - tgtType="words", - Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), - Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), - - #advanced options - n=c(20, 20, 20, 40, 40, 20, 40), - qsf=T, - note=F, - correct.error=F, - pause=250, - errorpause=300, - tgtCol="black", - catCol="green", - norepeat=TRUE +# FROM THAT CATEGORY HAVE BEEN SEEN + +writeIATfull( + IATname = "flowins", + posname = "Pleasant", + negname = "Unpleasant", + Aname = "Flowers", + Bname = "Insects", + catType = "words", + poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), + negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), + tgtType = "words", + Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), + Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), + + # advanced options + n = c(20, 20, 20, 40, 40, 20, 40), + qsf = T, + note = F, + correct.error = F, + pause = 250, + errorpause = 300, + tgtCol = "black", + catCol = "green", + norepeat = TRUE ) } } diff --git a/tests/testthat/test-analyze.R b/tests/testthat/test-analyze.R index 85ca348..7cf1676 100644 --- a/tests/testthat/test-analyze.R +++ b/tests/testthat/test-analyze.R @@ -2,9 +2,9 @@ context("analyze csv output") test_that("Function to import and analyze csv", { filename <- "iat_small.csv" - allContent <- readLines(filename, encoding="UTF-8") - allContent = allContent[-2] - dat = read.csv(textConnection(allContent), header = TRUE, stringsAsFactors = FALSE) + allContent <- readLines(filename, encoding = "UTF-8") + allContent <- allContent[-2] + dat <- read.csv(textConnection(allContent), header = TRUE, stringsAsFactors = FALSE) suppressWarnings( @@ -20,8 +20,10 @@ test_that("Function to import and analyze csv", { dat$incompatible.prac <- combineIATfourblocks(dat$Q6.RP6, dat$Q20.LP6, dat$Q10.RN3, dat$Q24.LN3) ) - clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, - dat$incompatible.prac, dat$incompatible.crit) + clean <- cleanIAT( + dat$compatible.prac, dat$compatible.crit, + dat$incompatible.prac, dat$incompatible.crit + ) - expect_true(all(round(clean$D,6) == c(0.536744, -0.520029 ))) + expect_equal(as.numeric(round(clean$D, 6)), c(0.536744, -0.520029)) }) diff --git a/tests/testthat/test-cleaniat-noprac.R b/tests/testthat/test-cleaniat-noprac.R new file mode 100644 index 0000000..f664e47 --- /dev/null +++ b/tests/testthat/test-cleaniat-noprac.R @@ -0,0 +1,27 @@ +context("analyze csv output") + +test_that("Function to import and analyze csv", { + filename <- "iat_small.csv" + allContent <- readLines(filename, encoding = "UTF-8") + allContent <- allContent[-2] + dat <- read.csv(textConnection(allContent), header = TRUE, stringsAsFactors = FALSE) + + + suppressWarnings( + dat$compatible.crit <- combineIATfourblocks(dat$Q4.RP4, dat$Q18.LP4, dat$Q14.RN7, dat$Q28.LN7) + ) + suppressWarnings( + dat$incompatible.crit <- combineIATfourblocks(dat$Q7.RP7, dat$Q21.LP7, dat$Q11.RN4, dat$Q25.LN4) + ) + suppressWarnings( + dat$compatible.prac <- combineIATfourblocks(dat$Q3.RP3, dat$Q17.LP3, dat$Q13.RN6, dat$Q27.LN6) + ) + suppressWarnings( + dat$incompatible.prac <- combineIATfourblocks(dat$Q6.RP6, dat$Q20.LP6, dat$Q10.RN3, dat$Q24.LN3) + ) + + clean <- cleanIAT.noprac(dat$compatible.crit, dat$incompatible.crit) + + expect_equal(as.numeric(round(clean$D, 6)), c(0.210920, -0.249192)) +}) + diff --git a/tests/testthat/test-iatalpha.R b/tests/testthat/test-iatalpha.R new file mode 100644 index 0000000..7aa2970 --- /dev/null +++ b/tests/testthat/test-iatalpha.R @@ -0,0 +1,30 @@ +context("alpha") + +test_that("IATalpha", { + filename <- "iat_small.csv" + allContent <- readLines(filename, encoding = "UTF-8") + allContent <- allContent[-2] + dat <- read.csv(textConnection(allContent), header = TRUE, stringsAsFactors = FALSE) + + suppressWarnings( + dat$compatible.crit <- combineIATfourblocks(dat$Q4.RP4, dat$Q18.LP4, dat$Q14.RN7, dat$Q28.LN7) + ) + suppressWarnings( + dat$incompatible.crit <- combineIATfourblocks(dat$Q7.RP7, dat$Q21.LP7, dat$Q11.RN4, dat$Q25.LN4) + ) + suppressWarnings( + dat$compatible.prac <- combineIATfourblocks(dat$Q3.RP3, dat$Q17.LP3, dat$Q13.RN6, dat$Q27.LN6) + ) + suppressWarnings( + dat$incompatible.prac <- combineIATfourblocks(dat$Q6.RP6, dat$Q20.LP6, dat$Q10.RN3, dat$Q24.LN3) + ) + + clean <- cleanIAT( + dat$compatible.prac, dat$compatible.crit, + dat$incompatible.prac, dat$incompatible.crit + ) + + alpha <- IATalpha(clean) + alpha_total <- as.numeric(alpha$alpha.total) + expect_equal(round(alpha_total, 4), 0.9444) +}) diff --git a/tests/testthat/test-iatreliability.R b/tests/testthat/test-iatreliability.R index c0d1ba2..0371ed4 100644 --- a/tests/testthat/test-iatreliability.R +++ b/tests/testthat/test-iatreliability.R @@ -2,9 +2,9 @@ context("reliability") test_that("IATreliability", { filename <- "iat_small.csv" - allContent <- readLines(filename, encoding="UTF-8") - allContent = allContent[-2] - dat = read.csv(textConnection(allContent), header = TRUE, stringsAsFactors = FALSE) + allContent <- readLines(filename, encoding = "UTF-8") + allContent <- allContent[-2] + dat <- read.csv(textConnection(allContent), header = TRUE, stringsAsFactors = FALSE) suppressWarnings( dat$compatible.crit <- combineIATfourblocks(dat$Q4.RP4, dat$Q18.LP4, dat$Q14.RN7, dat$Q28.LN7) @@ -19,9 +19,11 @@ test_that("IATreliability", { dat$incompatible.prac <- combineIATfourblocks(dat$Q6.RP6, dat$Q20.LP6, dat$Q10.RN3, dat$Q24.LN3) ) - clean <- cleanIAT(dat$compatible.prac, dat$compatible.crit, - dat$incompatible.prac, dat$incompatible.crit) + clean <- cleanIAT( + dat$compatible.prac, dat$compatible.crit, + dat$incompatible.prac, dat$incompatible.crit + ) reliability <- IATreliability(clean) - expect_true(round(reliability$reliability,4) == 1) + expect_equal(round(reliability$reliability, 4), 1) }) diff --git a/tests/testthat/test-parcel.R b/tests/testthat/test-parcel.R new file mode 100644 index 0000000..b0c5988 --- /dev/null +++ b/tests/testthat/test-parcel.R @@ -0,0 +1,30 @@ +context("alpha") + +test_that("IATalpha", { + filename <- "iat_small.csv" + allContent <- readLines(filename, encoding = "UTF-8") + allContent <- allContent[-2] + dat <- read.csv(textConnection(allContent), header = TRUE, stringsAsFactors = FALSE) + + suppressWarnings( + dat$compatible.crit <- combineIATfourblocks(dat$Q4.RP4, dat$Q18.LP4, dat$Q14.RN7, dat$Q28.LN7) + ) + suppressWarnings( + dat$incompatible.crit <- combineIATfourblocks(dat$Q7.RP7, dat$Q21.LP7, dat$Q11.RN4, dat$Q25.LN4) + ) + suppressWarnings( + dat$compatible.prac <- combineIATfourblocks(dat$Q3.RP3, dat$Q17.LP3, dat$Q13.RN6, dat$Q27.LN6) + ) + suppressWarnings( + dat$incompatible.prac <- combineIATfourblocks(dat$Q6.RP6, dat$Q20.LP6, dat$Q10.RN3, dat$Q24.LN3) + ) + + clean <- cleanIAT( + dat$compatible.prac, dat$compatible.crit, + dat$incompatible.prac, dat$incompatible.crit + ) + + parcel <- parcelIAT(clean) + expect_equal(as.numeric(round(parcel[1,], 4)), c(-1.0826, -0.2992, -0.4367, -0.1931)) +}) + diff --git a/tests/testthat/test-qsf.R b/tests/testthat/test-qsf.R index f5e1004..a69b6d0 100644 --- a/tests/testthat/test-qsf.R +++ b/tests/testthat/test-qsf.R @@ -1,28 +1,27 @@ context("build qsf process") test_that("Function to create qsf", { -writeIATfull(IATname="flowins", - posname="Pleasant", - negname="Unpleasant", - Aname="Flowers", - Bname="Insects", - catType="words", - poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), - negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), - tgtType="words", - Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), - Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), + writeIATfull( + IATname = "flowins", + posname = "Pleasant", + negname = "Unpleasant", + Aname = "Flowers", + Bname = "Insects", + catType = "words", + poswords = c("Gentle", "Enjoy", "Heaven", "Cheer", "Happy", "Love", "Friend"), + negwords = c("Poison", "Evil", "Gloom", "Damage", "Vomit", "Ugly", "Hurt"), + tgtType = "words", + Awords = c("Orchid", "Tulip", "Rose", "Daffodil", "Daisy", "Lilac", "Lily"), + Bwords = c("Wasp", "Flea", "Roach", "Centipede", "Moth", "Bedbug", "Gnat"), - #advanced options with recommended IAT settings - n=c(20, 20, 20, 40, 40, 20, 40), - qsf=T, - note=T, - correct.error=T, - pause=250, - tgtCol="black", - catCol="green" -) + # advanced options with recommended IAT settings + n = c(20, 20, 20, 40, 40, 20, 40), + qsf = T, + note = T, + correct.error = T, + pause = 250, + tgtCol = "black", + catCol = "green" + ) expect_true("iat-flowins.qsf" %in% list.files()) }) - -