Raw RTs
Remove outlier trials
Next, we can remove outlier RTs that are more than 3 SDs away from the mean.
Let’s get the number of trials. This is the initial number of trials.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
group_by(workerId,image) %>%
dplyr::summarize(counts = n()) %>%
spread(image,counts) %>%
mutate(sum = rowSums(.[-1], na.rm = TRUE))
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts,10)
Before the data are trimmed, let’s generate histograms of all RTs and the mean RT of each subject
tbl_good_catch_acc_all_main_acc_inacc_trials_removed$rt_s = tbl_good_catch_acc_all_main_acc_inacc_trials_removed$rt/1000
tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
gghistogram(x = "rt_s", fill = "#f7a800", rug = TRUE, bins = 60, xlim = c(0,60), ylim = c(0,1500), xlab = ("Detection Raw RT (sec)"), title = "All Trials")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_mean_subj_RT <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
group_by(workerId) %>%
dplyr::summarize(mean_rt = mean(rt_s, na.rm=TRUE))
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_mean_subj_RT %>%
gghistogram(x = "mean_rt", fill = "#f7a800", rug = TRUE, bins = 45, xlim = c(0,45), ylim = c(0,40), xlab = ("Mean Detection Raw RT (sec)"), title = "All Subjects")

Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed)
## [1] 4018
Trial timer maxed out at 60 sec. Any RTs recorded as 60 sec should be discarded.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
filter(rt < 60000)
Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed)
## [1] 4014
Next, data are inspected for RT outliers. Two additional columns are added to the data table. First, an “outliers” column is added that labels an RT as an outlier or not (0 = not an outlier, 1 = an outlier less than 3 SDs, 2 = an outlier greater than 3 SDs). Second, a “removed_RT” column is added that contains non-outlier RTs.
Note: code can be changed to allow for replacement of outliers with the cutoff values.
correct.trials <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed[tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed$click_ACC == "1",]
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed <- ddply(correct.trials, .(workerId), function(x){
m <- mean(x$rt)
s <- sd(x$rt)
upper <- m + 3*s #change 3 with another number to increase or decrease cutoff criteria
lower <- m - 3*s #change 3 with another number to increase or decrease cutoff criteria
x$outliers <- 0
x$outliers[x$rt > upper] <- 2
x$outliers[x$rt < lower] <- 1
x$removed_RT <- x$rt
x$removed_RT[x$rt > upper]<- NA #change NA with upper to replace an outlier with the upper cutoff
x$removed_RT[x$rt < lower]<- NA #change NA with lower to replace an outlier with the lower cutoff
x
})
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed,10)
Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed)
## [1] 4014
Next, let’s completely toss out the outlier trials (labeled as NA).
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed[!is.na(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed$removed_RT),]
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed,10)
Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed)
## [1] 3924
Let’s get the number of trials. This is the number of trials that “survive” the data trimming.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
group_by(workerId,image) %>%
dplyr::summarize(counts = n()) %>%
spread(image,counts) %>%
mutate(sum = rowSums(.[-1], na.rm = TRUE))
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts,10)
Here are new histograms of all RTs and the mean RT of each subject.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
gghistogram(x = "rt_s", fill = "#f7a800", rug = TRUE, bins = 60, xlim = c(0,60), ylim = c(0,1200), xlab = ("Detection Raw RT (sec)"), title = "All Trials")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_mean_subj_RT <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
group_by(workerId) %>%
dplyr::summarize(mean_rt = mean(rt_s, na.rm=TRUE))
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_mean_subj_RT %>%
gghistogram(x = "mean_rt", fill = "#f7a800", rug = TRUE, bins = 25, xlim = c(0,25), ylim = c(0,50), xlab = ("Mean Detection Raw RT (sec)"), title = "All Subjects")

What is the percentage of outlier RTs that were removed overall?
tbl_all_main_acc_rts_3SD_removed_count <- data.frame(total_removed = tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum - tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts$sum)
per_RTs_removed <- (sum(tbl_all_main_acc_rts_3SD_removed_count) / sum(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum)) * 100
per_RTs_removed
## [1] 2.339472
What is the percentage of outlier RTs that were removed per subject? This is easy to visualize in a plot.
tbl_per_rts_3SD_removed_by_subj <- data.frame((tbl_all_main_acc_rts_3SD_removed_count / tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum) * 100)
tbl_per_rts_3SD_removed_by_subj <- cbind.data.frame(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts[1],tbl_all_main_acc_rts_3SD_removed_count,tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum,tbl_per_rts_3SD_removed_by_subj)
colnames(tbl_per_rts_3SD_removed_by_subj) <- c("workerId", "outlier_RTs", "total_RTs", "percent_excluded")
#head(tbl_per_rts_3SD_removed_by_subj,10)
tbl_per_rts_3SD_removed_by_subj %>%
ggbarplot(x = "workerId", y = "percent_excluded", ylab = "% Trials Excluded", fill = "#f7a800", font.xtickslab = 4, sort.val = c("asc")) + rotate_x_text()

Summary statistics
Let’s again confirm how many subjects we’re working with. This is the total number of subjects with good catch trial accuracy and good main trial accuracy.
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts %>% distinct(workerId,.keep_all = FALSE))
## [1] 196
Plot the results
This is a plot of the mean detection RT for each image.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
ggbarplot(x = "image", y = "rt_s", ylab = "Mean Detection Raw RT (sec)", fill = "#f7a800", add = "mean_se", font.xtickslab = 4, sort.val = c("asc"), title = "All stims", ylim = c(0,30)) + rotate_x_text() + theme(legend.position = "none")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
filter(grepl('_L_', image)) %>%
ggbarplot(x = "image", y = "rt_s", ylab = "Mean Detection Raw RT (sec)", fill = "#f7a800", add = "mean_se", font.xtickslab = 4, sort.val = c("asc"), title = "Change on Left", ylim = c(0,30)) + rotate_x_text() + theme(legend.position = "none")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
filter(grepl('_R_', image)) %>%
ggbarplot(x = "image", y = "rt_s", ylab = "Mean Detection Raw RT (sec)", fill = "#f7a800", add = "mean_se", font.xtickslab = 4, sort.val = c("asc"), title = "Change on Right", ylim = c(0,30)) + rotate_x_text() + theme(legend.position = "none")

