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_v5/", 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] 35

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_5_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
A10JXOU89D5RXR 36 24 24 72 156
A1198W1SPF1R4 36 24 24 72 156
A14ADQ7RUN6TDY 36 24 24 72 156
A1KZ21TSAYUHO4 36 24 24 72 156
A1LA6CIGBNDOH9 36 24 24 72 156
A1M682B2WUSYJP 36 24 24 72 156
A1N0D7925N0060 36 24 24 72 156
A1NF1XZTCVRG1V 36 24 24 72 156
A1TLNLB9D87H6 36 24 24 72 156
A1VEUBY3JTXH0W 36 24 24 72 156
A1VGQQPI02FE31 36 24 24 72 156
A1VMPZVVVZUCS4 36 24 24 72 156
A27OJ2085CJ90R 36 24 24 72 156
A2DT28O8YHDU9B 36 24 24 72 156
A2GTJ0BD4CG1A2 36 24 24 72 156
A2HFK76PFSAXBE 36 24 24 72 156
A2POU9TTW177VH 36 24 24 72 156
A2PTTSUG7NF42Q 36 24 24 72 156
A2RVEG53L48BAE 36 24 24 72 156
A2XK59FYAFO9EX 36 24 24 72 156
A2YA1ZM1V760Q1 36 24 24 72 156
A3493E42N1JZVF 36 24 24 72 156
A34DYM8J0X5VK 36 24 24 72 156
A34GLND3Z6CKJE 36 24 24 72 156
A37E2SOKV6I0VZ 36 24 24 72 156
A3AGU4FBSDDVYS 36 24 24 72 156
A3E70T8BHKN77M 36 24 24 72 156
A3FF5CCILJAWYT 36 24 24 72 156
A3FMBSTZ3ZGSV1 36 24 24 72 156
A3G4VYIIJIUK8W 36 24 24 72 156
A3RHJEMZ4EGY2U 36 24 24 72 156
A3ULYZVZ0DDDK6 36 24 24 72 156
AG6WV3WODQ7IN 36 24 24 72 156
AKR9067Q09RZS 35 24 23 71 153
AVZOC3OGBQRX2 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
A10JXOU89D5RXR 12 40 52
A1198W1SPF1R4 12 40 52
A14ADQ7RUN6TDY 12 40 52
A1KZ21TSAYUHO4 12 40 52
A1LA6CIGBNDOH9 12 40 52
A1M682B2WUSYJP 12 40 52
A1N0D7925N0060 12 40 52
A1NF1XZTCVRG1V 12 40 52
A1TLNLB9D87H6 12 40 52
A1VEUBY3JTXH0W 12 40 52
A1VGQQPI02FE31 12 40 52
A1VMPZVVVZUCS4 12 40 52
A27OJ2085CJ90R 12 40 52
A2DT28O8YHDU9B 12 40 52
A2GTJ0BD4CG1A2 12 40 52
A2HFK76PFSAXBE 12 40 52
A2POU9TTW177VH 12 40 52
A2PTTSUG7NF42Q 12 40 52
A2RVEG53L48BAE 12 40 52
A2XK59FYAFO9EX 12 40 52
A2YA1ZM1V760Q1 12 40 52
A3493E42N1JZVF 12 40 52
A34DYM8J0X5VK 12 40 52
A34GLND3Z6CKJE 12 40 52
A37E2SOKV6I0VZ 12 40 52
A3AGU4FBSDDVYS 12 40 52
A3E70T8BHKN77M 12 40 52
A3FF5CCILJAWYT 12 40 52
A3FMBSTZ3ZGSV1 12 40 52
A3G4VYIIJIUK8W 12 40 52
A3RHJEMZ4EGY2U 12 40 52
A3ULYZVZ0DDDK6 12 40 52
AG6WV3WODQ7IN 12 40 52
AKR9067Q09RZS 12 39 51
AVZOC3OGBQRX2 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
A10JXOU89D5RXR change 0 36 36
A10JXOU89D5RXR no_change 1 11 12
A1198W1SPF1R4 change 6 30 36
A1198W1SPF1R4 no_change 2 10 12
A14ADQ7RUN6TDY change 11 25 36
A14ADQ7RUN6TDY no_change 3 9 12
A1KZ21TSAYUHO4 change 0 36 36
A1KZ21TSAYUHO4 no_change 3 9 12
A1LA6CIGBNDOH9 change 0 36 36
A1LA6CIGBNDOH9 no_change 1 11 12
A1M682B2WUSYJP change 22 14 36
A1M682B2WUSYJP no_change 7 5 12
A1N0D7925N0060 change 0 36 36
A1N0D7925N0060 no_change 2 10 12
A1NF1XZTCVRG1V change 0 36 36
A1NF1XZTCVRG1V no_change 1 11 12
A1TLNLB9D87H6 change 2 34 36
A1TLNLB9D87H6 no_change 1 11 12
A1VEUBY3JTXH0W change 16 20 36
A1VEUBY3JTXH0W no_change 4 8 12
A1VGQQPI02FE31 change 16 20 36
A1VGQQPI02FE31 no_change 5 7 12
A1VMPZVVVZUCS4 change 1 35 36
A1VMPZVVVZUCS4 no_change 3 9 12
A27OJ2085CJ90R change 23 13 36
A27OJ2085CJ90R no_change 9 3 12
A2DT28O8YHDU9B change 17 19 36
A2DT28O8YHDU9B no_change 5 7 12
A2GTJ0BD4CG1A2 change 5 31 36
A2GTJ0BD4CG1A2 no_change 0 12 12
A2HFK76PFSAXBE change 36 0 36
A2HFK76PFSAXBE no_change 7 5 12
A2POU9TTW177VH change 23 13 36
A2POU9TTW177VH no_change 2 10 12
A2PTTSUG7NF42Q change 33 3 36
A2PTTSUG7NF42Q no_change 3 9 12
A2RVEG53L48BAE change 12 24 36
A2RVEG53L48BAE no_change 1 11 12
A2XK59FYAFO9EX change 24 12 36
A2XK59FYAFO9EX no_change 0 12 12
A2YA1ZM1V760Q1 change 4 32 36
A2YA1ZM1V760Q1 no_change 5 7 12
A3493E42N1JZVF change 0 36 36
A3493E42N1JZVF no_change 1 11 12
A34DYM8J0X5VK change 23 13 36
A34DYM8J0X5VK no_change 3 9 12
A34GLND3Z6CKJE change 10 26 36
A34GLND3Z6CKJE no_change 9 3 12
A37E2SOKV6I0VZ change 0 36 36
A37E2SOKV6I0VZ no_change 2 10 12
A3AGU4FBSDDVYS change 8 28 36
A3AGU4FBSDDVYS no_change 1 11 12
A3E70T8BHKN77M change 21 15 36
A3E70T8BHKN77M no_change 2 10 12
A3FF5CCILJAWYT change 19 17 36
A3FF5CCILJAWYT no_change 1 11 12
A3FMBSTZ3ZGSV1 change 5 31 36
A3FMBSTZ3ZGSV1 no_change 0 12 12
A3G4VYIIJIUK8W change 8 28 36
A3G4VYIIJIUK8W no_change 11 1 12
A3RHJEMZ4EGY2U change 0 36 36
A3RHJEMZ4EGY2U no_change 2 10 12
A3ULYZVZ0DDDK6 change 0 36 36
A3ULYZVZ0DDDK6 no_change 1 11 12
AG6WV3WODQ7IN change 6 30 36
AG6WV3WODQ7IN no_change 2 10 12
AKR9067Q09RZS change 23 12 35
AKR9067Q09RZS no_change 1 11 12
AVZOC3OGBQRX2 change 19 17 36
AVZOC3OGBQRX2 no_change 0 12 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
A10JXOU89D5RXR 1 47 48
A1198W1SPF1R4 8 40 48
A14ADQ7RUN6TDY 14 34 48
A1KZ21TSAYUHO4 3 45 48
A1LA6CIGBNDOH9 1 47 48
A1M682B2WUSYJP 29 19 48
A1N0D7925N0060 2 46 48
A1NF1XZTCVRG1V 1 47 48
A1TLNLB9D87H6 3 45 48
A1VEUBY3JTXH0W 20 28 48
A1VGQQPI02FE31 21 27 48
A1VMPZVVVZUCS4 4 44 48
A27OJ2085CJ90R 32 16 48
A2DT28O8YHDU9B 22 26 48
A2GTJ0BD4CG1A2 5 43 48
A2HFK76PFSAXBE 43 5 48
A2POU9TTW177VH 25 23 48
A2PTTSUG7NF42Q 36 12 48
A2RVEG53L48BAE 13 35 48
A2XK59FYAFO9EX 24 24 48
A2YA1ZM1V760Q1 9 39 48
A3493E42N1JZVF 1 47 48
A34DYM8J0X5VK 26 22 48
A34GLND3Z6CKJE 19 29 48
A37E2SOKV6I0VZ 2 46 48
A3AGU4FBSDDVYS 9 39 48
A3E70T8BHKN77M 23 25 48
A3FF5CCILJAWYT 20 28 48
A3FMBSTZ3ZGSV1 5 43 48
A3G4VYIIJIUK8W 19 29 48
A3RHJEMZ4EGY2U 2 46 48
A3ULYZVZ0DDDK6 1 47 48
AG6WV3WODQ7IN 8 40 48
AKR9067Q09RZS 24 23 47
AVZOC3OGBQRX2 19 29 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
A10JXOU89D5RXR 1.0000000 0.9166667 0.9583333 0.9791667
A1198W1SPF1R4 0.8333333 0.8333333 0.8333333 0.8333333
A14ADQ7RUN6TDY 0.6944444 0.7500000 0.7222222 0.7083333
A1KZ21TSAYUHO4 1.0000000 0.7500000 0.8750000 0.9375000
A1LA6CIGBNDOH9 1.0000000 0.9166667 0.9583333 0.9791667
A1M682B2WUSYJP 0.3888889 0.4166667 0.4027778 0.3958333
A1N0D7925N0060 1.0000000 0.8333333 0.9166667 0.9583333
A1NF1XZTCVRG1V 1.0000000 0.9166667 0.9583333 0.9791667
A1TLNLB9D87H6 0.9444444 0.9166667 0.9305556 0.9375000
A1VEUBY3JTXH0W 0.5555556 0.6666667 0.6111111 0.5833333
A1VGQQPI02FE31 0.5555556 0.5833333 0.5694444 0.5625000
A1VMPZVVVZUCS4 0.9722222 0.7500000 0.8611111 0.9166667
A27OJ2085CJ90R 0.3611111 0.2500000 0.3055556 0.3333333
A2DT28O8YHDU9B 0.5277778 0.5833333 0.5555556 0.5416667
A2GTJ0BD4CG1A2 0.8611111 1.0000000 0.9305556 0.8958333
A2HFK76PFSAXBE 0.0000000 0.4166667 0.2083333 0.1041667
A2POU9TTW177VH 0.3611111 0.8333333 0.5972222 0.4791667
A2PTTSUG7NF42Q 0.0833333 0.7500000 0.4166667 0.2500000
A2RVEG53L48BAE 0.6666667 0.9166667 0.7916667 0.7291667
A2XK59FYAFO9EX 0.3333333 1.0000000 0.6666667 0.5000000
A2YA1ZM1V760Q1 0.8888889 0.5833333 0.7361111 0.8125000
A3493E42N1JZVF 1.0000000 0.9166667 0.9583333 0.9791667
A34DYM8J0X5VK 0.3611111 0.7500000 0.5555556 0.4583333
A34GLND3Z6CKJE 0.7222222 0.2500000 0.4861111 0.6041667
A37E2SOKV6I0VZ 1.0000000 0.8333333 0.9166667 0.9583333
A3AGU4FBSDDVYS 0.7777778 0.9166667 0.8472222 0.8125000
A3E70T8BHKN77M 0.4166667 0.8333333 0.6250000 0.5208333
A3FF5CCILJAWYT 0.4722222 0.9166667 0.6944444 0.5833333
A3FMBSTZ3ZGSV1 0.8611111 1.0000000 0.9305556 0.8958333
A3G4VYIIJIUK8W 0.7777778 0.0833333 0.4305556 0.6041667
A3RHJEMZ4EGY2U 1.0000000 0.8333333 0.9166667 0.9583333
A3ULYZVZ0DDDK6 1.0000000 0.9166667 0.9583333 0.9791667
AG6WV3WODQ7IN 0.8333333 0.8333333 0.8333333 0.8333333
AKR9067Q09RZS 0.3428571 0.9166667 0.6297619 0.4893617
AVZOC3OGBQRX2 0.4722222 1.0000000 0.7361111 0.6041667 
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] 35

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
A10JXOU89D5RXR 7 5 52 64
A1198W1SPF1R4 12 17 51 80
A14ADQ7RUN6TDY 5 0 49 54
A1KZ21TSAYUHO4 1 11 61 73
A1LA6CIGBNDOH9 11 11 65 87
A1M682B2WUSYJP 9 10 31 50
A1N0D7925N0060 11 11 39 61
A1NF1XZTCVRG1V 19 20 59 98
A1TLNLB9D87H6 5 3 64 72
A1VEUBY3JTXH0W 13 10 30 53
A1VGQQPI02FE31 7 10 36 53
A1VMPZVVVZUCS4 9 14 51 74
A27OJ2085CJ90R 11 10 45 66
A2DT28O8YHDU9B 14 14 37 65
A2GTJ0BD4CG1A2 17 20 57 94
A2HFK76PFSAXBE 13 5 15 33
A2POU9TTW177VH 1 2 67 70
A2PTTSUG7NF42Q 15 12 39 66
A2RVEG53L48BAE 7 3 51 61
A2XK59FYAFO9EX 8 4 44 56
A2YA1ZM1V760Q1 15 19 62 96
A3493E42N1JZVF 16 18 71 105
A34DYM8J0X5VK 2 0 67 69
A34GLND3Z6CKJE 17 17 49 83
A37E2SOKV6I0VZ 20 19 67 106
A3AGU4FBSDDVYS 1 3 51 55
A3E70T8BHKN77M 7 9 45 61
A3FF5CCILJAWYT 0 2 9 11
A3FMBSTZ3ZGSV1 11 11 35 57
A3G4VYIIJIUK8W 19 15 55 89
A3RHJEMZ4EGY2U 0 1 72 73
A3ULYZVZ0DDDK6 5 12 69 86
AG6WV3WODQ7IN 15 16 46 77
AKR9067Q09RZS 0 0 64 64
AVZOC3OGBQRX2 11 6 35 52 
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] 35

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
A10JXOU89D5RXR 24 24 72 120
A1198W1SPF1R4 24 24 72 120
A14ADQ7RUN6TDY 24 24 72 120
A1KZ21TSAYUHO4 24 24 72 120
A1LA6CIGBNDOH9 24 24 72 120
A1M682B2WUSYJP 24 24 72 120
A1N0D7925N0060 24 24 72 120
A1NF1XZTCVRG1V 24 24 72 120
A1TLNLB9D87H6 24 24 72 120
A1VEUBY3JTXH0W 24 24 72 120
A1VGQQPI02FE31 24 24 72 120
A1VMPZVVVZUCS4 24 24 72 120
A27OJ2085CJ90R 24 24 72 120
A2DT28O8YHDU9B 24 24 72 120
A2GTJ0BD4CG1A2 24 24 72 120
A2HFK76PFSAXBE 24 24 72 120
A2POU9TTW177VH 24 24 72 120
A2PTTSUG7NF42Q 24 24 72 120
A2RVEG53L48BAE 24 24 72 120
A2XK59FYAFO9EX 24 24 72 120
A2YA1ZM1V760Q1 24 24 72 120
A3493E42N1JZVF 24 24 72 120
A34DYM8J0X5VK 24 24 72 120
A34GLND3Z6CKJE 24 24 72 120
A37E2SOKV6I0VZ 24 24 72 120
A3AGU4FBSDDVYS 24 24 72 120
A3E70T8BHKN77M 24 24 72 120
A3FF5CCILJAWYT 24 24 72 120
A3FMBSTZ3ZGSV1 24 24 72 120
A3G4VYIIJIUK8W 24 24 72 120
A3RHJEMZ4EGY2U 24 24 72 120
A3ULYZVZ0DDDK6 24 24 72 120
AG6WV3WODQ7IN 24 24 72 120
AKR9067Q09RZS 24 23 71 118
AVZOC3OGBQRX2 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
A10JXOU89D5RXR 0.5333333
A1198W1SPF1R4 0.6666667
A14ADQ7RUN6TDY 0.4500000
A1KZ21TSAYUHO4 0.6083333
A1LA6CIGBNDOH9 0.7250000
A1M682B2WUSYJP 0.4166667
A1N0D7925N0060 0.5083333
A1NF1XZTCVRG1V 0.8166667
A1TLNLB9D87H6 0.6000000
A1VEUBY3JTXH0W 0.4416667
A1VGQQPI02FE31 0.4416667
A1VMPZVVVZUCS4 0.6166667
A27OJ2085CJ90R 0.5500000
A2DT28O8YHDU9B 0.5416667
A2GTJ0BD4CG1A2 0.7833333
A2HFK76PFSAXBE 0.2750000
A2POU9TTW177VH 0.5833333
A2PTTSUG7NF42Q 0.5500000
A2RVEG53L48BAE 0.5083333
A2XK59FYAFO9EX 0.4666667
A2YA1ZM1V760Q1 0.8000000
A3493E42N1JZVF 0.8750000
A34DYM8J0X5VK 0.5750000
A34GLND3Z6CKJE 0.6916667
A37E2SOKV6I0VZ 0.8833333
A3AGU4FBSDDVYS 0.4583333
A3E70T8BHKN77M 0.5083333
A3FF5CCILJAWYT 0.0916667
A3FMBSTZ3ZGSV1 0.4750000
A3G4VYIIJIUK8W 0.7416667
A3RHJEMZ4EGY2U 0.6083333
A3ULYZVZ0DDDK6 0.7166667
AG6WV3WODQ7IN 0.6416667
AKR9067Q09RZS 0.5423729
AVZOC3OGBQRX2 0.4333333 
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 = 2.7088, df = 34, p-value = 0.005248
## alternative hypothesis: true mean is greater than 0.5
## 95 percent confidence interval:
##  0.5281904       Inf
## sample estimates:
## mean of x 
## 0.5750202

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 34  7.304  0.2148               
## 
## Error: factor(workerId):bin
##           Df Sum Sq Mean Sq F value Pr(>F)
## bin        1 0.0618 0.06178   1.754  0.194
## Residuals 34 1.1972 0.03521               
## 
## Error: Within
##            Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 210  3.748 0.01785
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         35    35   -0.0292    34 0.977     1 ns          
##  2 ACC   1      3         35    35   -0.247     34 0.806     1 ns          
##  3 ACC   1      4         35    35    0.737     34 0.466     1 ns          
##  4 ACC   1      5         35    35    0.942     34 0.353     1 ns          
##  5 ACC   1      6         35    35    1.02      34 0.316     1 ns          
##  6 ACC   1      7         35    35    0.799     34 0.43      1 ns          
##  7 ACC   1      8         35    35    0.878     34 0.386     1 ns          
##  8 ACC   2      3         35    35   -0.247     34 0.806     1 ns          
##  9 ACC   2      4         35    35    0.782     34 0.44      1 ns          
## 10 ACC   2      5         35    35    1.12      34 0.269     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         35 0.691 0.036
## 2 invalid_same      acc         35 0.405 0.045
## 3 invalid_different acc         35 0.398 0.042
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 34  3.346 0.09842               
## 
## Error: factor(workerId):validity
##           Df Sum Sq Mean Sq F value   Pr(>F)    
## validity   2  1.958  0.9792   24.23 1.13e-08 ***
## Residuals 68  2.748  0.0404                     
## ---
## 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 = 5.2741, df = 34, p-value = 7.57e-06
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.1758409 0.3963031
## sample estimates:
## mean of the differences 
##                0.286072
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.27972, df = 34, p-value = 0.7814
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.04475281  0.05903853
## sample estimates:
## mean of the differences 
##             0.007142857

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
A10JXOU89D5RXR 38
A1198W1SPF1R4 39
A14ADQ7RUN6TDY 39
A1KZ21TSAYUHO4 40
A1LA6CIGBNDOH9 40
A1M682B2WUSYJP 25
A1N0D7925N0060 39
A1NF1XZTCVRG1V 38
A1TLNLB9D87H6 32
A1VEUBY3JTXH0W 22
A1VGQQPI02FE31 16
A1VMPZVVVZUCS4 36
A27OJ2085CJ90R 17
A2DT28O8YHDU9B 17
A2GTJ0BD4CG1A2 39
A2HFK76PFSAXBE 4
A2POU9TTW177VH 36
A2PTTSUG7NF42Q 23
A2RVEG53L48BAE 39
A2XK59FYAFO9EX 34
A2YA1ZM1V760Q1 24
A3493E42N1JZVF 39
A34DYM8J0X5VK 38
A34GLND3Z6CKJE 21
A37E2SOKV6I0VZ 38
A3AGU4FBSDDVYS 39
A3E70T8BHKN77M 33
A3FF5CCILJAWYT 39
A3FMBSTZ3ZGSV1 39
A3G4VYIIJIUK8W 10
A3RHJEMZ4EGY2U 40
A3ULYZVZ0DDDK6 36
AG6WV3WODQ7IN 19
AKR9067Q09RZS 39
AVZOC3OGBQRX2 40

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
A10JXOU89D5RXR 0.7307692
A1198W1SPF1R4 0.7500000
A14ADQ7RUN6TDY 0.7500000
A1KZ21TSAYUHO4 0.7692308
A1LA6CIGBNDOH9 0.7692308
A1M682B2WUSYJP 0.4807692
A1N0D7925N0060 0.7500000
A1NF1XZTCVRG1V 0.7307692
A1TLNLB9D87H6 0.6153846
A1VEUBY3JTXH0W 0.4230769
A1VGQQPI02FE31 0.3076923
A1VMPZVVVZUCS4 0.6923077
A27OJ2085CJ90R 0.3269231
A2DT28O8YHDU9B 0.3269231
A2GTJ0BD4CG1A2 0.7500000
A2HFK76PFSAXBE 0.0769231
A2POU9TTW177VH 0.6923077
A2PTTSUG7NF42Q 0.4423077
A2RVEG53L48BAE 0.7500000
A2XK59FYAFO9EX 0.6538462
A2YA1ZM1V760Q1 0.4615385
A3493E42N1JZVF 0.7500000
A34DYM8J0X5VK 0.7307692
A34GLND3Z6CKJE 0.4038462
A37E2SOKV6I0VZ 0.7307692
A3AGU4FBSDDVYS 0.7500000
A3E70T8BHKN77M 0.6346154
A3FF5CCILJAWYT 0.7500000
A3FMBSTZ3ZGSV1 0.7500000
A3G4VYIIJIUK8W 0.1923077
A3RHJEMZ4EGY2U 0.7692308
A3ULYZVZ0DDDK6 0.6923077
AG6WV3WODQ7IN 0.3653846
AKR9067Q09RZS 0.7647059
AVZOC3OGBQRX2 0.7692308

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.29             0.60
## no_change_catch_rate              0.29                 1.00             0.01
## change_main_rate                  0.60                 0.01             1.00
## no_change_main_rate               0.45                 0.80             0.14
##                      no_change_main_rate
## change_catch_rate                   0.45
## no_change_catch_rate                0.80
## change_main_rate                    0.14
## no_change_main_rate                 1.00
## 
## n= 35 
## 
## 
## P
##                      change_catch_rate no_change_catch_rate change_main_rate
## change_catch_rate                      0.0960               0.0001          
## no_change_catch_rate 0.0960                                 0.9556          
## change_main_rate     0.0001            0.9556                               
## no_change_main_rate  0.0068            0.0000               0.4279          
##                      no_change_main_rate
## change_catch_rate    0.0068             
## no_change_catch_rate 0.0000             
## change_main_rate     0.4279             
## 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        35 0.688 0.049
## 2 no_change_catch_rate rate        35 0.76  0.039
## 3 change_main_rate     rate        35 0.575 0.028
## 4 no_change_main_rate  rate        35 0.609 0.033
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 = -1.3428, df = 34, p-value = 0.1882
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.18084281  0.03694258
## sample estimates:
## mean of the differences 
##             -0.07195011
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 = 2.8417, df = 34, p-value = 0.007532
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.03206106 0.19304598
## sample estimates:
## mean of the differences 
##               0.1125535
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 = 1.7365, df = 34, p-value = 0.09153
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.01343858  0.17126212
## sample estimates:
## mean of the differences 
##              0.07891177
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 = 3.8608, df = 34, p-value = 0.0004816
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.08738542 0.28162184
## sample estimates:
## mean of the differences 
##               0.1845036
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 = 6.4542, df = 34, p-value = 2.228e-07
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.1033595 0.1983643
## sample estimates:
## mean of the differences 
##               0.1508619
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.83996, df = 34, p-value = 0.4068
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.11503628  0.04775279
## sample estimates:
## mean of the differences 
##             -0.03364175

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] 35

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.5), label = TRUE, lab.nb.digits = 2, lab.vjust = c(-4, -4, -4))

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      35 1.79  0.253
## 2 invalid_same_d_prime      dprime      35 0.787 0.198
## 3 invalid_different_d_prime dprime      35 0.758 0.173
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 34  119.2   3.505               
## 
## Error: factor(workerId):validity
##           Df Sum Sq Mean Sq F value   Pr(>F)    
## validity   2  24.24  12.119   21.14 7.26e-08 ***
## Residuals 68  38.99   0.573                     
## ---
## 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 = 4.8838, df = 34, p-value = 2.429e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.5864761 1.4224251
## sample estimates:
## mean of the differences 
##                1.004451
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.28887, df = 34, p-value = 0.7744
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.174464  0.232279
## sample estimates:
## mean of the differences 
##              0.02890751

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           35  0.27  0.084
## 2 invalid_same_c      c           35  0.773 0.132
## 3 invalid_different_c c           35 -0.379 0.086
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 34  14.61  0.4298               
## 
## Error: factor(workerId):validity
##           Df Sum Sq Mean Sq F value   Pr(>F)    
## validity   2  23.33  11.664   34.16 5.38e-11 ***
## Residuals 68  23.22   0.341                     
## ---
## 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 = -4.8838, df = 34, p-value = 2.429e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.7112125 -0.2932380
## sample estimates:
## mean of the differences 
##              -0.5022253
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 = 6.9178, df = 34, p-value = 5.684e-08
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.8132002 1.4897363
## sample estimates:
## mean of the differences 
##                1.151468

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, 5), label = TRUE, lab.nb.digits = 2, lab.vjust = c(-4, -4.5, -4.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_β             β           35  3.16 0.542
## 2 invalid_same_β      β           35  3.25 0.638
## 3 invalid_different_β β           35  3.16 0.605
aov_β <- aov(β ~ validity + Error(factor(workerId)/validity), tbl_paramters_β)
summary(aov_β)
## 
## Error: factor(workerId)
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 34   1064   31.29               
## 
## Error: factor(workerId):validity
##           Df Sum Sq Mean Sq F value Pr(>F)
## validity   2   0.18  0.0896    0.03  0.971
## Residuals 68 204.90  3.0132

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 = -0.1938, df = 34, p-value = 0.8475
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.9726381  0.8032794
## sample estimates:
## mean of the differences 
##             -0.08467937
tbl_paramters_β %>% 
  filter(validity == "invalid_same_β" | validity == "invalid_different_β") %>%
  with(t.test(β~validity,paired=TRUE))
## 
##  Paired t-test
## 
## data:  β by validity
## t = 0.22662, df = 34, p-value = 0.8221
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.7193561  0.8999254
## sample estimates:
## mean of the differences 
##              0.09028468