1 Experiment details

2 Set up R environment

library(tidyverse)
library(ggplot2)
library(ggpubr)
library(plyr)
library(magick)
library(rstatix)
library(reshape2)
library(knitr)
library(lme4)
library(psycho)
library(Hmisc)

Make sure you’re in the right directory. Set the R working drectory to the main experiment directory, which is where this markdown is saved, along with any supporting material and raw data, which are stored as a subdirectory.

setwd("/Users/adambarnas/Box/MeridianCB")  

3 Read-in and manipulate datafiles

Read in the individual subject files (saved automatically on the server as csv files).

tbl_all <- list.files(path = "./data_v4/", pattern = "*.csv", full.names = T) %>% 
    map_df(~read_csv(.))
tbl_all <- data.frame(tbl_all)

Confirm the number of subjects and make sure the sample sizes reflects the number of data files in the data subdirectory.

nrow(tbl_all %>% distinct(workerId,.keep_all = FALSE))
## [1] 36

Next, define trial conditions by breaking apart the name of the image, given by objs_image column.

tbl_all <- tbl_all %>% 
separate(objs_image,into=c('change_or_no_change','rectangle_orientation','cue_loc','change_loc','validity','display_num'))

For clarity, rename all the variable values that are now given by the change_or_no_change and validity variable.

tbl_all <- tbl_all %>% mutate(change_or_no_change = recode_factor(change_or_no_change, `C`="change", `NC`="no_change"))

tbl_all <- tbl_all %>% mutate(validity = case_when(trial_number <= 10 & validity == "C" ~ "practice_catch",
                              trial_number > 10 & validity == "C" ~ "catch",
                              validity == "P" ~ "practice_main",  
                              validity == "V" ~ "valid",
                              validity == "IS" ~ "invalid_same",
                              validity == "ID" ~ "invalid_different"))

Let’s also assign the trials to bins based on the trial number. The practice trials (the first 10 for each subject) will be labeled “0” since they are not factored into any analyses.

tbl_all$bin = "filler"
tbl_all[which(tbl_all$trial_number %in% c(1:10)), "bin"] = 0
tbl_all[which(tbl_all$trial_number %in% c(11:36)), "bin"] = 1
tbl_all[which(tbl_all$trial_number %in% c(37:62)), "bin"] = 2
tbl_all[which(tbl_all$trial_number %in% c(63:88)), "bin"] = 3
tbl_all[which(tbl_all$trial_number %in% c(89:114)), "bin"] = 4
tbl_all[which(tbl_all$trial_number %in% c(115:140)), "bin"] = 5
tbl_all[which(tbl_all$trial_number %in% c(141:166)), "bin"] = 6
tbl_all[which(tbl_all$trial_number %in% c(167:192)), "bin"] = 7
tbl_all[which(tbl_all$trial_number %in% c(193:218)), "bin"] = 8

tbl_all$bin <- as.numeric(tbl_all$bin)
#class(tbl_all$bin)

Save raw data

write.csv(tbl_all,'version_4_raw_data.csv', row.names=FALSE)

** This table contains the number of change trials for each individual.** There were 120 change trials that were 60% valid (72 trials) and 40% invalid (24 trials for each type). There were also 36 change catch trials. The numbers of each trial type were split evenly among the 4 cue locations. The last variable, “sum”, is the total number of change trials saved for each participant. There were 156 change trials.

tbl_all_change_counts <- tbl_all %>%
  group_by(workerId,validity) %>%
  filter(change_or_no_change == "change" & (validity=='valid' | validity=='invalid_same' | validity=='invalid_different' | validity=='catch')) %>%
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts)
tbl_all_change_counts$change_total_sum = rowSums(tbl_all_change_counts[,c(-1)], na.rm = TRUE)
kable(tbl_all_change_counts)
workerId catch invalid_different invalid_same valid change_total_sum
A11PIARI7WALAX 36 24 24 72 156
A15RTRQ5YO6AUS 36 24 24 72 156
A16SJ5D3DKUEXJ 36 24 24 72 156
A170WD5QOT5KF5 36 24 24 72 156
A1969Q0R4Y0E3J 36 24 24 72 156
A1H2UHJ78F185L 36 24 24 72 156
A1TSVP4XC9NTR4 36 24 24 72 156
A1UCDLTUO7FES9 36 24 24 72 156
A1UOG38V6W8SF6 36 24 24 72 156
A1WNV787CX1ORQ 36 24 24 72 156
A2615YW1YERQBO 36 24 24 72 156
A2DZW5E52SJ93H 36 24 24 72 156
A2EXYEEMGDETEM 36 24 24 72 156
A2GZ00IMOT6L3X 36 24 24 72 156
A2JZUSRBP6H5S 36 24 24 72 156
A2LVCS009DMEAT 36 24 24 72 156
A2QP9ZGIW4R7C2 36 24 24 72 156
A2UHVW63V1CMD1 36 24 24 72 156
A2Z8F2UEJ9N75M 36 24 24 72 156
A31JM9RECQGYEX 36 24 24 72 156
A3C2X1L5PVNNLV 36 24 24 72 156
A3JVLFHF518XR9 36 24 23 72 155
A3LC8JT9NKNKN 36 24 24 72 156
A3OSQTN7GCA5D6 36 24 24 72 156
A3R7L5UI9IEWGD 36 24 24 72 156
A3V4SRRO18ELMV 36 24 23 72 155
A7O82NXM2PI12 36 24 24 72 156
A8BGHKGBA8O33 36 24 24 72 156
A8T5YVT0QXTCY 36 24 24 72 156
ACBSHAUF2NJVJ 36 24 24 72 156
AIX7Y732EMEBL 36 24 24 72 156
AKTWA4NBCUQMV 36 24 24 72 156
ANPCXN619ACW9 36 24 24 72 156
AOS2PVHT2HYTL 36 24 24 72 156
ASDVZRY6J7P5Z 36 24 24 72 156
AXB10LDNM2V3N 36 24 24 72 156

The change trial counts can also be binned over time.

tbl_all_change_counts_bin <- tbl_all %>%
  group_by(workerId,validity,bin) %>%
  filter(change_or_no_change == "change" & (validity=='valid' | validity=='invalid_same' | validity=='invalid_different' | validity=='catch')) %>%
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts)
tbl_all_change_counts_bin[is.na(tbl_all_change_counts_bin)] <- 0
tbl_all_change_counts_bin$sum = rowSums(tbl_all_change_counts_bin[,c(-1:-2)], na.rm = TRUE)
#kable(tbl_all_change_counts_bin)

** This table contains the number of no-change trials for each individual.** There were 12 no-change catch trials and 40 no-change main trials. The numbers of each trial type were split evenly among the 4 cue locations. The last variable, “sum”, is the total number of change trials saved for each participant.

tbl_all_no_change_counts <- tbl_all %>%
  group_by(workerId,validity) %>%
  filter(change_or_no_change == "no_change" & (validity == "valid" | validity == "catch")) %>%
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts)
tbl_all_no_change_counts$no_change_total = rowSums(tbl_all_no_change_counts[,c(-1)], na.rm = TRUE)
colnames(tbl_all_no_change_counts) <- c("workerId", "catch", "main", "no_change_total")
kable(tbl_all_no_change_counts)
workerId catch main no_change_total
A11PIARI7WALAX 12 40 52
A15RTRQ5YO6AUS 12 40 52
A16SJ5D3DKUEXJ 12 40 52
A170WD5QOT5KF5 12 40 52
A1969Q0R4Y0E3J 12 40 52
A1H2UHJ78F185L 12 40 52
A1TSVP4XC9NTR4 12 40 52
A1UCDLTUO7FES9 12 40 52
A1UOG38V6W8SF6 12 40 52
A1WNV787CX1ORQ 12 40 52
A2615YW1YERQBO 12 40 52
A2DZW5E52SJ93H 12 40 52
A2EXYEEMGDETEM 12 40 52
A2GZ00IMOT6L3X 12 40 52
A2JZUSRBP6H5S 12 40 52
A2LVCS009DMEAT 12 40 52
A2QP9ZGIW4R7C2 12 40 52
A2UHVW63V1CMD1 12 40 52
A2Z8F2UEJ9N75M 12 40 52
A31JM9RECQGYEX 12 40 52
A3C2X1L5PVNNLV 12 40 52
A3JVLFHF518XR9 12 40 52
A3LC8JT9NKNKN 12 40 52
A3OSQTN7GCA5D6 12 40 52
A3R7L5UI9IEWGD 12 40 52
A3V4SRRO18ELMV 12 40 52
A7O82NXM2PI12 12 40 52
A8BGHKGBA8O33 12 40 52
A8T5YVT0QXTCY 12 40 52
ACBSHAUF2NJVJ 12 40 52
AIX7Y732EMEBL 12 40 52
AKTWA4NBCUQMV 12 40 52
ANPCXN619ACW9 12 40 52
AOS2PVHT2HYTL 12 40 52
ASDVZRY6J7P5Z 12 40 52
AXB10LDNM2V3N 12 40 52