This table contains the final count for each image. This is after RTs were excluded that were more than 3 SDs from the mean.
image_count_final <- data.frame(image_count = colSums(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts[,2:255], na.rm = TRUE))
knitr::kable(image_count_final)
| 001_L_mirror |
12 |
| 001_R_mirror |
21 |
| 002_L_napkin |
17 |
| 002_R_napkin |
19 |
| 003_L_ducks |
11 |
| 003_R_ducks |
13 |
| 004_L_electricalgrid |
13 |
| 004_R_electricalgrid |
22 |
| 005_L_mirror |
13 |
| 005_R_mirror |
20 |
| 006_L_vase |
18 |
| 006_R_vase |
20 |
| 007_L_soap |
15 |
| 007_R_soap |
22 |
| 008_L_bottle |
17 |
| 008_R_bottle |
23 |
| 009_L_carpet |
15 |
| 009_R_carpet |
20 |
| 010_L_candle |
6 |
| 010_R_candle |
8 |
| 011_L_parfum |
17 |
| 011_R_parfum |
16 |
| 012_L_tubaccesory |
9 |
| 012_R_tubaccesory |
17 |
| 013_L_lamp |
10 |
| 013_R_lamp |
20 |
| 014_L_lamp |
16 |
| 014_R_lamp |
21 |
| 015_L_ceilinglight |
10 |
| 015_R_ceilinglight |
9 |
| 016_L_art |
14 |
| 016_R_art |
25 |
| 017_L_wood |
9 |
| 017_R_wood |
9 |
| 018_L_plant |
17 |
| 018_R_plant |
25 |
| 019_L_lamp_sized |
12 |
| 019_R_lamp_sized |
20 |
| 020_L_walldeco |
18 |
| 020_R_walldeco |
21 |
| 021_L_keyboard |
17 |
| 021_R_keyboard |
20 |
| 022_L_lamp |
13 |
| 022_R_lamp |
21 |
| 023_L_remote |
13 |
| 023_R_remote |
22 |
| 024_L_towels |
17 |
| 024_R_towels |
17 |
| 025_L_vase |
13 |
| 025_R_vase |
18 |
| 026_L_rack |
11 |
| 026_R_rack |
18 |
| 027_L_soapdish |
13 |
| 027_R_soapdish |
13 |
| 028_L_vase |
14 |
| 028_R_vase |
18 |
| 029_L_glass |
15 |
| 029_R_glass |
21 |
| 030_L_drawer |
13 |
| 030_R_drawer |
23 |
| 031_L_log |
8 |
| 031_R_log |
16 |
| 032_L_bottle |
13 |
| 032_R_bottle |
12 |
| 033_L_vase |
13 |
| 033_R_vase |
23 |
| 034_L_handle |
7 |
| 034_R_handle |
15 |
| 035_L_fruit |
14 |
| 035_R_fruit |
17 |
| 036_L_bowl |
13 |
| 036_R_bowl |
17 |
| 037_L_towel |
4 |
| 037_R_towel |
14 |
| 038_L_art |
16 |
| 038_R_art |
22 |
| 039_L_ventilator |
2 |
| 039_R_ventilator |
11 |
| 040_L_painting |
13 |
| 040_R_painting |
21 |
| 041_L_fruit |
9 |
| 041_R_fruit |
6 |
| 042_L_tap |
11 |
| 042_R_tap |
17 |
| 043_L_clock |
17 |
| 043_R_clock |
20 |
| 044_L_light |
16 |
| 044_R_light |
15 |
| 045_L_musicdock |
17 |
| 045_R_musicdock |
23 |
| 046_L_remote |
9 |
| 046_R_remote |
18 |
| 047_L_handle |
10 |
| 047_R_handle |
15 |
| 048_L_art |
16 |
| 048_R_art |
20 |
| 049_L_painting |
13 |
| 049_R_painting |
23 |
| 050_L_book |
13 |
| 050_R_book |
18 |
| 051_L_owl |
16 |
| 051_R_owl |
23 |
| 052_L_speaker |
15 |
| 052_R_speaker |
21 |
| 053_L_handle |
7 |
| 053_R_handle |
9 |
| 054_L_firewood |
13 |
| 054_R_firewood |
20 |
| 055_R_carpet |
2 |
| 056_L_comforter |
16 |
| 056_R_comforter |
22 |
| 057_L_bin |
9 |
| 057_R_bin |
19 |
| 058_L_clutch |
14 |
| 058_R_clutch |
20 |
| 059_L_car |
12 |
| 059_R_car |
17 |
| 060_L_pillow |
18 |
| 060_R_pillow |
21 |
| 061_L_glass |
13 |
| 061_R_glass |
20 |
| 062_L_flowers |
18 |
| 062_R_flowers |
23 |
| 063_L_laptop |
5 |
| 063_R_laptop |
10 |
| 064_L_bottles |
14 |
| 064_R_bottles |
19 |
| 065_L_cd |
14 |
| 065_R_cd |
21 |
| 066_L_vase |
14 |
| 066_R_vase |
16 |
| 067_L_painting |
11 |
| 067_R_painting |
15 |
| 068_L_faucet |
15 |
| 068_R_faucet |
20 |
| 069_L_things |
15 |
| 069_R_things |
14 |
| 070_L_lamp |
16 |
| 070_R_lamp |
24 |
| 071_L_art |
14 |
| 071_R_art |
25 |
| 072_L_handle |
15 |
| 072_R_handle |
16 |
| 073_L_coffeemug |
10 |
| 073_R_coffeemug |
17 |
| 074_L_book |
17 |
| 074_R_book |
23 |
| 075_L_light |
12 |
| 075_R_light |
17 |
| 076_L_hook |
12 |
| 076_R_hook |
17 |
| 077_L_footrest |
4 |
| 077_R_footrest |
15 |
| 078_L_faucet |
9 |
| 078_R_faucet |
19 |
| 079_L_bowl |
12 |
| 079_R_bowl |
16 |
| 080_L_plant |
12 |
| 080_R_plant |
25 |
| 081_L_football |
11 |
| 081_R_football |
12 |
| 082_L_bowl |
11 |
| 082_R_bowl |
17 |
| 083_L_knob |
7 |
| 083_R_knob |
14 |
| 084_L_light |
13 |
| 084_R_light |
26 |
| 085_L_switchboard |
11 |
| 085_R_switchboard |
13 |
| 086_L_book |
16 |
| 086_R_book |
17 |
| 087_L_towelhandle |
16 |
| 087_R_towelhandle |
21 |
| 088_L_clock |
12 |
| 088_R_clock |
11 |
| 089_L_poster |
8 |
| 089_R_poster |
16 |
| 090_L_lamp |
10 |
| 090_R_lamp |
16 |
| 091_L_airfreshener |
6 |
| 091_R_airfreshener |
11 |
| 092_L_candles |
14 |
| 092_R_candles |
18 |
| 093_L_switch |
11 |
| 093_R_switch |
19 |
| 095_L_candle |
16 |
| 095_R_candle |
19 |
| 096_L_painting |
13 |
| 096_R_painting |
19 |
| 097_L_light |
12 |
| 097_R_light |
20 |
| 098_L_slippers |
13 |
| 098_R_slippers |
18 |
| 099_L_sconce |
13 |
| 099_R_sconce |
17 |
| 100_L_mirror |
19 |
| 100_R_mirror |
25 |
| 101_L_cup |
14 |
| 101_R_cup |
22 |
| 102_L_shoppingbag |
13 |
| 102_R_shoppingbag |
21 |
| 103_L_hook |
4 |
| 103_R_hook |
6 |
| 104_L_bottle |
18 |
| 104_R_bottle |
18 |
| 105_L_hat |
15 |
| 105_R_hat |
19 |
| 106_L_toweldispenser |
17 |
| 106_R_toweldispenser |
19 |
| 107_L_shirts |
15 |
| 107_R_shirts |
21 |
| 108_L_boa |
12 |
| 108_R_boa |
20 |
| 109_L_pillow |
15 |
| 109_R_pillow |
20 |
| 110_L_plant |
12 |
| 110_R_plant |
21 |
| 111_L_pot |
15 |
| 111_R_pot |
22 |
| 112_L_basket |
13 |
| 112_R_basket |
20 |
| 113_L_plant |
11 |
| 113_R_plant |
15 |
| 114_L_bird |
14 |
| 114_R_bird |
17 |
| 115_L_pot |
12 |
| 115_R_pot |
15 |
| 116_L_basket |
15 |
| 116_R_basket |
20 |
| 117_L_plant_sized |
15 |
| 117_R_plant_sized |
20 |
| 118_L_shoes |
17 |
| 118_R_shoes |
19 |
| 119_L_painting |
16 |
| 119_R_painting |
19 |
| 120_L_art |
14 |
| 120_R_art |
14 |
| 121_L_car |
13 |
| 121_R_car |
20 |
| 122_L_chair |
9 |
| 122_R_chair |
13 |
| 123_L_pot |
14 |
| 123_R_pot |
20 |
| 124_L_vase |
12 |
| 124_R_vase |
20 |
| 125_L_sofa |
18 |
| 125_R_sofa |
22 |
| 126_L_candles |
13 |
| 126_R_candles |
19 |
| 127_L_light |
15 |
| 127_R_light |
18 |
| 128_L_pot |
12 |
| 128_R_pot |
15 |
| sum |
3924 |
Splash vs. Flicker
This final section compares the RT data from the images with the mudsplashes and the images without mudsplashes.
wolfe_mudsplash <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
group_by(image) %>%
dplyr::summarize(mean_rt = mean(rt_s, na.rm=TRUE)) %>%
separate(image,into=c('stim'), sep=5)
wolfe_flicker <- read_csv("./change_blindness_wolfe_behav.csv")
## Warning: Missing column names filled in: 'X1' [1]
wolfe_flicker <-cbind.data.frame(wolfe_flicker[2], wolfe_flicker[7])
wolfe_RTs <- merge(wolfe_mudsplash, wolfe_flicker, by.x='stim')
colnames(wolfe_RTs) <- c("image", "splash", "flicker")
wolfe_RTs_long <- gather(wolfe_RTs, condition, RT, splash:flicker, factor_key=TRUE)
wolfe_RTs_long %>%
group_by(condition) %>%
get_summary_stats(RT, type = "mean_se")
## # A tibble: 2 x 5
## condition variable n mean se
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 splash RT 253 10.2 0.137
## 2 flicker RT 253 13.5 0.521
wolfe_RTs_long %>%
with(t.test(RT~condition,paired=TRUE))
##
## Paired t-test
##
## data: RT by condition
## t = -6.7525, df = 252, p-value = 9.968e-11
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -4.289901 -2.352567
## sample estimates:
## mean of the differences
## -3.321234
wolfe_RTs_long %>%
ggbarplot("image", "RT", fill = "condition", color = "condition", palette = "jco", position = position_dodge(0.9), font.xtickslab = 4, ylab = "Mean Detection Raw RT (sec)", title = "All stims", ylim = c(0,50)) + rotate_x_text()

wolfe_RTs %>%
ggpaired(cond1 = "splash", cond2 = "flicker", fill = "condition", palette = "jco", ylab = "Mean Detection Raw RT (sec)", title = "All stims", ylim = c(0,50))

wolfe_RTs %>%
ggscatter(x = "splash", y = "flicker", xlab = "Mean Splash Detection Raw RT (sec)", ylab = "Mean Flicker Detection Raw RT (sec)", fill = "#f7a800", color = "#f7a800", add = "reg.line", cor.coef = TRUE, cor.coeff.args = list(method = "pearson", label.x = 0, label.sep = "\n"), ylim = c(0, 50), xlim = c(0, 50), title = "All stims")

wolfe_RTs_long %>%
group_by(condition) %>%
filter(grepl('_L', image)) %>%
get_summary_stats(RT, type = "mean_se")
## # A tibble: 2 x 5
## condition variable n mean se
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 splash RT 126 10.3 0.22
## 2 flicker RT 126 13.6 0.701
wolfe_RTs_long %>%
filter(grepl('_L', image)) %>%
with(t.test(RT~condition,paired=TRUE))
##
## Paired t-test
##
## data: RT by condition
## t = -4.9831, df = 125, p-value = 2.037e-06
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -4.508576 -1.945295
## sample estimates:
## mean of the differences
## -3.226935
wolfe_RTs_long %>%
filter(grepl('_L', image)) %>%
ggbarplot("image", "RT", fill = "condition", color = "condition", palette = "jco", position = position_dodge(0.9), font.xtickslab = 4, ylab = "Mean Detection Raw RT (sec)", title = "Change on Left", ylim = c(0,50)) + rotate_x_text()

wolfe_RTs %>%
filter(grepl('_L', image)) %>%
ggpaired(cond1 = "splash", cond2 = "flicker", fill = "condition", palette = "jco", ylab = "Mean Detection Raw RT (sec)", title = "Change on Left", ylim = c(0,50))

wolfe_RTs %>%
filter(grepl('_L', image)) %>%
ggscatter(x = "splash", y = "flicker", xlab = "Mean Splash Detection Raw RT (sec)", ylab = "Mean Flicker Detection Raw RT (sec)", fill = "#f7a800", color = "#f7a800", add = "reg.line", cor.coef = TRUE, cor.coeff.args = list(method = "pearson", label.x = 0, label.sep = "\n"), ylim = c(0, 50), xlim = c(0, 50), title = "Change on Left")

wolfe_RTs_long %>%
group_by(condition) %>%
filter(grepl('_R', image)) %>%
get_summary_stats(RT, type = "mean_se")
## # A tibble: 2 x 5
## condition variable n mean se
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 splash RT 127 10.1 0.163
## 2 flicker RT 127 13.5 0.773
wolfe_RTs_long %>%
filter(grepl('_R', image)) %>%
with(t.test(RT~condition,paired=TRUE))
##
## Paired t-test
##
## data: RT by condition
## t = -4.6004, df = 126, p-value = 1.013e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -4.883733 -1.945848
## sample estimates:
## mean of the differences
## -3.41479
wolfe_RTs_long %>%
filter(grepl('_R', image)) %>%
ggbarplot("image", "RT", fill = "condition", color = "condition", palette = "jco", position = position_dodge(0.9), font.xtickslab = 4, ylab = "Mean Detection Raw RT (sec)", title = "Change on Right", ylim = c(0,50)) + rotate_x_text()

wolfe_RTs %>%
filter(grepl('_R', image)) %>%
ggpaired(cond1 = "splash", cond2 = "flicker", fill = "condition", palette = "jco", ylab = "Mean Detection Raw RT (sec)", title = "Change on Right", ylim = c(0,50))

wolfe_RTs %>%
filter(grepl('_R', image)) %>%
ggscatter(x = "splash", y = "flicker", xlab = "Mean Splash Detection Raw RT (sec)", ylab = "Mean Flicker Detection Raw RT (sec)", fill = "#f7a800", color = "#f7a800", add = "reg.line", cor.coef = TRUE, cor.coeff.args = list(method = "pearson", label.x = 0, label.sep = "\n"), ylim = c(0, 50), xlim = c(0, 50), title = "Change on Right")