The no-change trial counts can also be binned over time.

tbl_all_no_change_counts_bin <- tbl_all %>%
  group_by(workerId,validity,bin) %>%
  filter(change_or_no_change == "no_change" & (validity == "valid" | validity == "catch")) %>%
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts)
tbl_all_no_change_counts_bin[is.na(tbl_all_no_change_counts_bin)] <- 0
colnames(tbl_all_no_change_counts_bin) <- c("workerId", "bin", "catch", "main")
#kable(tbl_all_no_change_counts_bin)

Calculate the number of change main trials, excuding catch trials. Also split the number of catch trials over time.

tbl_all_change_counts_no_catch <- tbl_all %>%
  group_by(workerId,validity) %>%
  filter(change_or_no_change == "change" & (validity=='valid' | validity=='invalid_same' | validity=='invalid_different')) %>%
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts)
tbl_all_change_counts_no_catch$sum = rowSums(tbl_all_change_counts_no_catch[,c(-1)], na.rm = TRUE)
#kable(tbl_all_change_counts_no_catch)

tbl_all_change_counts_no_catch_bin <- tbl_all %>%
  group_by(workerId,validity,bin) %>%
  filter(change_or_no_change == "change" & (validity=='valid' | validity=='invalid_same' | validity=='invalid_different')) %>%
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts)
tbl_all_change_counts_no_catch_bin[is.na(tbl_all_change_counts_no_catch_bin)] <- 0
tbl_all_change_counts_no_catch_bin$sum = rowSums(tbl_all_change_counts_no_catch_bin[,c(-1:-2)], na.rm = TRUE)
#kable(tbl_all_change_counts_no_catch_bin)

The data are loaded. Next, look at the quality of the data by examining the accuracy.

4 Analyze accuracy

The changing object could appear in four possible locations. Subjects were instructed to press ‘F’ if there was a changing object and to press ‘J’ if there was no changing object. Trials are labeled 1 for correct responses (‘F’ on change trials and ‘J’ on no-change trials) or 0 for incorrect responses (‘J’ on change trials and ‘F’ on no-change trials).

tbl_all$acc = "filler"

for (i in 1:length(tbl_all$workerId)){
  if (tbl_all$change_or_no_change[i] == "change"){
    if (tbl_all$key[i] == "F"){
      tbl_all$acc[i] = 1
  } else {
      tbl_all$acc[i] = 0
  }
} else {
    if (tbl_all$key[i] == "J"){
      tbl_all$acc[i] = 1
  } else {
      tbl_all$acc[i] = 0
  }
}
}

tbl_all_change_acc <- tbl_all %>%
  filter(change_or_no_change == "change")

tbl_all_no_change_acc <- tbl_all %>%
  filter(change_or_no_change == "no_change")

4.1 Accuracy on catch trials

Sum the number of good catch trials (1) to get the total number of accurate catch trials per subject. There were 48 total catch trials. Change catch trials consisted of one object always changing to a letter. No-change catch trials consisted of one object that did not change.

tbl_good_catch_acc_all_main_acc_counts_1 <- tbl_all %>%
  filter(validity=='catch')
tbl_good_catch_acc_all_main_acc_counts_1 <- tbl_good_catch_acc_all_main_acc_counts_1 %>%
  group_by(workerId,change_or_no_change,acc) %>%
  dplyr::summarize(counts = n()) %>%
  spread(acc,counts)
tbl_good_catch_acc_all_main_acc_counts_1[is.na(tbl_good_catch_acc_all_main_acc_counts_1)] <- 0
tbl_good_catch_acc_all_main_acc_counts_1$total = rowSums(tbl_good_catch_acc_all_main_acc_counts_1[,c(-1,-2)], na.rm = TRUE)
colnames(tbl_good_catch_acc_all_main_acc_counts_1) <- c("workerId", "change_or_no_change", "inacc_catch", "acc_catch", "total_catch")
kable(tbl_good_catch_acc_all_main_acc_counts_1)
workerId change_or_no_change inacc_catch acc_catch total_catch
A11PIARI7WALAX change 0 36 36
A11PIARI7WALAX no_change 2 10 12
A15RTRQ5YO6AUS change 16 20 36
A15RTRQ5YO6AUS no_change 6 6 12
A16SJ5D3DKUEXJ change 1 35 36
A16SJ5D3DKUEXJ no_change 1 11 12
A170WD5QOT5KF5 change 36 0 36
A170WD5QOT5KF5 no_change 0 12 12
A1969Q0R4Y0E3J change 0 36 36
A1969Q0R4Y0E3J no_change 2 10 12
A1H2UHJ78F185L change 2 34 36
A1H2UHJ78F185L no_change 1 11 12
A1TSVP4XC9NTR4 change 19 17 36
A1TSVP4XC9NTR4 no_change 5 7 12
A1UCDLTUO7FES9 change 15 21 36
A1UCDLTUO7FES9 no_change 3 9 12
A1UOG38V6W8SF6 change 14 22 36
A1UOG38V6W8SF6 no_change 5 7 12
A1WNV787CX1ORQ change 2 34 36
A1WNV787CX1ORQ no_change 6 6 12
A2615YW1YERQBO change 2 34 36
A2615YW1YERQBO no_change 1 11 12
A2DZW5E52SJ93H change 0 36 36
A2DZW5E52SJ93H no_change 3 9 12
A2EXYEEMGDETEM change 26 10 36
A2EXYEEMGDETEM no_change 3 9 12
A2GZ00IMOT6L3X change 3 33 36
A2GZ00IMOT6L3X no_change 2 10 12
A2JZUSRBP6H5S change 2 34 36
A2JZUSRBP6H5S no_change 3 9 12
A2LVCS009DMEAT change 26 10 36
A2LVCS009DMEAT no_change 4 8 12
A2QP9ZGIW4R7C2 change 1 35 36
A2QP9ZGIW4R7C2 no_change 10 2 12
A2UHVW63V1CMD1 change 23 13 36
A2UHVW63V1CMD1 no_change 6 6 12
A2Z8F2UEJ9N75M change 19 17 36
A2Z8F2UEJ9N75M no_change 5 7 12
A31JM9RECQGYEX change 9 27 36
A31JM9RECQGYEX no_change 2 10 12
A3C2X1L5PVNNLV change 19 17 36
A3C2X1L5PVNNLV no_change 6 6 12
A3JVLFHF518XR9 change 2 34 36
A3JVLFHF518XR9 no_change 2 10 12
A3LC8JT9NKNKN change 3 33 36
A3LC8JT9NKNKN no_change 2 10 12
A3OSQTN7GCA5D6 change 21 15 36
A3OSQTN7GCA5D6 no_change 5 7 12
A3R7L5UI9IEWGD change 8 28 36
A3R7L5UI9IEWGD no_change 1 11 12
A3V4SRRO18ELMV change 9 27 36
A3V4SRRO18ELMV no_change 10 2 12
A7O82NXM2PI12 change 23 13 36
A7O82NXM2PI12 no_change 2 10 12
A8BGHKGBA8O33 change 3 33 36
A8BGHKGBA8O33 no_change 1 11 12
A8T5YVT0QXTCY change 8 28 36
A8T5YVT0QXTCY no_change 11 1 12
ACBSHAUF2NJVJ change 12 24 36
ACBSHAUF2NJVJ no_change 5 7 12
AIX7Y732EMEBL change 36 0 36
AIX7Y732EMEBL no_change 0 12 12
AKTWA4NBCUQMV change 17 19 36
AKTWA4NBCUQMV no_change 8 4 12
ANPCXN619ACW9 change 5 31 36
ANPCXN619ACW9 no_change 1 11 12
AOS2PVHT2HYTL change 5 31 36
AOS2PVHT2HYTL no_change 2 10 12
ASDVZRY6J7P5Z change 1 35 36
ASDVZRY6J7P5Z no_change 12 0 12
AXB10LDNM2V3N change 21 15 36
AXB10LDNM2V3N no_change 4 8 12
tbl_good_catch_acc_all_main_acc_counts_2 <- tbl_all %>%
  filter(validity=='catch')
tbl_good_catch_acc_all_main_acc_counts_2 <- tbl_good_catch_acc_all_main_acc_counts_2 %>%
  group_by(workerId,acc) %>%
  dplyr::summarize(counts = n()) %>%
  spread(acc,counts)