Log RTs
Remove outlier trials
Next, we can remove outlier RTs that are more than 3 SDs away from the mean.
Let’s get the number of trials. This is the initial number of trials.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
group_by(workerId,image) %>%
dplyr::summarize(counts = n()) %>%
spread(image,counts) %>%
mutate(sum = rowSums(.[-1], na.rm = TRUE))
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts,10)
Convert raw RTs to log-transformed RTs
tbl_good_catch_acc_all_main_acc_inacc_trials_removed$rt_s = tbl_good_catch_acc_all_main_acc_inacc_trials_removed$rt/1000
tbl_good_catch_acc_all_main_acc_inacc_trials_removed$log_rt = log10(tbl_good_catch_acc_all_main_acc_inacc_trials_removed$rt_s)
Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed)
## [1] 4018
Before the data are trimmed, let’s generate histograms of all RTs and the mean RT of each subject
tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
gghistogram(x = "log_rt", fill = "#f7a800", rug = TRUE, bins = 60, xlim = c(0,2), ylim = c(0,800), xlab = ("Detection Log RT"), title = "All Trials")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_mean_subj_log_RT <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
group_by(workerId) %>%
dplyr::summarize(mean_rt = mean(log_rt, na.rm=TRUE))
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_mean_subj_log_RT %>%
gghistogram(x = "mean_rt", fill = "#f7a800", rug = TRUE, bins = 35, xlim = c(0,2), ylim = c(0,25), xlab = ("Mean Detection Log RT"), title = "All Subjects")

Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed)
## [1] 4018
Trial timer maxed out at 60 sec. Any RTs recorded as 60 sec should be discarded.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
filter(rt < 60000)
Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed)
## [1] 4014
Next, data are inspected for RT outliers. Two additional columns are added to the data table. First, an “outliers” column is added that labels an RT as an outlier or not (0 = not an outlier, 1 = an outlier less than 3 SDs, 2 = an outlier greater than 3 SDs). Second, a “removed_RT” column is added that contains non-outlier RTs.
Note: code can be changed to allow for replacement of outliers with the cutoff values.
correct.trials <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed[tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed$click_ACC == "1",]
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed <- ddply(correct.trials, .(workerId), function(x){
m <- mean(x$log_rt)
s <- sd(x$log_rt)
upper <- m + 3*s #change 3 with another number to increase or decrease cutoff criteria
lower <- m - 3*s #change 3 with another number to increase or decrease cutoff criteria
x$outliers <- 0
x$outliers[x$log_rt > upper] <- 2
x$outliers[x$log_rt < lower] <- 1
x$removed_RT <- x$log_rt
x$removed_RT[x$log_rt > upper]<- NA #change NA with upper to replace an outlier with the upper cutoff
x$removed_RT[x$log_rt < lower]<- NA #change NA with lower to replace an outlier with the lower cutoff
x
})
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed,10)
Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed)
## [1] 4014
Next, let’s completely toss out the outlier trials (labeled as NA).
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed[!is.na(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed$removed_RT),]
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed,10)
Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed)
## [1] 3968
Let’s get the number of trials. This is the number of trials that “survive” the data trimming.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
group_by(workerId,image) %>%
dplyr::summarize(counts = n()) %>%
spread(image,counts) %>%
mutate(sum = rowSums(.[-1], na.rm = TRUE))
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts,10)
Here are new histograms of all RTs and the mean RT of each subject.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
gghistogram(x = "log_rt", fill = "#f7a800", rug = TRUE, bins = 30, xlim = c(0,2), ylim = c(0,1000), xlab = ("Detection Log RT"), title = "All Trials")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_mean_subj_RT <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
group_by(workerId) %>%
dplyr::summarize(mean_rt = mean(log_rt, na.rm=TRUE))
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_mean_subj_RT %>%
gghistogram(x = "mean_rt", fill = "#f7a800", rug = TRUE, bins = 15, xlim = c(0,2), ylim = c(0,40), xlab = ("Mean Detection Log RT"), title = "All Subjects")

What is the percentage of outlier RTs that were removed overall?
tbl_all_main_acc_rts_3SD_removed_count <- data.frame(total_removed = tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum - tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts$sum)
per_RTs_removed <- (sum(tbl_all_main_acc_rts_3SD_removed_count) / sum(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum)) * 100
per_RTs_removed
## [1] 1.2444
What is the percentage of outlier RTs that were removed per subject? This is easy to visualize in a plot.
tbl_per_rts_3SD_removed_by_subj <- data.frame((tbl_all_main_acc_rts_3SD_removed_count / tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum) * 100)
tbl_per_rts_3SD_removed_by_subj <- cbind.data.frame(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts[1],tbl_all_main_acc_rts_3SD_removed_count,tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum,tbl_per_rts_3SD_removed_by_subj)
colnames(tbl_per_rts_3SD_removed_by_subj) <- c("workerId", "outlier_RTs", "total_RTs", "percent_excluded")
#head(tbl_per_rts_3SD_removed_by_subj,10)
tbl_per_rts_3SD_removed_by_subj %>%
ggbarplot(x = "workerId", y = "percent_excluded", ylab = "% Trials Excluded", fill = "#f7a800", font.xtickslab = 4, sort.val = c("asc")) + rotate_x_text()

Summary statistics
Let’s again confirm how many subjects we’re working with. This is the total number of subjects with good catch trial accuracy and good main trial accuracy.
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts %>% distinct(workerId,.keep_all = FALSE))
## [1] 196
Plot the results
This is a plot of the mean detection RT for each image.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
ggbarplot(x = "image", y = "log_rt", ylab = "Mean Detection Log RT", fill = "#f7a800", add = "mean_se", ylim = c(0,1.5), font.xtickslab = 4, sort.val = c("asc"), title = "All stims") + rotate_x_text() + theme(legend.position = "none")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
filter(grepl('_L_', image)) %>%
ggbarplot(x = "image", y = "log_rt", ylab = "Mean Detection Log RT (sec)", fill = "#f7a800", add = "mean_se", font.xtickslab = 4, sort.val = c("asc"), title = "Change on Left", ylim = c(0,1.5)) + rotate_x_text() + theme(legend.position = "none")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
filter(grepl('_R_', image)) %>%
ggbarplot(x = "image", y = "log_rt", ylab = "Mean Detection Log RT (sec)", fill = "#f7a800", add = "mean_se", font.xtickslab = 4, sort.val = c("asc"), title = "Change on Right", ylim = c(0,1.5)) + rotate_x_text() + theme(legend.position = "none")

This table contains the final count for each image. This is after RTs were excluded that were more than 3 SDs from the mean.
image_count_final <- data.frame(image_count = colSums(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts[,2:255], na.rm = TRUE))
knitr::kable(image_count_final)
| 001_L_mirror |
12 |
| 001_R_mirror |
21 |
| 002_L_napkin |
17 |
| 002_R_napkin |
19 |
| 003_L_ducks |
11 |
| 003_R_ducks |
13 |
| 004_L_electricalgrid |
13 |
| 004_R_electricalgrid |
22 |
| 005_L_mirror |
13 |
| 005_R_mirror |
20 |
| 006_L_vase |
18 |
| 006_R_vase |
20 |
| 007_L_soap |
16 |
| 007_R_soap |
22 |
| 008_L_bottle |
17 |
| 008_R_bottle |
23 |
| 009_L_carpet |
15 |
| 009_R_carpet |
20 |
| 010_L_candle |
6 |
| 010_R_candle |
8 |
| 011_L_parfum |
17 |
| 011_R_parfum |
16 |
| 012_L_tubaccesory |
9 |
| 012_R_tubaccesory |
17 |
| 013_L_lamp |
10 |
| 013_R_lamp |
21 |
| 014_L_lamp |
16 |
| 014_R_lamp |
21 |
| 015_L_ceilinglight |
10 |
| 015_R_ceilinglight |
11 |
| 016_L_art |
14 |
| 016_R_art |
25 |
| 017_L_wood |
9 |
| 017_R_wood |
10 |
| 018_L_plant |
17 |
| 018_R_plant |
25 |
| 019_L_lamp_sized |
12 |
| 019_R_lamp_sized |
22 |
| 020_L_walldeco |
18 |
| 020_R_walldeco |
21 |
| 021_L_keyboard |
17 |
| 021_R_keyboard |
20 |
| 022_L_lamp |
15 |
| 022_R_lamp |
21 |
| 023_L_remote |
13 |
| 023_R_remote |
22 |
| 024_L_towels |
17 |
| 024_R_towels |
18 |
| 025_L_vase |
13 |
| 025_R_vase |
18 |
| 026_L_rack |
11 |
| 026_R_rack |
18 |
| 027_L_soapdish |
13 |
| 027_R_soapdish |
14 |
| 028_L_vase |
14 |
| 028_R_vase |
19 |
| 029_L_glass |
15 |
| 029_R_glass |
21 |
| 030_L_drawer |
14 |
| 030_R_drawer |
23 |
| 031_L_log |
8 |
| 031_R_log |
17 |
| 032_L_bottle |
13 |
| 032_R_bottle |
12 |
| 033_L_vase |
13 |
| 033_R_vase |
23 |
| 034_L_handle |
8 |
| 034_R_handle |
15 |
| 035_L_fruit |
14 |
| 035_R_fruit |
17 |
| 036_L_bowl |
13 |
| 036_R_bowl |
17 |
| 037_L_towel |
5 |
| 037_R_towel |
14 |
| 038_L_art |
16 |
| 038_R_art |
22 |
| 039_L_ventilator |
4 |
| 039_R_ventilator |
11 |
| 040_L_painting |
13 |
| 040_R_painting |
22 |
| 041_L_fruit |
10 |
| 041_R_fruit |
6 |
| 042_L_tap |
12 |
| 042_R_tap |
17 |
| 043_L_clock |
18 |
| 043_R_clock |
20 |
| 044_L_light |
16 |
| 044_R_light |
16 |
| 045_L_musicdock |
17 |
| 045_R_musicdock |
23 |
| 046_L_remote |
9 |
| 046_R_remote |
18 |
| 047_L_handle |
10 |
| 047_R_handle |
15 |
| 048_L_art |
16 |
| 048_R_art |
20 |
| 049_L_painting |
13 |
| 049_R_painting |
23 |
| 050_L_book |
13 |
| 050_R_book |
19 |
| 051_L_owl |
16 |
| 051_R_owl |
23 |
| 052_L_speaker |
15 |
| 052_R_speaker |
21 |
| 053_L_handle |
7 |
| 053_R_handle |
9 |
| 054_L_firewood |
13 |
| 054_R_firewood |
20 |
| 055_R_carpet |
2 |
| 056_L_comforter |
17 |
| 056_R_comforter |
22 |
| 057_L_bin |
9 |
| 057_R_bin |
19 |
| 058_L_clutch |
14 |
| 058_R_clutch |
20 |
| 059_L_car |
12 |
| 059_R_car |
17 |
| 060_L_pillow |
18 |
| 060_R_pillow |
22 |
| 061_L_glass |
13 |
| 061_R_glass |
20 |
| 062_L_flowers |
18 |
| 062_R_flowers |
23 |
| 063_L_laptop |
6 |
| 063_R_laptop |
10 |
| 064_L_bottles |
14 |
| 064_R_bottles |
19 |
| 065_L_cd |
14 |
| 065_R_cd |
22 |
| 066_L_vase |
15 |
| 066_R_vase |
16 |
| 067_L_painting |
11 |
| 067_R_painting |
16 |
| 068_L_faucet |
15 |
| 068_R_faucet |
20 |
| 069_L_things |
15 |
| 069_R_things |
14 |
| 070_L_lamp |
16 |
| 070_R_lamp |
24 |
| 071_L_art |
14 |
| 071_R_art |
25 |
| 072_L_handle |
15 |
| 072_R_handle |
16 |
| 073_L_coffeemug |
11 |
| 073_R_coffeemug |
18 |
| 074_L_book |
17 |
| 074_R_book |
23 |
| 075_L_light |
12 |
| 075_R_light |
18 |
| 076_L_hook |
12 |
| 076_R_hook |
17 |
| 077_L_footrest |
4 |
| 077_R_footrest |
15 |
| 078_L_faucet |
9 |
| 078_R_faucet |
19 |
| 079_L_bowl |
12 |
| 079_R_bowl |
16 |
| 080_L_plant |
13 |
| 080_R_plant |
25 |
| 081_L_football |
11 |
| 081_R_football |
12 |
| 082_L_bowl |
11 |
| 082_R_bowl |
17 |
| 083_L_knob |
8 |
| 083_R_knob |
14 |
| 084_L_light |
14 |
| 084_R_light |
26 |
| 085_L_switchboard |
11 |
| 085_R_switchboard |
13 |
| 086_L_book |
16 |
| 086_R_book |
17 |
| 087_L_towelhandle |
16 |
| 087_R_towelhandle |
21 |
| 088_L_clock |
12 |
| 088_R_clock |
12 |
| 089_L_poster |
8 |
| 089_R_poster |
16 |
| 090_L_lamp |
10 |
| 090_R_lamp |
17 |
| 091_L_airfreshener |
6 |
| 091_R_airfreshener |
11 |
| 092_L_candles |
14 |
| 092_R_candles |
18 |
| 093_L_switch |
11 |
| 093_R_switch |
19 |
| 095_L_candle |
16 |
| 095_R_candle |
19 |
| 096_L_painting |
13 |
| 096_R_painting |
19 |
| 097_L_light |
12 |
| 097_R_light |
20 |
| 098_L_slippers |
13 |
| 098_R_slippers |
18 |
| 099_L_sconce |
13 |
| 099_R_sconce |
17 |
| 100_L_mirror |
19 |
| 100_R_mirror |
25 |
| 101_L_cup |
14 |
| 101_R_cup |
25 |
| 102_L_shoppingbag |
13 |
| 102_R_shoppingbag |
21 |
| 103_L_hook |
4 |
| 103_R_hook |
8 |
| 104_L_bottle |
18 |
| 104_R_bottle |
18 |
| 105_L_hat |
15 |
| 105_R_hat |
19 |
| 106_L_toweldispenser |
17 |
| 106_R_toweldispenser |
19 |
| 107_L_shirts |
15 |
| 107_R_shirts |
21 |
| 108_L_boa |
12 |
| 108_R_boa |
20 |
| 109_L_pillow |
15 |
| 109_R_pillow |
20 |
| 110_L_plant |
12 |
| 110_R_plant |
21 |
| 111_L_pot |
15 |
| 111_R_pot |
22 |
| 112_L_basket |
13 |
| 112_R_basket |
20 |
| 113_L_plant |
11 |
| 113_R_plant |
15 |
| 114_L_bird |
14 |
| 114_R_bird |
17 |
| 115_L_pot |
12 |
| 115_R_pot |
16 |
| 116_L_basket |
15 |
| 116_R_basket |
20 |
| 117_L_plant_sized |
15 |
| 117_R_plant_sized |
20 |
| 118_L_shoes |
17 |
| 118_R_shoes |
19 |
| 119_L_painting |
16 |
| 119_R_painting |
19 |
| 120_L_art |
14 |
| 120_R_art |
14 |
| 121_L_car |
13 |
| 121_R_car |
20 |
| 122_L_chair |
9 |
| 122_R_chair |
13 |
| 123_L_pot |
14 |
| 123_R_pot |
20 |
| 124_L_vase |
12 |
| 124_R_vase |
20 |
| 125_L_sofa |
18 |
| 125_R_sofa |
22 |
| 126_L_candles |
13 |
| 126_R_candles |
19 |
| 127_L_light |
15 |
| 127_R_light |
18 |
| 128_L_pot |
12 |
| 128_R_pot |
15 |
| sum |
3968 |
Splash vs. Flicker
This final section compares the RT data from the images with the mudsplashes and the images without mudsplashes.
wolfe_mudsplash <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
group_by(image) %>%
dplyr::summarize(mean_rt = mean(log_rt, na.rm=TRUE)) %>%
separate(image,into=c('stim'), sep=5)
wolfe_flicker <- read_csv("./change_blindness_wolfe_behav.csv")
## Warning: Missing column names filled in: 'X1' [1]
wolfe_flicker <-cbind.data.frame(wolfe_flicker[2], wolfe_flicker[10])
wolfe_RTs <- merge(wolfe_mudsplash, wolfe_flicker, by.x='stim')
colnames(wolfe_RTs) <- c("image", "splash", "flicker")
wolfe_RTs_long <- gather(wolfe_RTs, condition, RT, splash:flicker, factor_key=TRUE)
wolfe_RTs_long %>%
group_by(condition) %>%
get_summary_stats(RT, type = "mean_se")
## # A tibble: 2 x 5
## condition variable n mean se
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 splash RT 253 0.971 0.005
## 2 flicker RT 253 1.05 0.017
wolfe_RTs_long %>%
with(t.test(RT~condition,paired=TRUE))
##
## Paired t-test
##
## data: RT by condition
## t = -4.9257, df = 252, p-value = 1.523e-06
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.11098154 -0.04758295
## sample estimates:
## mean of the differences
## -0.07928225
wolfe_RTs_long %>%
ggbarplot("image", "RT", fill = "condition", color = "condition", palette = "jco", position = position_dodge(0.9), font.xtickslab = 4, ylab = "Mean Detection Log RT (sec)", title = "All stims", ylim = c(0,2)) + rotate_x_text()