tbl_good_catch_acc_all_main_acc_counts_2[is.na(tbl_good_catch_acc_all_main_acc_counts_2)] <- 0
tbl_good_catch_acc_all_main_acc_counts_2$total = rowSums(tbl_good_catch_acc_all_main_acc_counts_2[,c(-1)], na.rm = TRUE)
colnames(tbl_good_catch_acc_all_main_acc_counts_2) <- c("workerId", "inacc_catch", "acc_catch", "total_catch")
kable(tbl_good_catch_acc_all_main_acc_counts_2)
workerId inacc_catch acc_catch total_catch
A11PIARI7WALAX 2 46 48
A15RTRQ5YO6AUS 22 26 48
A16SJ5D3DKUEXJ 2 46 48
A170WD5QOT5KF5 36 12 48
A1969Q0R4Y0E3J 2 46 48
A1H2UHJ78F185L 3 45 48
A1TSVP4XC9NTR4 24 24 48
A1UCDLTUO7FES9 18 30 48
A1UOG38V6W8SF6 19 29 48
A1WNV787CX1ORQ 8 40 48
A2615YW1YERQBO 3 45 48
A2DZW5E52SJ93H 3 45 48
A2EXYEEMGDETEM 29 19 48
A2GZ00IMOT6L3X 5 43 48
A2JZUSRBP6H5S 5 43 48
A2LVCS009DMEAT 30 18 48
A2QP9ZGIW4R7C2 11 37 48
A2UHVW63V1CMD1 29 19 48
A2Z8F2UEJ9N75M 24 24 48
A31JM9RECQGYEX 11 37 48
A3C2X1L5PVNNLV 25 23 48
A3JVLFHF518XR9 4 44 48
A3LC8JT9NKNKN 5 43 48
A3OSQTN7GCA5D6 26 22 48
A3R7L5UI9IEWGD 9 39 48
A3V4SRRO18ELMV 19 29 48
A7O82NXM2PI12 25 23 48
A8BGHKGBA8O33 4 44 48
A8T5YVT0QXTCY 19 29 48
ACBSHAUF2NJVJ 17 31 48
AIX7Y732EMEBL 36 12 48
AKTWA4NBCUQMV 25 23 48
ANPCXN619ACW9 6 42 48
AOS2PVHT2HYTL 7 41 48
ASDVZRY6J7P5Z 13 35 48
AXB10LDNM2V3N 25 23 48

Divide the number of accurate catch trials by the number of total catch trials for each participant. The resulting value will be the subjects catch trial rate.

  • change_catch_rate = performance on change catch trials (pressing ‘F’ when object changes to letter)

  • no_change_catch_rate = performance on no-change catch trials (pressing ‘J’ when object does not change)

  • mean_catch_rate = average of change_catch_rate and no_change_catch_rate

  • cumulative_catch_rate = sum performance on all accurate catch trials (change and no-change) and dividing by the total number of catch trials (48)

tbl_all_catch_acc_rate_1 <- (tbl_good_catch_acc_all_main_acc_counts_1$acc_catch / tbl_good_catch_acc_all_main_acc_counts_1$total_catch)
tbl_all_catch_acc_rate_1 <- cbind.data.frame(tbl_good_catch_acc_all_main_acc_counts_1[,1:2], tbl_all_catch_acc_rate_1)
colnames(tbl_all_catch_acc_rate_1) <- c("workerId", "change_or_no_change", "catch_rate")
tbl_all_catch_acc_rate_1 <- spread(tbl_all_catch_acc_rate_1, change_or_no_change, catch_rate)
tbl_all_catch_acc_rate_1$catch_rate = rowMeans(tbl_all_catch_acc_rate_1[,c(-1)], na.rm = TRUE)
colnames(tbl_all_catch_acc_rate_1) <- c("workerId", "change_catch_rate", "no_change_catch_rate", "mean_catch_rate")
#kable(tbl_all_catch_acc_rate_1)

tbl_all_catch_acc_rate_2 <- (tbl_good_catch_acc_all_main_acc_counts_2$acc_catch / tbl_good_catch_acc_all_main_acc_counts_2$total_catch)
tbl_all_catch_acc_rate_2 <- cbind.data.frame(tbl_good_catch_acc_all_main_acc_counts_2[,1], tbl_all_catch_acc_rate_2)
colnames(tbl_all_catch_acc_rate_2) <- c("workerId", "cumulative_catch_rate")
#kable(tbl_all_catch_acc_rate_2)

tbl_all_catch_acc_rate <- cbind.data.frame(tbl_all_catch_acc_rate_1, tbl_all_catch_acc_rate_2[2])
kable(tbl_all_catch_acc_rate)
workerId change_catch_rate no_change_catch_rate mean_catch_rate cumulative_catch_rate
A11PIARI7WALAX 1.0000000 0.8333333 0.9166667 0.9583333
A15RTRQ5YO6AUS 0.5555556 0.5000000 0.5277778 0.5416667
A16SJ5D3DKUEXJ 0.9722222 0.9166667 0.9444444 0.9583333
A170WD5QOT5KF5 0.0000000 1.0000000 0.5000000 0.2500000
A1969Q0R4Y0E3J 1.0000000 0.8333333 0.9166667 0.9583333
A1H2UHJ78F185L 0.9444444 0.9166667 0.9305556 0.9375000
A1TSVP4XC9NTR4 0.4722222 0.5833333 0.5277778 0.5000000
A1UCDLTUO7FES9 0.5833333 0.7500000 0.6666667 0.6250000
A1UOG38V6W8SF6 0.6111111 0.5833333 0.5972222 0.6041667
A1WNV787CX1ORQ 0.9444444 0.5000000 0.7222222 0.8333333
A2615YW1YERQBO 0.9444444 0.9166667 0.9305556 0.9375000
A2DZW5E52SJ93H 1.0000000 0.7500000 0.8750000 0.9375000
A2EXYEEMGDETEM 0.2777778 0.7500000 0.5138889 0.3958333
A2GZ00IMOT6L3X 0.9166667 0.8333333 0.8750000 0.8958333
A2JZUSRBP6H5S 0.9444444 0.7500000 0.8472222 0.8958333
A2LVCS009DMEAT 0.2777778 0.6666667 0.4722222 0.3750000
A2QP9ZGIW4R7C2 0.9722222 0.1666667 0.5694444 0.7708333
A2UHVW63V1CMD1 0.3611111 0.5000000 0.4305556 0.3958333
A2Z8F2UEJ9N75M 0.4722222 0.5833333 0.5277778 0.5000000
A31JM9RECQGYEX 0.7500000 0.8333333 0.7916667 0.7708333
A3C2X1L5PVNNLV 0.4722222 0.5000000 0.4861111 0.4791667
A3JVLFHF518XR9 0.9444444 0.8333333 0.8888889 0.9166667
A3LC8JT9NKNKN 0.9166667 0.8333333 0.8750000 0.8958333
A3OSQTN7GCA5D6 0.4166667 0.5833333 0.5000000 0.4583333
A3R7L5UI9IEWGD 0.7777778 0.9166667 0.8472222 0.8125000
A3V4SRRO18ELMV 0.7500000 0.1666667 0.4583333 0.6041667
A7O82NXM2PI12 0.3611111 0.8333333 0.5972222 0.4791667
A8BGHKGBA8O33 0.9166667 0.9166667 0.9166667 0.9166667
A8T5YVT0QXTCY 0.7777778 0.0833333 0.4305556 0.6041667
ACBSHAUF2NJVJ 0.6666667 0.5833333 0.6250000 0.6458333
AIX7Y732EMEBL 0.0000000 1.0000000 0.5000000 0.2500000
AKTWA4NBCUQMV 0.5277778 0.3333333 0.4305556 0.4791667
ANPCXN619ACW9 0.8611111 0.9166667 0.8888889 0.8750000
AOS2PVHT2HYTL 0.8611111 0.8333333 0.8472222 0.8541667
ASDVZRY6J7P5Z 0.9722222 0.0000000 0.4861111 0.7291667
AXB10LDNM2V3N 0.4166667 0.6666667 0.5416667 0.4791667
tbl_all_catch_acc_rate_long <- gather(tbl_all_catch_acc_rate, type, rate, change_catch_rate:cumulative_catch_rate, factor_key=TRUE)

Plot the group’s overall accuracy on the catch trials.