wolfe_RTs %>%
ggpaired(cond1 = "splash", cond2 = "flicker", fill = "condition", palette = "jco", ylab = "Mean Detection Log RT (sec)", title = "All stims", ylim = c(0,2))

wolfe_RTs %>%
ggscatter(x = "splash", y = "flicker", xlab = "Mean Splash Detection Log RT (sec)", ylab = "Mean Flicker Detection Log RT (sec)", fill = "#f7a800", color = "#f7a800", add = "reg.line", cor.coef = TRUE, cor.coeff.args = list(method = "pearson", label.x = 0, label.sep = "\n"), ylim = c(0, 2), xlim = c(0, 2), title = "All stims")

wolfe_RTs_long %>%
group_by(condition) %>%
filter(grepl('_L', image)) %>%
get_summary_stats(RT, type = "mean_se")
## # A tibble: 2 x 5
## condition variable n mean se
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 splash RT 126 0.972 0.007
## 2 flicker RT 126 1.06 0.023
wolfe_RTs_long %>%
filter(grepl('_L', image)) %>%
with(t.test(RT~condition,paired=TRUE))
##
## Paired t-test
##
## data: RT by condition
## t = -3.9421, df = 125, p-value = 0.0001337
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.12958934 -0.04296094
## sample estimates:
## mean of the differences
## -0.08627514
wolfe_RTs_long %>%
filter(grepl('_L', image)) %>%
ggbarplot("image", "RT", fill = "condition", color = "condition", palette = "jco", position = position_dodge(0.9), font.xtickslab = 4, ylab = "Mean Detection Log RT (sec)", title = "Change on Left", ylim = c(0,2)) + rotate_x_text()

wolfe_RTs %>%
filter(grepl('_L', image)) %>%
ggpaired(cond1 = "splash", cond2 = "flicker", fill = "condition", palette = "jco", ylab = "Mean Detection Log RT (sec)", title = "Change on Left", ylim = c(0,2))

wolfe_RTs %>%
filter(grepl('_L', image)) %>%
ggscatter(x = "splash", y = "flicker", xlab = "Mean Splash Detection Log RT (sec)", ylab = "Mean Flicker Detection Log RT (sec)", fill = "#f7a800", color = "#f7a800", add = "reg.line", cor.coef = TRUE, cor.coeff.args = list(method = "pearson", label.x = 0, label.sep = "\n"), ylim = c(0, 2), xlim = c(0, 2), title = "Change on Left")

wolfe_RTs_long %>%
group_by(condition) %>%
filter(grepl('_R', image)) %>%
get_summary_stats(RT, type = "mean_se")
## # A tibble: 2 x 5
## condition variable n mean se
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 splash RT 127 0.97 0.006
## 2 flicker RT 127 1.04 0.026
wolfe_RTs_long %>%
filter(grepl('_R', image)) %>%
with(t.test(RT~condition,paired=TRUE))
##
## Paired t-test
##
## data: RT by condition
## t = -3.0571, df = 126, p-value = 0.00273
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.11917581 -0.02551302
## sample estimates:
## mean of the differences
## -0.07234442
wolfe_RTs_long %>%
filter(grepl('_R', image)) %>%
ggbarplot("image", "RT", fill = "condition", color = "condition", palette = "jco", position = position_dodge(0.9), font.xtickslab = 4, ylab = "Mean Detection Log RT (sec)", title = "Change on Right", ylim = c(0,2)) + rotate_x_text()

wolfe_RTs %>%
filter(grepl('_R', image)) %>%
ggpaired(cond1 = "splash", cond2 = "flicker", fill = "condition", palette = "jco", ylab = "Mean Detection Log RT (sec)", title = "Change on Right", ylim = c(0,2))

wolfe_RTs %>%
filter(grepl('_R', image)) %>%
ggscatter(x = "splash", y = "flicker", xlab = "Mean Splash Detection Log RT (sec)", ylab = "Mean Flicker Detection Log RT (sec)", fill = "#f7a800", color = "#f7a800", add = "reg.line", cor.coef = TRUE, cor.coeff.args = list(method = "pearson", label.x = 0, label.sep = "\n"), ylim = c(0, 2), xlim = c(0, 2), title = "Change on Right")

Cycles
Remove outlier trials
Next, we can remove outlier RTs that are more than 3 SDs away from the mean.
Let’s get the number of trials. This is the initial number of trials.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
group_by(workerId,image) %>%
dplyr::summarize(counts = n()) %>%
spread(image,counts) %>%
mutate(sum = rowSums(.[-1], na.rm = TRUE))
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts,10)
Before the data are trimmed, let’s generate histograms of all RTs and the mean RT of each subject
tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
gghistogram(x = "cycles", fill = "#f7a800", rug = TRUE, bins = 30, xlim = c(0,20), ylim = c(0,1600), xlab = ("Number of Cycles"), title = "All Trials")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_mean_subj_RT <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
group_by(workerId) %>%
dplyr::summarize(mean_cycles = mean(cycles, na.rm=TRUE))
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_mean_subj_RT %>%
gghistogram(x = "mean_cycles", fill = "#f7a800", rug = TRUE, bins = 30, xlim = c(0,15), ylim = c(0,40), xlab = ("Mean Number of Cycles"), title = "All Subjects")

Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed)
## [1] 4018
Trial timer maxed out at 60 sec. Any RTs recorded as 60 sec should be discarded.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed %>%
filter(rt < 60000)
Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed)
## [1] 4014
Next, data are inspected for RT outliers. Two additional columns are added to the data table. First, an “outliers” column is added that labels an RT as an outlier or not (0 = not an outlier, 1 = an outlier less than 3 SDs, 2 = an outlier greater than 3 SDs). Second, a “removed_RT” column is added that contains non-outlier RTs.
Note: code can be changed to allow for replacement of outliers with the cutoff values.
correct.trials <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed[tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed$click_ACC == "1",]
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed <- ddply(correct.trials, .(workerId), function(x){
m <- mean(x$cycles)
s <- sd(x$cycles)
upper <- m + 3*s #change 3 with another number to increase or decrease cutoff criteria
lower <- m - 3*s #change 3 with another number to increase or decrease cutoff criteria
x$outliers <- 0
x$outliers[x$cycles > upper] <- 2
x$outliers[x$cycles < lower] <- 1
x$removed_RT <- x$cycles
x$removed_RT[x$cycles > upper]<- NA #change NA with upper to replace an outlier with the upper cutoff
x$removed_RT[x$cycles < lower]<- NA #change NA with lower to replace an outlier with the lower cutoff
x
})
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed,10)
Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed)
## [1] 4014
Next, let’s completely toss out the outlier trials (labeled as NA).
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed[!is.na(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed$removed_RT),]
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed,10)
Count the number of trials
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed)
## [1] 3924
Let’s get the number of trials. This is the number of trials that “survive” the data trimming.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
group_by(workerId,image) %>%
dplyr::summarize(counts = n()) %>%
spread(image,counts) %>%
mutate(sum = rowSums(.[-1], na.rm = TRUE))
#head(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts,10)
Here are new histograms of all RTs and the mean RT of each subject.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
gghistogram(x = "cycles", fill = "#f7a800", rug = TRUE, bins = 30, xlim = c(0,20), ylim = c(0,1600), xlab = ("Number of Cycles"), title = "All Trials")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_mean_subj_RT <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
group_by(workerId) %>%
dplyr::summarize(mean_cycles = mean(cycles, na.rm=TRUE))
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_mean_subj_RT %>%
gghistogram(x = "mean_cycles", fill = "#f7a800", rug = TRUE, bins = 30, xlim = c(0,10), ylim = c(0,40), xlab = ("Mean Number of Cycles"), title = "All Subjects")

What is the percentage of outlier RTs that were removed overall?
tbl_all_main_acc_rts_3SD_removed_count <- data.frame(total_removed = tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum - tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts$sum)
per_RTs_removed <- (sum(tbl_all_main_acc_rts_3SD_removed_count) / sum(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum)) * 100
per_RTs_removed
## [1] 2.339472
What is the percentage of outlier RTs that were removed per subject? This is easy to visualize in a plot.
tbl_per_rts_3SD_removed_by_subj <- data.frame((tbl_all_main_acc_rts_3SD_removed_count / tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum) * 100)
tbl_per_rts_3SD_removed_by_subj <- cbind.data.frame(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts[1],tbl_all_main_acc_rts_3SD_removed_count,tbl_good_catch_acc_all_main_acc_inacc_trials_removed_counts$sum,tbl_per_rts_3SD_removed_by_subj)
colnames(tbl_per_rts_3SD_removed_by_subj) <- c("workerId", "outlier_RTs", "total_RTs", "percent_excluded")
#head(tbl_per_rts_3SD_removed_by_subj,10)
tbl_per_rts_3SD_removed_by_subj %>%
ggbarplot(x = "workerId", y = "percent_excluded", ylab = "% Trials Excluded", fill = "#f7a800", font.xtickslab = 4, sort.val = c("asc")) + rotate_x_text()

Summary statistics
Let’s again confirm how many subjects we’re working with. This is the total number of subjects with good catch trial accuracy and good main trial accuracy.
nrow(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts %>% distinct(workerId,.keep_all = FALSE))
## [1] 196
Plot the results
This is a plot of the mean cyclesfor each image.
tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
ggbarplot(x = "image", y = "cycles", ylab = "Mean Number of Cycles", fill = "#f7a800", add = "mean_se", ylim = c(0,8), font.xtickslab = 4, sort.val = c("asc"), title = "All stims") + rotate_x_text() + theme(legend.position = "none")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
filter(grepl('_L_', image)) %>%
ggbarplot(x = "image", y = "cycles", ylab = "Mean Number of Cycles", fill = "#f7a800", add = "mean_se", font.xtickslab = 4, sort.val = c("asc"), title = "Change on Left", ylim = c(0,8)) + rotate_x_text() + theme(legend.position = "none")

tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
filter(grepl('_R_', image)) %>%
ggbarplot(x = "image", y = "cycles", ylab = "Mean Number of Cycles", fill = "#f7a800", add = "mean_se", font.xtickslab = 4, sort.val = c("asc"), title = "Change on Right", ylim = c(0,8)) + rotate_x_text() + theme(legend.position = "none")