tbl_all_catch_acc_rate_long %>%
  ggbarplot(y = "rate", x = "type", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", add = "mean_se", ylim = c(0, 1), xlab = "Group", width = 0.5, label = TRUE, lab.nb.digits = 2, lab.vjust = -2, title = "Group Catch Performance", font.xtickslab = 10)

Let’s also take a look at each individual subject’s catch trial performance rate.

tbl_all_catch_acc_rate_long %>%
  filter (type == "change_catch_rate") %>% 
  ggbarplot(x = "workerId", y = "rate", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", ylim = c(0, 1), title = "Individual Change Catch Trial Performance", sort.val = c("asc"), font.xtickslab = 8) + rotate_x_text()+ geom_hline(yintercept = 0.5, linetype = 2)

tbl_all_catch_acc_rate_long %>%
  filter (type == "no_change_catch_rate") %>% 
  ggbarplot(x = "workerId", y = "rate", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", ylim = c(0, 1), title = "Individual No-change Catch Trial Performance", sort.val = c("asc"), font.xtickslab = 8) + rotate_x_text()+ geom_hline(yintercept = 0.5, linetype = 2)

tbl_all_catch_acc_rate_long %>%
  filter (type == "mean_catch_rate") %>% 
  ggbarplot(x = "workerId", y = "rate", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", ylim = c(0, 1), title = "Individual Mean Catch Trial Performance", sort.val = c("asc"), font.xtickslab = 8) + rotate_x_text()+ geom_hline(yintercept = 0.5, linetype = 2)

tbl_all_catch_acc_rate_long %>%
  filter (type == "cumulative_catch_rate") %>% 
  ggbarplot(x = "workerId", y = "rate", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", ylim = c(0, 1), title = "Individual Cumulative Catch Trial Performance", sort.val = c("asc"), font.xtickslab = 8) + rotate_x_text()+ geom_hline(yintercept = 0.5, linetype = 2)

4.2 Accuracy on change trials

For the rest of the analyses, focus on the participants with good catch rate performance. Select the subjects with good catch trial rates from the original tbl_all.

#tbl_good_catch_acc_all_main_acc <- tbl_all[(tbl_all$workerId %in% tbl_good_catch_acc_rate$workerId),]
tbl_good_catch_acc_all_main_acc <- tbl_all[(tbl_all$workerId %in% tbl_all_catch_acc_rate$workerId),]

Verify subject count.

nrow(tbl_good_catch_acc_all_main_acc %>% distinct(workerId,.keep_all = FALSE))
## [1] 36

Here, is a table containing the number of trials for each individual after excluding main trials based on accuracy. Again, there were 120 change main trials that were 60% valid (72 trials) and 40% invalid (24 trials for each type). This chunk will also bin the counts in a separate table.

tbl_good_catch_acc_all_main_acc_counts <- tbl_good_catch_acc_all_main_acc %>%
  filter(change_or_no_change == "change" & (validity=='valid' | validity=='invalid_same' | validity=='invalid_different')) %>%
  group_by(workerId,validity, .drop=FALSE) %>%
  filter(acc == 1, .preserve = TRUE) %>% 
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts, fill = 0)
tbl_good_catch_acc_all_main_acc_counts[is.na(tbl_good_catch_acc_all_main_acc_counts)] <- 0
tbl_good_catch_acc_all_main_acc_counts$sum = rowSums(tbl_good_catch_acc_all_main_acc_counts[,c(-1)], na.rm = TRUE)
kable(tbl_good_catch_acc_all_main_acc_counts)
workerId invalid_different invalid_same valid sum
A11PIARI7WALAX 20 23 65 108
A15RTRQ5YO6AUS 12 10 33 55
A16SJ5D3DKUEXJ 13 14 55 82
A170WD5QOT5KF5 0 0 0 0
A1969Q0R4Y0E3J 20 18 65 103
A1H2UHJ78F185L 8 6 33 47
A1TSVP4XC9NTR4 12 12 34 58
A1UCDLTUO7FES9 13 12 39 64
A1UOG38V6W8SF6 7 10 28 45
A1WNV787CX1ORQ 9 10 27 46
A2615YW1YERQBO 9 8 58 75
A2DZW5E52SJ93H 15 15 53 83
A2EXYEEMGDETEM 17 11 46 74
A2GZ00IMOT6L3X 10 8 46 64
A2JZUSRBP6H5S 19 21 65 105
A2LVCS009DMEAT 1 4 18 23
A2QP9ZGIW4R7C2 0 0 0 0
A2UHVW63V1CMD1 19 14 36 69
A2Z8F2UEJ9N75M 3 8 36 47
A31JM9RECQGYEX 23 16 50 89
A3C2X1L5PVNNLV 8 8 24 40
A3JVLFHF518XR9 11 14 47 72
A3LC8JT9NKNKN 9 12 42 63
A3OSQTN7GCA5D6 10 12 25 47
A3R7L5UI9IEWGD 14 11 51 76
A3V4SRRO18ELMV 18 18 56 92
A7O82NXM2PI12 2 3 69 74
A8BGHKGBA8O33 3 10 57 70
A8T5YVT0QXTCY 23 21 63 107
ACBSHAUF2NJVJ 10 13 37 60
AIX7Y732EMEBL 0 0 0 0
AKTWA4NBCUQMV 18 17 47 82
ANPCXN619ACW9 0 0 68 68
AOS2PVHT2HYTL 0 2 65 67
ASDVZRY6J7P5Z 23 22 71 116
AXB10LDNM2V3N 14 9 40 63
tbl_good_catch_acc_all_main_acc_counts_bin <- tbl_good_catch_acc_all_main_acc %>%
  filter(bin != 0) %>%
  group_by(workerId,validity,bin, .drop=FALSE) %>%
  filter(change_or_no_change == "change" & (validity=='valid' | validity=='invalid_same' | validity=='invalid_different') & acc == 1, .preserve = TRUE) %>%
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts)
tbl_good_catch_acc_all_main_acc_counts_bin[is.na(tbl_good_catch_acc_all_main_acc_counts_bin)] <- 0
tbl_good_catch_acc_all_main_acc_counts_bin$sum = rowSums(tbl_good_catch_acc_all_main_acc_counts_bin[,c(-1:-2)], na.rm = TRUE)

And let’s check the number of subjects we are now working with.

nrow(tbl_good_catch_acc_all_main_acc_counts %>% distinct(workerId,.keep_all = FALSE))
## [1] 36

Get the original number of trials for the relevant subjects.

tbl_good_catch_acc_all_main_acc_counts_original <- tbl_all_change_counts_no_catch[(tbl_all_change_counts_no_catch$workerId %in% tbl_good_catch_acc_all_main_acc_counts$workerId),]
kable(tbl_good_catch_acc_all_main_acc_counts_original)
workerId invalid_different invalid_same valid sum
A11PIARI7WALAX 24 24 72 120
A15RTRQ5YO6AUS 24 24 72 120
A16SJ5D3DKUEXJ 24 24 72 120
A170WD5QOT5KF5 24 24 72 120
A1969Q0R4Y0E3J 24 24 72 120
A1H2UHJ78F185L 24 24 72 120
A1TSVP4XC9NTR4 24 24 72 120
A1UCDLTUO7FES9 24 24 72 120
A1UOG38V6W8SF6 24 24 72 120
A1WNV787CX1ORQ 24 24 72 120
A2615YW1YERQBO 24 24 72 120
A2DZW5E52SJ93H 24 24 72 120
A2EXYEEMGDETEM 24 24 72 120
A2GZ00IMOT6L3X 24 24 72 120
A2JZUSRBP6H5S 24 24 72 120
A2LVCS009DMEAT 24 24 72 120
A2QP9ZGIW4R7C2 24 24 72 120
A2UHVW63V1CMD1 24 24 72 120
A2Z8F2UEJ9N75M 24 24 72 120
A31JM9RECQGYEX 24 24 72 120
A3C2X1L5PVNNLV 24 24 72 120
A3JVLFHF518XR9 24 23 72 119
A3LC8JT9NKNKN 24 24 72 120
A3OSQTN7GCA5D6 24 24 72 120
A3R7L5UI9IEWGD 24 24 72 120
A3V4SRRO18ELMV 24 23 72 119
A7O82NXM2PI12 24 24 72 120
A8BGHKGBA8O33 24 24 72 120
A8T5YVT0QXTCY 24 24 72 120
ACBSHAUF2NJVJ 24 24 72 120
AIX7Y732EMEBL 24 24 72 120
AKTWA4NBCUQMV 24 24 72 120
ANPCXN619ACW9 24 24 72 120
AOS2PVHT2HYTL 24 24 72 120
ASDVZRY6J7P5Z 24 24 72 120
AXB10LDNM2V3N 24 24 72 120

Plot the overall accuracy at the group level (collasped across workerId and condition).

tbl_overall_good_acc <- (tbl_good_catch_acc_all_main_acc_counts$sum / tbl_good_catch_acc_all_main_acc_counts_original$sum)
tbl_overall_good_acc <- cbind.data.frame(tbl_good_catch_acc_all_main_acc_counts[,1], tbl_overall_good_acc)
colnames(tbl_overall_good_acc) <- c("workerId", "change_main_rate")
kable(tbl_overall_good_acc)
workerId change_main_rate
A11PIARI7WALAX 0.9000000
A15RTRQ5YO6AUS 0.4583333
A16SJ5D3DKUEXJ 0.6833333
A170WD5QOT5KF5 0.0000000
A1969Q0R4Y0E3J 0.8583333
A1H2UHJ78F185L 0.3916667
A1TSVP4XC9NTR4 0.4833333
A1UCDLTUO7FES9 0.5333333
A1UOG38V6W8SF6 0.3750000
A1WNV787CX1ORQ 0.3833333
A2615YW1YERQBO 0.6250000
A2DZW5E52SJ93H 0.6916667
A2EXYEEMGDETEM 0.6166667
A2GZ00IMOT6L3X 0.5333333
A2JZUSRBP6H5S 0.8750000
A2LVCS009DMEAT 0.1916667
A2QP9ZGIW4R7C2 0.0000000
A2UHVW63V1CMD1 0.5750000
A2Z8F2UEJ9N75M 0.3916667
A31JM9RECQGYEX 0.7416667
A3C2X1L5PVNNLV 0.3333333
A3JVLFHF518XR9 0.6050420
A3LC8JT9NKNKN 0.5250000
A3OSQTN7GCA5D6 0.3916667
A3R7L5UI9IEWGD 0.6333333
A3V4SRRO18ELMV 0.7731092
A7O82NXM2PI12 0.6166667
A8BGHKGBA8O33 0.5833333
A8T5YVT0QXTCY 0.8916667
ACBSHAUF2NJVJ 0.5000000
AIX7Y732EMEBL 0.0000000
AKTWA4NBCUQMV 0.6833333
ANPCXN619ACW9 0.5666667
AOS2PVHT2HYTL 0.5583333
ASDVZRY6J7P5Z 0.9666667
AXB10LDNM2V3N 0.5250000
tbl_overall_good_acc %>% 
  ggbarplot(y = "change_main_rate", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", add = "mean_se", ylim = c(0, 1), xlab = "Group", width = 0.5, label = TRUE, lab.nb.digits = 2, lab.vjust = -2, title = "Main Trial Accuracy")

4.2.0.1 Main trial accuracy relative to chance performance

chance <- t.test(tbl_overall_good_acc$change_main_rate, mu = .50, alternative="greater")
chance
## 
##  One Sample t-test
## 
## data:  tbl_overall_good_acc$change_main_rate
## t = 1.0158, df = 35, p-value = 0.1584
## alternative hypothesis: true mean is greater than 0.5
## 95 percent confidence interval:
##  0.4730696       Inf
## sample estimates:
## mean of x 
## 0.5405968

4.2.1 Accuracy over time

Look at the overall accuracy at the group level (collasped across workerId and condition) over time.

tbl_good_no_NA_bin <- tbl_good_catch_acc_all_main_acc %>%
  group_by(workerId,validity,bin) %>%
  filter(validity=='valid' | validity=='invalid_same' | validity=='invalid_different') %>%
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts)
tbl_good_no_NA_bin$sum = rowSums(tbl_good_no_NA_bin[,c(-1:-2)], na.rm = TRUE)
#head(tbl_good_no_NA_bin,10)

tbl_overall_good_acc_bin <- (tbl_good_catch_acc_all_main_acc_counts_bin$sum / tbl_all_change_counts_no_catch_bin$sum)
tbl_overall_good_acc_bin <- cbind.data.frame(tbl_good_no_NA_bin[,1:2], tbl_overall_good_acc_bin)
colnames(tbl_overall_good_acc_bin) <- c("workerId", "bin", "ACC")
tbl_overall_good_acc_bin %>% 
  ggline(y = "ACC", x = "bin", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", add = "mean_se", ylim = c(0, 1), xlab = " Bin", title = "Main Trial Accuracy Over Time", na.rm = TRUE)

Here are some descriptive and inferential statistics (repeated measures ANOVA and post-hoc t-tests) for the effect of accuracy over time.

aov_acc_time <- aov(ACC ~ bin + Error(factor(workerId)/bin), tbl_overall_good_acc_bin)
summary(aov_acc_time)
## 
## Error: factor(workerId)
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 35  16.05  0.4586               
## 
## Error: factor(workerId):bin
##           Df Sum Sq Mean Sq F value Pr(>F)  
## bin        1 0.0900 0.09002   3.604 0.0659 .
## Residuals 35 0.8743 0.02498                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Error: Within
##            Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 216  3.881 0.01797
pwc_acc_time <- tbl_overall_good_acc_bin %>%
  pairwise_t_test(
    ACC ~ bin, paired = TRUE,
    p.adjust.method = "bonferroni"
    )
pwc_acc_time
## # A tibble: 28 x 10
##    .y.   group1 group2    n1    n2 statistic    df     p p.adj p.adj.signif
##  * <chr> <chr>  <chr>  <int> <int>     <dbl> <dbl> <dbl> <dbl> <chr>       
##  1 ACC   1      2         36    36    -0.332    35 0.742 1     ns          
##  2 ACC   1      3         36    36    -2.17     35 0.037 1     ns          
##  3 ACC   1      4         36    36    -1.37     35 0.179 1     ns          
##  4 ACC   1      5         36    36    -1.99     35 0.055 1     ns          
##  5 ACC   1      6         36    36    -1.52     35 0.138 1     ns          
##  6 ACC   1      7         36    36    -1.17     35 0.251 1     ns          
##  7 ACC   1      8         36    36    -2.11     35 0.042 1     ns          
##  8 ACC   2      3         36    36    -2.35     35 0.025 0.689 ns          
##  9 ACC   2      4         36    36    -1.34     35 0.19  1     ns          
## 10 ACC   2      5         36    36    -2.07     35 0.046 1     ns          
## # … with 18 more rows

4.2.2 Accuracy by validty

Look at the overall accuracy for the group by validity (valid, invalid-same etc.).

tbl_overall_good_acc_cond <- (tbl_good_catch_acc_all_main_acc_counts[-1] / tbl_good_catch_acc_all_main_acc_counts_original[-1])
tbl_overall_good_acc_cond <- cbind.data.frame(tbl_good_catch_acc_all_main_acc_counts[,1], tbl_overall_good_acc_cond)
tbl_overall_good_acc_cond <- gather(tbl_overall_good_acc_cond, validity, acc, valid:invalid_different, factor_key=TRUE)
tbl_overall_good_acc_cond %>%   
  ggbarplot(x = "validity", y = "acc", ylab = "Accuracy", fill = "validity" , color = "validity", palette = c("#0d2240", "#00a8e1", "#f7a800", "#E31818", "#dfdddc"), add = "mean_se", ylim = c(0, 1), na.rm = TRUE, label = TRUE, lab.nb.digits = 2, lab.vjust = c(-2.5, -2.5, -2.5), title = "Main Trial Accuracy By Validity", xlab = "Validity")

Here are some descriptive and inferential statistics (repeated measures ANOVA and post-hoc t-tests) for the effect of accuracy by validty.

tbl_overall_good_acc_cond %>%
  group_by(validity) %>%
  get_summary_stats(acc, type = "mean_se")
## # A tibble: 3 x 5
##   validity          variable     n  mean    se
##   <fct>             <chr>    <dbl> <dbl> <dbl>
## 1 valid             acc         36 0.598 0.045
## 2 invalid_same      acc         36 0.455 0.045
## 3 invalid_different acc         36 0.455 0.051
aov_acc_validity <- aov(acc ~ validity + Error(factor(workerId)/validity), tbl_overall_good_acc_cond)
summary(aov_acc_validity)
## 
## Error: factor(workerId)
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 35  6.318  0.1805               
## 
## Error: factor(workerId):validity
##           Df Sum Sq Mean Sq F value   Pr(>F)    
## validity   2 0.4875 0.24375    8.72 0.000416 ***
## Residuals 70 1.9568 0.02795                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
tbl_overall_good_acc_cond %>% 
  filter(validity == "valid" | validity == "invalid_same") %>%
  with(t.test(acc~validity,paired=TRUE))
## 
##  Paired t-test
## 
## data:  acc by validity
## t = 3.3166, df = 35, p-value = 0.002132
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.05519425 0.22939378
## sample estimates:
## mean of the differences 
##                0.142294
tbl_overall_good_acc_cond %>% 
  filter(validity == "invalid_same" | validity == "invalid_different") %>%
  with(t.test(acc~validity,paired=TRUE))
## 
##  Paired t-test
## 
## data:  acc by validity
## t = 0.021717, df = 35, p-value = 0.9828
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.04188335  0.04278915
## sample estimates:
## mean of the differences 
##            0.0004528986

4.2.3 Individual subject accuracy

Third, we can look at the accuracy for each individual subject. The dashed line at 0.50 represents chance.

tbl_overall_good_acc %>% 
  ggbarplot(x = "workerId", y = "change_main_rate", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", ylim = c(0, 1), title = "Individual Accuracy", sort.val = c("asc"), font.xtickslab = 8) + rotate_x_text() + geom_hline(yintercept = .5, linetype = 2)

4.3 Accuracy on no-change trials

Count the count of accurate no-change trials. The subject pressed ‘J’.

tbl_good_catch_acc_all_main_no_change_acc_counts <- tbl_all_no_change_acc %>%
  modify_if(is.character, as.factor) %>% # This keeps ASDVZRY6J7P5Z in (they had 0 accurate no-change)
  filter(validity=='valid' & acc == 1) %>% 
  group_by(workerId, .drop=FALSE) %>%
  dplyr::summarize(counts = n())
tbl_good_catch_acc_all_main_no_change_acc_counts[is.na(tbl_good_catch_acc_all_main_no_change_acc_counts)] <- 0
colnames(tbl_good_catch_acc_all_main_no_change_acc_counts) <- c("workerId", "acc_no_change")
kable(tbl_good_catch_acc_all_main_no_change_acc_counts)
workerId acc_no_change
A11PIARI7WALAX 39
A15RTRQ5YO6AUS 20
A16SJ5D3DKUEXJ 38
A170WD5QOT5KF5 40
A1969Q0R4Y0E3J 40
A1H2UHJ78F185L 40
A1TSVP4XC9NTR4 27
A1UCDLTUO7FES9 23
A1UOG38V6W8SF6 28
A1WNV787CX1ORQ 29
A2615YW1YERQBO 40
A2DZW5E52SJ93H 40
A2EXYEEMGDETEM 12
A2GZ00IMOT6L3X 39
A2JZUSRBP6H5S 36
A2LVCS009DMEAT 33
A2QP9ZGIW4R7C2 40
A2UHVW63V1CMD1 24
A2Z8F2UEJ9N75M 30
A31JM9RECQGYEX 27
A3C2X1L5PVNNLV 24
A3JVLFHF518XR9 37
A3LC8JT9NKNKN 39
A3OSQTN7GCA5D6 23
A3R7L5UI9IEWGD 35
A3V4SRRO18ELMV 11
A7O82NXM2PI12 39
A8BGHKGBA8O33 37
A8T5YVT0QXTCY 3
ACBSHAUF2NJVJ 15
AIX7Y732EMEBL 40
AKTWA4NBCUQMV 13
ANPCXN619ACW9 36
AOS2PVHT2HYTL 37
ASDVZRY6J7P5Z 0
AXB10LDNM2V3N 18

Compute the no-change accuracy rate.

tbl_no_change_acc_rate <- (tbl_good_catch_acc_all_main_no_change_acc_counts$acc_no_change / tbl_all_no_change_counts$no_change_total)
tbl_no_change_acc_rate <- cbind.data.frame(tbl_good_catch_acc_all_main_no_change_acc_counts[,1], tbl_no_change_acc_rate)
colnames(tbl_no_change_acc_rate) <- c("workerId", "no_change_main_rate")
kable(tbl_no_change_acc_rate)
workerId no_change_main_rate
A11PIARI7WALAX 0.7500000
A15RTRQ5YO6AUS 0.3846154
A16SJ5D3DKUEXJ 0.7307692
A170WD5QOT5KF5 0.7692308
A1969Q0R4Y0E3J 0.7692308
A1H2UHJ78F185L 0.7692308
A1TSVP4XC9NTR4 0.5192308
A1UCDLTUO7FES9 0.4423077
A1UOG38V6W8SF6 0.5384615
A1WNV787CX1ORQ 0.5576923
A2615YW1YERQBO 0.7692308
A2DZW5E52SJ93H 0.7692308
A2EXYEEMGDETEM 0.2307692
A2GZ00IMOT6L3X 0.7500000
A2JZUSRBP6H5S 0.6923077
A2LVCS009DMEAT 0.6346154
A2QP9ZGIW4R7C2 0.7692308
A2UHVW63V1CMD1 0.4615385
A2Z8F2UEJ9N75M 0.5769231
A31JM9RECQGYEX 0.5192308
A3C2X1L5PVNNLV 0.4615385
A3JVLFHF518XR9 0.7115385
A3LC8JT9NKNKN 0.7500000
A3OSQTN7GCA5D6 0.4423077
A3R7L5UI9IEWGD 0.6730769
A3V4SRRO18ELMV 0.2115385
A7O82NXM2PI12 0.7500000
A8BGHKGBA8O33 0.7115385
A8T5YVT0QXTCY 0.0576923
ACBSHAUF2NJVJ 0.2884615
AIX7Y732EMEBL 0.7692308
AKTWA4NBCUQMV 0.2500000
ANPCXN619ACW9 0.6923077
AOS2PVHT2HYTL 0.7115385
ASDVZRY6J7P5Z 0.0000000
AXB10LDNM2V3N 0.3461538

Generate plots of the average no-change accuracy rate for the group and each individual’s no-change accuracy rate.

tbl_no_change_acc_rate %>% 
  ggbarplot(y = "no_change_main_rate", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", add = "mean_se", ylim = c(0, 1), xlab = "Group", width = 0.5, label = TRUE, lab.nb.digits = 2, lab.vjust = -2, title = "No Change Trial Accuracy")

tbl_no_change_acc_rate %>% 
  ggbarplot(x = "workerId", y = "no_change_main_rate", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", ylim = c(0, 1), title = "Individual No Change Trial Accuracy", sort.val = c("asc"), font.xtickslab = 8) + rotate_x_text() + geom_hline(yintercept = .5, linetype = 2)

4.4 Correlations between change catch, no-change catch, change main, and no-change main trials

tbl_corr <- cbind.data.frame(tbl_all_catch_acc_rate[c(2,3)], tbl_overall_good_acc[2], tbl_no_change_acc_rate[2])
tbl_corr_output <- rcorr(as.matrix(tbl_corr))
tbl_corr_output
##                      change_catch_rate no_change_catch_rate change_main_rate
## change_catch_rate                 1.00                -0.06             0.55
## no_change_catch_rate             -0.06                 1.00            -0.16
## change_main_rate                  0.55                -0.16             1.00
## no_change_main_rate               0.19                 0.76            -0.33
##                      no_change_main_rate
## change_catch_rate                   0.19
## no_change_catch_rate                0.76
## change_main_rate                   -0.33
## no_change_main_rate                 1.00
## 
## n= 36 
## 
## 
## P
##                      change_catch_rate no_change_catch_rate change_main_rate
## change_catch_rate                      0.7453               0.0005          
## no_change_catch_rate 0.7453                                 0.3493          
## change_main_rate     0.0005            0.3493                               
## no_change_main_rate  0.2660            0.0000               0.0506          
##                      no_change_main_rate
## change_catch_rate    0.2660             
## no_change_catch_rate 0.0000             
## change_main_rate     0.0506             
## no_change_main_rate
tbl_corr %>% 
  ggscatter(x = "change_catch_rate", y = "no_change_catch_rate", add = "reg.line", title = "Correlation Between Change Catch Trial and No-change Catch Trial Accuracies", ylim = c(0, 1), xlim = c(0, 1), add.params = list(color = "blue", fill = "lightgray")) + stat_cor(method = "pearson") + font("title", size = 12)
## `geom_smooth()` using formula 'y ~ x'

tbl_corr %>% 
  ggscatter(x = "change_catch_rate", y = "change_main_rate", add = "reg.line", title = "Correlation Between Change Catch Trial and Change Main Trial Accuracies", ylim = c(0, 1), xlim = c(0, 1), add.params = list(color = "blue", fill = "lightgray")) + stat_cor(method = "pearson") + font("title", size = 12)
## `geom_smooth()` using formula 'y ~ x'

tbl_corr %>% 
  ggscatter(x = "change_catch_rate", y = "no_change_main_rate", add = "reg.line", title = "Correlation Between Change Catch Trial and No-change Main Trial Accuracies", ylim = c(0, 1), xlim = c(0, 1), add.params = list(color = "blue", fill = "lightgray")) + stat_cor(method = "pearson") + font("title", size = 12)
## `geom_smooth()` using formula 'y ~ x'

tbl_corr %>% 
  ggscatter(x = "no_change_catch_rate", y = "change_main_rate", add = "reg.line", title = "Correlation Between No-change Catch Trial and Change Main Trial Accuracies", ylim = c(0, 1), xlim = c(0, 1), add.params = list(color = "blue", fill = "lightgray")) + stat_cor(method = "pearson") + font("title", size = 12)
## `geom_smooth()` using formula 'y ~ x'

tbl_corr %>% 
  ggscatter(x = "no_change_catch_rate", y = "no_change_main_rate", add = "reg.line", title = "Correlation Between No-change Catch Trial and No-change Main Trial Accuracies", ylim = c(0, 1), xlim = c(0, 1), add.params = list(color = "blue", fill = "lightgray")) + stat_cor(method = "pearson") + font("title", size = 12)
## `geom_smooth()` using formula 'y ~ x'

tbl_corr %>% 
  ggscatter(x = "change_main_rate", y = "no_change_main_rate", add = "reg.line", title = "Correlation Between Change Main Trial and No-change Main Trial Accuracies", ylim = c(0, 1), xlim = c(0, 1), add.params = list(color = "blue", fill = "lightgray")) + stat_cor(method = "pearson") + font("title", size = 12)
## `geom_smooth()` using formula 'y ~ x'

4.5 Difference between catch, change, and no-change trials

tbl_corr <- gather(tbl_corr, rate_type, rate, change_catch_rate:no_change_main_rate, factor_key=TRUE)

tbl_corr %>%
  group_by(rate_type) %>%
  get_summary_stats(rate, type = "mean_se")
## # A tibble: 4 x 5
##   rate_type            variable     n  mean    se
##   <fct>                <chr>    <dbl> <dbl> <dbl>
## 1 change_catch_rate    rate        36 0.684 0.048
## 2 no_change_catch_rate rate        36 0.671 0.044
## 3 change_main_rate     rate        36 0.541 0.04 
## 4 no_change_main_rate  rate        36 0.562 0.037
tbl_corr %>% 
  filter(rate_type == "change_catch_rate" | rate_type == "no_change_catch_rate") %>%
  with(t.test(rate~rate_type,paired=TRUE))
## 
##  Paired t-test
## 
## data:  rate by rate_type
## t = 0.19617, df = 35, p-value = 0.8456
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.1226270  0.1488616
## sample estimates:
## mean of the differences 
##              0.01311728
tbl_corr %>% 
  filter(rate_type == "change_catch_rate" | rate_type == "change_main_rate") %>%
  with(t.test(rate~rate_type,paired=TRUE))
## 
##  Paired t-test
## 
## data:  rate by rate_type
## t = 3.3904, df = 35, p-value = 0.001743
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.0577010 0.2299326
## sample estimates:
## mean of the differences 
##               0.1438168
tbl_corr %>% 
  filter(rate_type == "change_catch_rate" | rate_type == "no_change_main_rate") %>%
  with(t.test(rate~rate_type,paired=TRUE))
## 
##  Paired t-test
## 
## data:  rate by rate_type
## t = 2.2321, df = 35, p-value = 0.03211
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.01108167 0.23381387
## sample estimates:
## mean of the differences 
##               0.1224478
tbl_corr %>% 
  filter(rate_type == "no_change_catch_rate" | rate_type == "change_main_rate") %>%
  with(t.test(rate~rate_type,paired=TRUE))
## 
##  Paired t-test
## 
## data:  rate by rate_type
## t = 2.0533, df = 35, p-value = 0.04758
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.001476349 0.259922655
## sample estimates:
## mean of the differences 
##               0.1306995
tbl_corr %>% 
  filter(rate_type == "no_change_catch_rate" | rate_type == "no_change_main_rate") %>%
  with(t.test(rate~rate_type,paired=TRUE))
## 
##  Paired t-test
## 
## data:  rate by rate_type
## t = 3.7996, df = 35, p-value = 0.0005551
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.05091573 0.16774524
## sample estimates:
## mean of the differences 
##               0.1093305
tbl_corr %>% 
  filter(rate_type == "change_main_rate" | rate_type == "no_change_main_rate") %>%
  with(t.test(rate~rate_type,paired=TRUE))
## 
##  Paired t-test
## 
## data:  rate by rate_type
## t = -0.34194, df = 35, p-value = 0.7344
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.1482377  0.1054997
## sample estimates:
## mean of the differences 
##             -0.02136902

5 Analyze data

5.1 Summary statistics

Confirm subject count.

tbl_all_dprime <- tbl_all[(tbl_all$workerId %in% tbl_good_catch_acc_all_main_acc_counts$workerId),] 
nrow(data.frame(tbl_all_dprime %>% distinct(workerId,.keep_all = FALSE)))
## [1] 36

5.2 Calculate signal detection parameters

5.2.1 d’

First, get signal detection counts for each subject (hits, misses, false alarms, and correct rejections), as well as the total number of change and no-change trials.

tbl_all_dprime_hit_counts <- tbl_all_dprime %>%
  group_by(workerId, validity) %>% 
  filter((validity == "valid" | validity == "invalid_same" | validity == "invalid_different") & change_or_no_change == "change" & key == "F", .preserve = TRUE) %>%
  dplyr::summarize(counts = n()) %>% 
  spread(validity, counts)
colnames(tbl_all_dprime_hit_counts)[-1] <- paste(colnames(tbl_all_dprime_hit_counts)[-1], "hit", sep = "_")

tbl_all_dprime_miss_counts <- tbl_all_dprime %>%
  group_by(workerId, validity) %>% 
  filter((validity == "valid" | validity == "invalid_same" | validity == "invalid_different") & change_or_no_change == "change" & key == "J", .preserve = TRUE) %>%
  dplyr::summarize(counts = n()) %>% 
  spread(validity, counts)
colnames(tbl_all_dprime_miss_counts)[-1] <- paste(colnames(tbl_all_dprime_miss_counts)[-1], "miss", sep = "_")

tbl_all_dprime_falsealarm_counts <- tbl_all_dprime %>%
  group_by(workerId, validity, .drop=FALSE) %>% 
  filter((validity != "practice_main") & change_or_no_change == "no_change" & key == "F", .preserve = TRUE) %>%
  dplyr::summarize(counts = n()) %>% 
  spread(validity, counts)
colnames(tbl_all_dprime_falsealarm_counts)[-1] <- paste(colnames(tbl_all_dprime_falsealarm_counts)[-1], "false_alarm", sep = "_")

tbl_all_dprime_correctrejection_counts <- tbl_all_dprime %>%
  group_by(workerId, validity) %>% 
  filter((validity != "practice_main") & change_or_no_change == "no_change" & key == "J", .preserve = TRUE) %>%
  dplyr::summarize(counts = n()) %>% 
  spread(validity, counts)
colnames(tbl_all_dprime_correctrejection_counts)[-1] <- paste(colnames(tbl_all_dprime_correctrejection_counts)[-1], "correct_rejection", sep = "_")

tbl_num_change_trials <- tbl_all %>%
  group_by(workerId,validity) %>%
  filter(change_or_no_change == "change" & (validity=='valid' | validity=='invalid_same' | validity=='invalid_different')) %>%
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts)
tbl_all_change_counts_no_catch$sum = rowSums(tbl_all_change_counts_no_catch[,c(-1)], na.rm = TRUE)
#kable(tbl_num_change_trials)

tbl_num_no_change_trials <- tbl_all %>%
  group_by(workerId,validity) %>%
  filter(change_or_no_change == "no_change" & validity == "valid") %>%
  dplyr::summarize(counts = n()) %>%
  spread(validity,counts)
colnames(tbl_num_no_change_trials) <- c("workerId", "no_change")
#kable(tbl_num_no_change_trials)

tbl_paramters <- cbind.data.frame(tbl_all_dprime_hit_counts[c(-2,-5,-6)], tbl_all_dprime_miss_counts[c(-1,-2,-5,-6)], tbl_all_dprime_falsealarm_counts[7], tbl_all_dprime_correctrejection_counts[7], tbl_num_change_trials[-1], tbl_num_no_change_trials[-1])

Next, Compute valid, invalid-same, and invalid-different hit rates, as well as false-alarm rate.

tbl_paramters <- tbl_paramters %>% 
  mutate(valid_hit_rate = valid_hit/valid) %>%
  mutate(invalid_same_hit_rate = invalid_same_hit/invalid_same) %>% 
  mutate(invalid_different_hit_rate = invalid_different_hit/invalid_different) %>%
  mutate(false_alarm_rate = valid_false_alarm/no_change)

Before z-transforming, hit and false-alarm rates of 0% are converted to 1% and rates of 100% are converted to 99% to prevent the z-transformation from resulting in -infinity or infinity.

tbl_paramters$valid_hit_rate[tbl_paramters$valid_hit_rate == 0] <- .01
tbl_paramters$valid_hit_rate[tbl_paramters$valid_hit_rate == 1] <- .99
tbl_paramters$invalid_same_hit_rate[tbl_paramters$invalid_same_hit_rate == 0] <- .01
tbl_paramters$invalid_same_hit_rate[tbl_paramters$invalid_same_hit_rate == 1] <- .99
tbl_paramters$invalid_different_hit_rate[tbl_paramters$invalid_different_hit_rate == 0] <- .01
tbl_paramters$invalid_different_hit_rate[tbl_paramters$invalid_different_hit_rate == 1] <- .99
tbl_paramters$false_alarm_rate[tbl_paramters$false_alarm_rate == 0] <- .01
tbl_paramters$false_alarm_rate[tbl_paramters$false_alarm_rate == 1] <- .99

Finally, perform z-transformation and compute d-prime values.

tbl_paramters <- tbl_paramters %>% 
  mutate(z_valid_hit_rate = qnorm(valid_hit_rate)) %>% 
  mutate(z_invalid_same_hit_rate = qnorm(invalid_same_hit_rate)) %>% 
  mutate(z_invalid_different_hit_rate = qnorm(invalid_different_hit_rate)) %>% 
  mutate(z_false_alarm_rate = qnorm(false_alarm_rate)) %>% 
  mutate(valid_d_prime = z_valid_hit_rate - z_false_alarm_rate) %>% 
  mutate(invalid_same_d_prime = z_invalid_same_hit_rate - z_false_alarm_rate) %>% 
  mutate(invalid_different_d_prime = z_invalid_different_hit_rate - z_false_alarm_rate)

5.2.2 c

tbl_paramters <- tbl_paramters %>% 
  mutate(valid_c = (z_valid_hit_rate + z_false_alarm_rate) * -0.5) %>% 
  mutate(invalid_same_c = (z_invalid_same_hit_rate + z_false_alarm_rate) * -0.5) %>% 
  mutate(invalid_different_c = (z_invalid_different_hit_rate - z_false_alarm_rate) * -0.5)

5.2.3 β

tbl_paramters <- tbl_paramters %>% 
  mutate(valid_β = exp((z_false_alarm_rate^2 - z_valid_hit_rate^2)/2)) %>% 
  mutate(invalid_same_β = exp((z_false_alarm_rate^2 - z_invalid_same_hit_rate^2)/2)) %>% 
  mutate(invalid_different_β = exp((z_false_alarm_rate^2 - z_invalid_different_hit_rate^2)/2))

5.3 d’

5.3.1 Plot

tbl_paramters_dprime <- gather(tbl_paramters, validity, dprime, valid_d_prime:invalid_different_d_prime, factor_key=TRUE)
tbl_paramters_dprime <- cbind(tbl_paramters_dprime[c(1, 28, 29)])
tbl_paramters_dprime %>% 
  ggbarplot(x = "validity", y = "dprime", ylab = "d'", fill = "validity" , color = "validity", palette = c("#0d2240", "#00a8e1", "#f7a800"), add = "mean_se", ylim = c(0, 2), label = TRUE, lab.nb.digits = 2, lab.vjust = c(-7, -6, -6))

5.3.2 Repeated-measures ANOVA

tbl_paramters_dprime %>%
  group_by(validity) %>%
  get_summary_stats(dprime, type = "mean_se")
## # A tibble: 3 x 5
##   validity                  variable     n  mean    se
##   <fct>                     <chr>    <dbl> <dbl> <dbl>
## 1 valid_d_prime             dprime      36 1.16  0.226
## 2 invalid_same_d_prime      dprime      36 0.693 0.189
## 3 invalid_different_d_prime dprime      36 0.666 0.189
aov_dprime <- aov(dprime ~ validity + Error(factor(workerId)/validity), tbl_paramters_dprime)
summary(aov_dprime)
## 
## Error: factor(workerId)
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 35  127.6   3.646               
## 
## Error: factor(workerId):validity
##           Df Sum Sq Mean Sq F value  Pr(>F)   
## validity   2   5.63  2.8149   7.448 0.00117 **
## Residuals 70  26.46  0.3779                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

5.3.3 Pairwise comparisons

tbl_paramters_dprime %>% 
  filter(validity == "valid_d_prime" | validity == "invalid_same_d_prime") %>%
  with(t.test(dprime~validity,paired=TRUE))
## 
##  Paired t-test
## 
## data:  dprime by validity
## t = 3.0699, df = 35, p-value = 0.004121
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.1594220 0.7819107
## sample estimates:
## mean of the differences 
##               0.4706663
tbl_paramters_dprime %>% 
  filter(validity == "invalid_same_d_prime" | validity == "invalid_different_d_prime") %>%
  with(t.test(dprime~validity,paired=TRUE))
## 
##  Paired t-test
## 
## data:  dprime by validity
## t = 0.33508, df = 35, p-value = 0.7396
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.1328390  0.1853601
## sample estimates:
## mean of the differences 
##              0.02626053

5.4 c

5.4.1 Plot

tbl_paramters_c <- gather(tbl_paramters, validity, c, valid_c:invalid_different_c, factor_key=TRUE)
tbl_paramters_c <- cbind(tbl_paramters_c[c(1, 28, 29)])
tbl_paramters_c %>% 
  ggbarplot(x = "validity", y = "c", ylab = "c", fill = "validity" , color = "validity", palette = c("#0d2240", "#00a8e1", "#f7a800"), add = "mean_se", ylim = c(-1, 1), label = TRUE, lab.nb.digits = 2, lab.vjust = c(-3, -3, -1))

5.4.2 Repeated-measures ANOVA

tbl_paramters_c %>%
  group_by(validity) %>%
  get_summary_stats(c, type = "mean_se")
## # A tibble: 3 x 5
##   validity            variable     n   mean    se
##   <fct>               <chr>    <dbl>  <dbl> <dbl>
## 1 valid_c             c           36  0.322 0.146
## 2 invalid_same_c      c           36  0.558 0.156
## 3 invalid_different_c c           36 -0.333 0.095
aov_c <- aov(c ~ validity + Error(factor(workerId)/validity), tbl_paramters_c)
summary(aov_c)
## 
## Error: factor(workerId)
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 35   36.6   1.046               
## 
## Error: factor(workerId):validity
##           Df Sum Sq Mean Sq F value   Pr(>F)    
## validity   2  15.34   7.670   16.75 1.14e-06 ***
## Residuals 70  32.06   0.458                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

5.4.3 Pairwise comparisons

tbl_paramters_c %>% 
  filter(validity == "valid_c" | validity == "invalid_same_c") %>%
  with(t.test(c~validity,paired=TRUE))
## 
##  Paired t-test
## 
## data:  c by validity
## t = -3.0699, df = 35, p-value = 0.004121
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.39095533 -0.07971101
## sample estimates:
## mean of the differences 
##              -0.2353332
tbl_paramters_c %>% 
  filter(validity == "invalid_same_c" | validity == "invalid_different_c") %>%
  with(t.test(c~validity,paired=TRUE))
## 
##  Paired t-test
## 
## data:  c by validity
## t = 4.7471, df = 35, p-value = 3.435e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.5098068 1.2716429
## sample estimates:
## mean of the differences 
##               0.8907248

5.5 β

tbl_paramters_β <- gather(tbl_paramters, validity, β, valid_β:invalid_different_β, factor_key=TRUE)
tbl_paramters_β <- cbind(tbl_paramters_β[c(1, 28, 29)])
tbl_paramters_β %>% 
  ggbarplot(x = "validity", y = "β", ylab = "β", fill = "validity" , color = "validity", palette = c("#0d2240", "#00a8e1", "#f7a800"), add = "mean_se", ylim = c(0, 4), label = TRUE, lab.nb.digits = 2, lab.vjust = c(-5, -5.5, -5.5))

5.5.1 Repeated-measures ANOVA

tbl_paramters_β %>%
  group_by(validity) %>%
  get_summary_stats(β, type = "mean_se")
## # A tibble: 3 x 5
##   validity            variable     n  mean    se
##   <fct>               <chr>    <dbl> <dbl> <dbl>
## 1 valid_β             β           36  2.67 0.571
## 2 invalid_same_β      β           36  3.06 0.647
## 3 invalid_different_β β           36  2.90 0.658
aov_β <- aov(β ~ validity + Error(factor(workerId)/validity), tbl_paramters_β)
summary(aov_β)
## 
## Error: factor(workerId)
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 35   1436   41.02               
## 
## Error: factor(workerId):validity
##           Df Sum Sq Mean Sq F value Pr(>F)
## validity   2   2.72  1.3617   1.994  0.144
## Residuals 70  47.80  0.6829

5.5.2 Pairwise comparisons

tbl_paramters_β %>% 
  filter(validity == "valid_β" | validity == "invalid_same_β") %>%
  with(t.test(β~validity,paired=TRUE))
## 
##  Paired t-test
## 
## data:  β by validity
## t = -1.5793, df = 35, p-value = 0.1233
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.8833335  0.1103232
## sample estimates:
## mean of the differences 
##              -0.3865052
tbl_paramters_β %>% 
  filter(validity == "invalid_same_β" | validity == "invalid_different_β") %>%
  with(t.test(β~validity,paired=TRUE))
## 
##  Paired t-test
## 
## data:  β by validity
## t = 1.0386, df = 35, p-value = 0.3061
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.1482729  0.4589164
## sample estimates:
## mean of the differences 
##               0.1553218