This table contains the final count for each image. This is after RTs were excluded that were more than 3 SDs from the mean.
image_count_final <- data.frame(image_count = colSums(tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed_counts[,2:49], na.rm = TRUE))
knitr::kable(image_count_final)
| 001_L_mirror |
12 |
| 001_R_mirror |
21 |
| 002_L_napkin |
17 |
| 002_R_napkin |
19 |
| 003_L_ducks |
11 |
| 003_R_ducks |
13 |
| 004_L_electricalgrid |
13 |
| 004_R_electricalgrid |
22 |
| 005_L_mirror |
13 |
| 005_R_mirror |
20 |
| 006_L_vase |
18 |
| 006_R_vase |
20 |
| 007_L_soap |
15 |
| 007_R_soap |
22 |
| 008_L_bottle |
17 |
| 008_R_bottle |
23 |
| 009_L_carpet |
15 |
| 009_R_carpet |
20 |
| 010_L_candle |
6 |
| 010_R_candle |
8 |
| 011_L_parfum |
17 |
| 011_R_parfum |
16 |
| 012_L_tubaccesory |
9 |
| 012_R_tubaccesory |
17 |
| 013_L_lamp |
10 |
| 013_R_lamp |
20 |
| 014_L_lamp |
16 |
| 014_R_lamp |
21 |
| 015_L_ceilinglight |
10 |
| 015_R_ceilinglight |
9 |
| 016_L_art |
14 |
| 016_R_art |
25 |
| 017_L_wood |
9 |
| 017_R_wood |
9 |
| 018_L_plant |
17 |
| 018_R_plant |
25 |
| 019_L_lamp_sized |
12 |
| 019_R_lamp_sized |
20 |
| 020_L_walldeco |
18 |
| 020_R_walldeco |
21 |
| 021_L_keyboard |
17 |
| 021_R_keyboard |
20 |
| 022_L_lamp |
13 |
| 022_R_lamp |
21 |
| 023_L_remote |
13 |
| 023_R_remote |
22 |
| 024_L_towels |
17 |
| 024_R_towels |
17 |
Splash vs. Flicker
This final section compares the RT data from the images with the mudsplashes and the images without mudsplashes.
wolfe_mudsplash <- tbl_good_catch_acc_all_main_acc_inacc_trials_removed_timeout_trials_removed_rts_3SD_trimmed_rts_3SD_removed %>%
group_by(image) %>%
dplyr::summarize(mean_cycles = mean(cycles, na.rm=TRUE)) %>%
separate(image,into=c('stim'), sep=5)
wolfe_flicker <- read_csv("./change_blindness_wolfe_behav.csv")
## Warning: Missing column names filled in: 'X1' [1]
wolfe_flicker <-cbind.data.frame(wolfe_flicker[2], wolfe_flicker[13])
wolfe_cycles <- merge(wolfe_mudsplash, wolfe_flicker, by.x='stim')
colnames(wolfe_cycles) <- c("image", "splash", "flicker")
wolfe_cycles_long <- gather(wolfe_RTs, condition, cycles, splash:flicker, factor_key=TRUE)
wolfe_cycles_long %>%
group_by(condition) %>%
get_summary_stats(cycles, type = "mean_se")
## # A tibble: 2 x 5
## condition variable n mean se
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 splash cycles 253 0.971 0.005
## 2 flicker cycles 253 1.05 0.017
wolfe_cycles_long %>%
with(t.test(cycles~condition,paired=TRUE))
##
## Paired t-test
##
## data: cycles by condition
## t = -4.9257, df = 252, p-value = 1.523e-06
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.11098154 -0.04758295
## sample estimates:
## mean of the differences
## -0.07928225
wolfe_cycles_long %>%
ggbarplot("image", "cycles", fill = "condition", color = "condition", palette = "jco", position = position_dodge(0.9), font.xtickslab = 4, ylab = "Mean Number of Cycles", title = "All stims", ylim = c(0,50)) + rotate_x_text()

wolfe_cycles %>%
ggpaired(cond1 = "splash", cond2 = "flicker", fill = "condition", palette = "jco", ylab = "Mean Number of Cycles", title = "All stims", ylim = c(0,50))

wolfe_cycles %>%
ggscatter(x = "splash", y = "flicker", xlab = "Mean Splash Number of Cycles", ylab = "Mean Flicker Number of Cycles", fill = "#f7a800", color = "#f7a800", add = "reg.line", cor.coef = TRUE, cor.coeff.args = list(method = "pearson", label.x = 10, label.sep = "\n"), ylim = c(0, 50), xlim = c(0, 50), title = "All stims")

wolfe_cycles_long %>%
group_by(condition) %>%
filter(grepl('_L', image)) %>%
get_summary_stats(cycles, type = "mean_se")
## # A tibble: 2 x 5
## condition variable n mean se
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 splash cycles 126 0.972 0.007
## 2 flicker cycles 126 1.06 0.023
wolfe_cycles_long %>%
filter(grepl('_L', image)) %>%
with(t.test(cycles~condition,paired=TRUE))
##
## Paired t-test
##
## data: cycles by condition
## t = -3.9421, df = 125, p-value = 0.0001337
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.12958934 -0.04296094
## sample estimates:
## mean of the differences
## -0.08627514
wolfe_cycles_long %>%
filter(grepl('_L', image)) %>%
ggbarplot("image", "cycles", fill = "condition", color = "condition", palette = "jco", position = position_dodge(0.9), font.xtickslab = 4, ylab = "Mean Number of Cycles", title = "Change on Left", ylim = c(0,50)) + rotate_x_text()

wolfe_cycles %>%
filter(grepl('_L', image)) %>%
ggpaired(cond1 = "splash", cond2 = "flicker", fill = "condition", palette = "jco", ylab = "Mean Number of Cycles", title = "Change on Left", ylim = c(0,50))

wolfe_cycles %>%
filter(grepl('_L', image)) %>%
ggscatter(x = "splash", y = "flicker", xlab = "Mean Splash Number of Cycles", ylab = "Mean Flicker Number of Cycles", fill = "#f7a800", color = "#f7a800", add = "reg.line", cor.coef = TRUE, cor.coeff.args = list(method = "pearson", label.x = 10, label.sep = "\n"), ylim = c(0, 50), xlim = c(0, 50), title = "Change on Left")

wolfe_cycles_long %>%
group_by(condition) %>%
filter(grepl('_R', image)) %>%
get_summary_stats(cycles, type = "mean_se")
## # A tibble: 2 x 5
## condition variable n mean se
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 splash cycles 127 0.97 0.006
## 2 flicker cycles 127 1.04 0.026
wolfe_cycles_long %>%
filter(grepl('_R', image)) %>%
with(t.test(cycles~condition,paired=TRUE))
##
## Paired t-test
##
## data: cycles by condition
## t = -3.0571, df = 126, p-value = 0.00273
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.11917581 -0.02551302
## sample estimates:
## mean of the differences
## -0.07234442
wolfe_cycles_long %>%
filter(grepl('_R', image)) %>%
ggbarplot("image", "cycles", fill = "condition", color = "condition", palette = "jco", position = position_dodge(0.9), font.xtickslab = 4, ylab = "Mean Number of Cycles", title = "Change on Right", ylim = c(0,50)) + rotate_x_text()

wolfe_cycles %>%
filter(grepl('_R', image)) %>%
ggpaired(cond1 = "splash", cond2 = "flicker", fill = "condition", palette = "jco", ylab = "Mean Number of Cycles", title = "Change on Right", ylim = c(0,50))

wolfe_cycles %>%
filter(grepl('_R', image)) %>%
ggscatter(x = "splash", y = "flicker", xlab = "Mean Splash Number of Cycles", ylab = "Mean Flicker Number of Cycles", fill = "#f7a800", color = "#f7a800", add = "reg.line", cor.coef = TRUE, cor.coeff.args = list(method = "pearson", label.x = 10, label.sep = "\n"), ylim = c(0, 50), xlim = c(0, 50), title = "Change on Right")
