Wolfe Mudsplash

1 Set up R environment

library(tidyverse)
library(ggplot2)
library(ggpubr)
library(plyr)
library(magick)
library(png)
library(EBImage)
library(lme4)
library(lmerTest)

Set the R working drectory to the main experiment directory.

setwd("/Users/adambarnas/Box/Mudsplash/Results")  

2 Format & manipulate raw data files

2.1 Read-in datafiles

First, read in the individual subject files (saved automatically on the server as csv files).

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

Get a count of the number of subjects.

nrow(tbl_all %>% distinct(workerId,.keep_all = FALSE))

## [1] 228

Next, rename the catch trials to the same convention as the main trials and break apart the unmod_image column into database (the lab where the stims come from) and image (the name of the image file).

tbl_all$unmod_image[tbl_all$unmod_image == "catchAirplane-a"] <- "wolfe_catchAirplane-a"
tbl_all$unmod_image[tbl_all$unmod_image == "catchBoat-a"] <- "wolfe_catchBoat-a"
tbl_all$unmod_image[tbl_all$unmod_image == "catchCow-a"] <- "wolfe_catchCow-a"
tbl_all$unmod_image <- lapply(tbl_all$unmod_image, gsub, pattern='-a', replacement='')
tbl_all <- tbl_all %>%
separate(unmod_image,into=c('database', 'image'), sep = "([\\_])", extra = "merge")
#head(tbl_all,10)

Let’s, for now, also assign the trials to bins based on the trial number. The 2 practice trials at the beginning and the 1 catch trial at the end will be labeled “filler”.

tbl_all$bin = "block_0"
tbl_all[which(tbl_all$trial_number %in% c(3:8)), "bin"] = "block_1"
tbl_all[which(tbl_all$trial_number %in% c(9:14)), "bin"] = "block_2"
tbl_all[which(tbl_all$trial_number %in% c(15:20)), "bin"] = "block_3"
tbl_all[which(tbl_all$trial_number %in% c(21:26)), "bin"] = "block_4"
tbl_all[which(tbl_all$trial_number %in% c(27:32)), "bin"] = "block_5"

Get the total number of trials for each subject and the initial count for each image.

tbl_all_counts <- tbl_all %>%
  group_by(workerId,image) %>%
  filter(image!= "catchAirplane" & image!= "catchBoat" & image!= "catchCow") %>%
  dplyr::summarize(counts = n()) %>%
  spread(image,counts) %>%
  mutate(sum = rowSums(.[-1], na.rm = TRUE))
#head(tbl_all_counts,10)

image_count_initial <- data.frame(image_count = colSums(tbl_all_counts[,2:255], na.rm = TRUE))
knitr::kable(image_count_initial)

	image_count
001_L_mirror	24
001_R_mirror	30
002_L_napkin	24
002_R_napkin	29
003_L_ducks	22
003_R_ducks	32
004_L_electricalgrid	25
004_R_electricalgrid	29
005_L_mirror	23
005_R_mirror	31
006_L_vase	23
006_R_vase	30
007_L_soap	25
007_R_soap	32
008_L_bottle	23
008_R_bottle	30
009_L_carpet	25
009_R_carpet	27
010_L_candle	25
010_R_candle	30
011_L_parfum	26
011_R_parfum	27
012_L_tubaccesory	25
012_R_tubaccesory	30
013_L_lamp	25
013_R_lamp	29
014_L_lamp	23
014_R_lamp	29
015_L_ceilinglight	24
015_R_ceilinglight	29
016_L_art	23
016_R_art	31
017_L_wood	27
017_R_wood	31
018_L_plant	24
018_R_plant	29
019_L_lamp_sized	24
019_R_lamp_sized	31
020_L_walldeco	25
020_R_walldeco	29
021_L_keyboard	25
021_R_keyboard	31
022_L_lamp	23
022_R_lamp	32
023_L_remote	26
023_R_remote	31
024_L_towels	23
024_R_towels	29
025_L_vase	23
025_R_vase	29
026_L_rack	26
026_R_rack	29
027_L_soapdish	25
027_R_soapdish	30
028_L_vase	24
028_R_vase	30
029_L_glass	23
029_R_glass	31
030_L_drawer	24
030_R_drawer	29
031_L_log	25
031_R_log	30
032_L_bottle	25
032_R_bottle	27
033_L_vase	25
033_R_vase	31
034_L_handle	24
034_R_handle	30
035_L_fruit	25
035_R_fruit	29
036_L_bowl	24
036_R_bowl	30
037_L_towel	25
037_R_towel	30
038_L_art	24
038_R_art	29
039_L_ventilator	24
039_R_ventilator	33
040_L_painting	22
040_R_painting	29
041_L_fruit	25
041_R_fruit	28
042_L_tap	25
042_R_tap	29
043_L_clock	26
043_R_clock	29
044_L_light	24
044_R_light	31
045_L_musicdock	24
045_R_musicdock	31
046_L_remote	24
046_R_remote	31
047_L_handle	26
047_R_handle	29
048_L_art	25
048_R_art	31
049_L_painting	25
049_R_painting	32
050_L_book	24
050_R_book	31
051_L_owl	23
051_R_owl	29
052_L_speaker	25
052_R_speaker	29
053_L_handle	24
053_R_handle	28
054_L_firewood	24
054_R_firewood	29
055_L_carpet	24
055_R_carpet	31
056_L_comforter	26
056_R_comforter	27
057_L_bin	24
057_R_bin	29
058_L_clutch	23
058_R_clutch	31
059_L_car	23
059_R_car	28
060_L_pillow	23
060_R_pillow	28
061_L_glass	23
061_R_glass	28
062_L_flowers	25
062_R_flowers	28
063_L_laptop	26
063_R_laptop	28
064_L_bottles	25
064_R_bottles	28
065_L_cd	22
065_R_cd	31
066_L_vase	26
066_R_vase	27
067_L_painting	27
067_R_painting	32
068_L_faucet	23
068_R_faucet	31
069_L_things	24
069_R_things	28
070_L_lamp	24
070_R_lamp	28
071_L_art	24
071_R_art	31
072_L_handle	23
072_R_handle	32
073_L_coffeemug	24
073_R_coffeemug	31
074_L_book	24
074_R_book	30
075_L_light	26
075_R_light	27
076_L_hook	23
076_R_hook	29
077_L_footrest	24
077_R_footrest	31
078_L_faucet	24
078_R_faucet	29
079_L_bowl	24
079_R_bowl	32
080_L_plant	24
080_R_plant	32
081_L_football	26
081_R_football	28
082_L_bowl	25
082_R_bowl	30
083_L_knob	26
083_R_knob	29
084_L_light	25
084_R_light	29
085_L_switchboard	25
085_R_switchboard	29
086_L_book	23
086_R_book	28
087_L_towelhandle	24
087_R_towelhandle	31
088_L_clock	24
088_R_clock	29
089_L_poster	25
089_R_poster	29
090_L_lamp	23
090_R_lamp	30
091_L_airfreshener	25
091_R_airfreshener	29
092_L_candles	24
092_R_candles	27
093_L_switch	23
093_R_switch	29
095_L_candle	23
095_R_candle	29
096_L_painting	27
096_R_painting	33
097_L_light	24
097_R_light	29
098_L_slippers	25
098_R_slippers	28
099_L_sconce	25
099_R_sconce	32
100_L_mirror	25
100_R_mirror	27
101_L_cup	27
101_R_cup	30
102_L_shoppingbag	23
102_R_shoppingbag	33
103_L_hook	26
103_R_hook	34
104_L_bottle	23
104_R_bottle	29
105_L_hat	25
105_R_hat	28
106_L_toweldispenser	24
106_R_toweldispenser	28
107_L_shirts	24
107_R_shirts	30
108_L_boa	25
108_R_boa	29
109_L_pillow	24
109_R_pillow	30
110_L_plant	24
110_R_plant	32
111_L_pot	25
111_R_pot	29
112_L_basket	23
112_R_basket	30
113_L_plant	23
113_R_plant	30
114_L_bird	26
114_R_bird	31
115_L_pot	25
115_R_pot	28
116_L_basket	23
116_R_basket	28
117_L_plant_sized	24
117_R_plant_sized	29
118_L_shoes	26
118_R_shoes	29
119_L_painting	26
119_R_painting	28
120_L_art	26
120_R_art	29
121_L_car	24
121_R_car	30
122_L_chair	23
122_R_chair	28
123_L_pot	24
123_R_pot	29
124_L_vase	24
124_R_vase	30
125_L_sofa	24
125_R_sofa	28
126_L_candles	23
126_R_candles	29
127_L_light	25
127_R_light	29
128_L_pot	24
128_R_pot	30

2.2 Compute number of cycles

One cycle (A-BS-B-AS) lasted 4200 ms (2000-100-2000-100).

tbl_all$cycles <- tbl_all$rt / 4200

The data are loaded. Let’s move on and examine the quality of the data.

2.3 Analyze accuracy

In this chunk, every click for a given image is compared to the image difference hull. The process involves the addition of two arrays - the difference hull array and an array created by the script and the subject’s click. The difference hull array is composed of 0s and 1s, with 1s corresponding to the changing object. An equally sized array of all 0s is composed, with one 1 corresponding to the X,Y coordinates of the click. These two arrays are added together and the maximum value is queried. A maximum value of 2 indicates that the click occurred within the boundaries of the image difference hall (an accurate click). A values less than 2 indicates that the click occurred outside the boundaries of the image difference hall (an inaccurate click). In the new click_ACC column, 1s correspond to accurate clicks and 0s correspond to inaccurate clicks. This will analyze the accuracy for the 2 practice images, all main images, and the 1 catch image.

img_train <- list.files(path = "/Users/adambarnas/Box/Mudsplash/Boxes_Wolfe2/", pattern = ".png", all.files = TRUE,full.names = TRUE,no.. = TRUE)
img_array <- readPNG(img_train)
img_list <- lapply(img_train, readPNG)
img_names <- row.names(image_count_initial)
img_names <- c("catchAirplane", "catchBoat", "catchCow", img_names)
names(img_list) = img_names

tbl_all$x[tbl_all$x == "0"] <- 1
tbl_all$y[tbl_all$y == "0"] <- 1

tbl_all$click_ACC= "filler"

for (i in 1:length(tbl_all$workerId)){
  img <- data.frame(img_list[tbl_all$image[i]])
  blank <- data.frame(array(c(0,0), dim = c(nrow(img),ncol(img))))
  blank[tbl_all$y[i], tbl_all$x[i]] <- 1
  combo <- img + blank
  which(combo==2, arr.ind=TRUE)
  if (max(combo, na.rm=TRUE) == 2){
    tbl_all$click_ACC[i] = 1
  } else {
    tbl_all$click_ACC[i] = 0
  }
} 

2.3.1 Catch trials

Check the accuracy of the catch trial. As a reminder, the catch trial was a large, salient changing object. If a subject did not click on the changing object during the catch trial, their performance on the main trials is likely poor and will be excluded. This chunk will filter the data by accuracy for both inaccurate (bad) catch trials and accurate (good) catch trials and save new dataframes. This chunk will also provide the number and workerIds for inaccurate and accurate catch trial performance.

tbl_all_catch_acc <- tbl_all %>%
  filter(image == "catchCow")
tbl_bad_catch_acc <- tbl_all_catch_acc %>%
  filter(click_ACC == 0)
tbl_good_catch_acc <- tbl_all_catch_acc %>%
  filter(click_ACC == 1)

tbl_bad_catch_acc <- tbl_all[(tbl_all$workerId %in% tbl_bad_catch_acc$workerId),]
nrow(tbl_bad_catch_acc %>% distinct(workerId,.keep_all = FALSE))

## [1] 9

tbl_good_catch_acc <- tbl_all[(tbl_all$workerId %in% tbl_good_catch_acc$workerId),]
nrow(tbl_good_catch_acc %>% distinct(workerId,.keep_all = FALSE))

## [1] 219

2.3.2 Main trials

Now, check the accuracy of the clicks for the main images. This chunk will compute the total number of inaccurate and accurate clicks for each subject.

tbl_good_catch_acc_all_main_acc <- tbl_good_catch_acc %>%
  filter(image!= "catchAirplane" & image!= "catchBoat" & image!= "catchCow")
tbl_good_catch_acc_all_main_acc_counts <- tbl_good_catch_acc_all_main_acc %>%
  group_by(workerId,click_ACC) %>%
  dplyr::summarize(counts = n()) %>%
  spread(click_ACC,counts) %>%
  mutate(total = rowSums(.[2:3], na.rm = TRUE))
colnames(tbl_good_catch_acc_all_main_acc_counts) <- c("workerId", "inacc", "acc", "total")

Here, we can plot the overall accuracy of the main trial clicks for the group.

tbl_good_catch_acc_all_main_acc_rate <- (tbl_good_catch_acc_all_main_acc_counts$acc / tbl_good_catch_acc_all_main_acc_counts$total)
tbl_good_catch_acc_all_main_acc_rate <- cbind.data.frame(tbl_good_catch_acc_all_main_acc_counts[,1], tbl_good_catch_acc_all_main_acc_rate)
colnames(tbl_good_catch_acc_all_main_acc_rate) <- c("workerId", "acc_rate")
tbl_good_catch_acc_all_main_acc_rate[is.na(tbl_good_catch_acc_all_main_acc_rate)] <- 0

tbl_good_catch_acc_all_main_acc_rate %>% 
  ggbarplot(y = "acc_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 = -1.6, title = "Main Trial Accuracy for All Subjects")

tbl_good_catch_acc_all_main_acc_rate %>% 
  ggbarplot(x = "workerId", y = "acc_rate", ylab = "Accuracy", fill = "#f7a800", color = "#f7a800", ylim = c(0, 1), title = "Main Trial Accuracy for Individual Subjects", font.xtickslab = 2, sort.val = c("asc")) + rotate_x_text()

Count the number of subjects and only remove inaccurate trials.

nrow(tbl_good_catch_acc_all_main_acc %>% distinct(workerId,.keep_all = FALSE))

## [1] 219

tbl_good_catch_acc_all_main_acc_inacc_trials_removed <- tbl_good_catch_acc_all_main_acc %>% 
  filter(click_ACC == 1)

3 Raw RTs

3.1 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,50), 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,30), 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 = 2, sort.val = c("asc")) + rotate_x_text()

3.2 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

3.3 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 = 2, 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)

	image_count
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

3.4 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 = 2,  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")

raw_RT_all_lmer = lmer(RT ~ condition + (1 | image), data = wolfe_RTs_long)
summary(raw_RT_all_lmer)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: RT ~ condition + (1 | image)
##    Data: wolfe_RTs_long
## 
## REML criterion at convergence: 3249.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.8021 -0.4373 -0.0733  0.2345  4.8596 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  image    (Intercept)  6.068   2.463   
##  Residual             30.603   5.532   
## Number of obs: 506, groups:  image, 253
## 
## Fixed effects:
##                  Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)       10.2194     0.3807 490.5684  26.843  < 2e-16 ***
## conditionflicker   3.3212     0.4919 252.0000   6.752 9.97e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## condtnflckr -0.646

wolfe_RTs_left_long <- wolfe_RTs_long %>%
  group_by(condition) %>%
  filter(grepl('_L', image))

wolfe_RTs_left_long %>% 
  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_left_long %>%
  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_left_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_left <- wolfe_RTs %>%
  filter(grepl('_L', image))

wolfe_RTs_left %>% 
  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_left %>%
  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")

raw_RT_left_lmer = lmer(RT ~ condition + (1 | image), data = wolfe_RTs_left_long)
summary(raw_RT_left_lmer)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: RT ~ condition + (1 | image)
##    Data: wolfe_RTs_left_long
## 
## REML criterion at convergence: 1594.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.7819 -0.4808 -0.0673  0.3101  4.0513 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  image    (Intercept)  7.561   2.75    
##  Residual             26.420   5.14    
## Number of obs: 252, groups:  image, 126
## 
## Fixed effects:
##                  Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)       10.3398     0.5193 238.2070  19.911  < 2e-16 ***
## conditionflicker   3.2269     0.6476 125.0000   4.983 2.04e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## condtnflckr -0.623

wolfe_RTs_right_long <- wolfe_RTs_long %>%
  group_by(condition) %>%
  filter(grepl('_R', image))

wolfe_RTs_right_long %>% 
  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_right_long %>%
  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_right_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 = "Change on Right", ylim = c(0,50)) + rotate_x_text()

wolfe_RTs_right <- wolfe_RTs %>%
  filter(grepl('_R', image))

wolfe_RTs_right %>% 
  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_right %>%
  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")

raw_RT_right_lmer = lmer(RT ~ condition + (1 | image), data = wolfe_RTs_right_long)
summary(raw_RT_right_lmer)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: RT ~ condition + (1 | image)
##    Data: wolfe_RTs_right_long
## 
## REML criterion at convergence: 1650.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.7577 -0.4027 -0.0816  0.2064  4.7464 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  image    (Intercept)  4.629   2.151   
##  Residual             34.987   5.915   
## Number of obs: 254, groups:  image, 127
## 
## Fixed effects:
##                  Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)       10.0999     0.5585 248.6062   18.08  < 2e-16 ***
## conditionflicker   3.4148     0.7423 126.0000    4.60 1.01e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## condtnflckr -0.665

4 Log RTs

4.1 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 = 2, sort.val = c("asc")) + rotate_x_text()

4.2 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

4.3 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 = 2, 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)

	image_count
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

4.4 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 = 2,  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")

raw_RT_all_lmer = lmer(RT ~ condition + (1 | image), data = wolfe_RTs_long)
summary(raw_RT_all_lmer)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: RT ~ condition + (1 | image)
##    Data: wolfe_RTs_long
## 
## REML criterion at convergence: -184.1
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7412 -0.3559  0.0035  0.4031  2.7727 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  image    (Intercept) 0.007719 0.08786 
##  Residual             0.032773 0.18103 
## Number of obs: 506, groups:  image, 253
## 
## Fixed effects:
##                   Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)        0.97116    0.01265 486.32760  76.767  < 2e-16 ***
## conditionflicker   0.07928    0.01610 252.00000   4.926 1.52e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## condtnflckr -0.636

wolfe_RTs_left_long <- wolfe_RTs_long %>%
  group_by(condition) %>%
  filter(grepl('_L', image))

wolfe_RTs_left_long %>% 
  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_left_long %>% 
  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_left_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 = "Change on Left", ylim = c(0,2)) + rotate_x_text()

wolfe_RTs_left <- wolfe_RTs %>%
  filter(grepl('_L', image))

wolfe_RTs_left %>% 
  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_left %>% 
  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")

raw_RT_left_lmer = lmer(RT ~ condition + (1 | image), data = wolfe_RTs_left_long)
summary(raw_RT_left_lmer)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: RT ~ condition + (1 | image)
##    Data: wolfe_RTs_left_long
## 
## REML criterion at convergence: -105.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7618 -0.4171 -0.0001  0.4706  2.4335 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  image    (Intercept) 0.007446 0.08629 
##  Residual             0.030176 0.17371 
## Number of obs: 252, groups:  image, 126
## 
## Fixed effects:
##                   Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)        0.97217    0.01728 240.57566  56.261  < 2e-16 ***
## conditionflicker   0.08628    0.02189 125.00000   3.942 0.000134 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## condtnflckr -0.633

wolfe_RTs_right_long <- wolfe_RTs_long %>%
  group_by(condition) %>%
  filter(grepl('_R', image))

wolfe_RTs_right_long %>% 
  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_right_long %>% 
  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_right_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 = "Change on Right", ylim = c(0,2)) + rotate_x_text()

wolfe_RTs_right <- wolfe_RTs %>%
  filter(grepl('_R', image)) 

wolfe_RTs_right %>% 
  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_right %>% 
  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")

raw_RT_right_lmer = lmer(RT ~ condition + (1 | image), data = wolfe_RTs_right_long)
summary(raw_RT_right_lmer)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: RT ~ condition + (1 | image)
##    Data: wolfe_RTs_right_long
## 
## REML criterion at convergence: -69
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.5792 -0.2956  0.0076  0.3494  2.7113 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  image    (Intercept) 0.008034 0.08963 
##  Residual             0.035561 0.18858 
## Number of obs: 254, groups:  image, 127
## 
## Fixed effects:
##                   Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)        0.97017    0.01853 243.72208  52.364  < 2e-16 ***
## conditionflicker   0.07234    0.02366 126.00000   3.057  0.00273 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## condtnflckr -0.639

5 Cycles

5.1 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,15), 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,8), 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 = 2, sort.val = c("asc")) + rotate_x_text()

5.2 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

5.3 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 = 2, 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)

	image_count
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

5.4 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_cycles, 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  2.43 0.033
## 2 flicker   cycles     253 14.1  0.543

wolfe_cycles_long %>% 
  with(t.test(cycles~condition,paired=TRUE))

## 
##  Paired t-test
## 
## data:  cycles by condition
## t = -21.922, df = 252, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -12.72017 -10.62305
## sample estimates:
## mean of the differences 
##               -11.67161

wolfe_cycles_long %>% 
  ggbarplot("image", "cycles", fill = "condition", color = "condition", palette = "jco", position = position_dodge(0.9), font.xtickslab = 2,  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")

cycles_all_lmer = lmer(cycles ~ condition + (1 | image), data = wolfe_cycles_long)
summary(cycles_all_lmer)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: cycles ~ condition + (1 | image)
##    Data: wolfe_cycles_long
## 
## REML criterion at convergence: 3265.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.9805 -0.3241 -0.0217  0.0844  5.2453 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  image    (Intercept)  1.505   1.227   
##  Residual             35.859   5.988   
## Number of obs: 506, groups:  image, 253
## 
## Fixed effects:
##                  Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)        2.4332     0.3843 503.1837   6.332 5.38e-10 ***
## conditionflicker  11.6716     0.5324 252.0001  21.922  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## condtnflckr -0.693

wolfe_cycles_left_long <- wolfe_cycles_long %>%
  group_by(condition) %>%
  filter(grepl('_L', image))

wolfe_cycles_left_long %>% 
  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  2.46 0.052
## 2 flicker   cycles     126 14.1  0.73

wolfe_cycles_left_long %>% 
  with(t.test(cycles~condition,paired=TRUE))

## 
##  Paired t-test
## 
## data:  cycles by condition
## t = -16.408, df = 125, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -13.07783 -10.26247
## sample estimates:
## mean of the differences 
##               -11.67015

wolfe_cycles_left_long %>% 
  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_left <- wolfe_cycles %>%
  filter(grepl('_L', image))

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

wolfe_cycles_left %>%
  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")

cycles_left_lmer = lmer(cycles ~ condition + (1 | image), data = wolfe_cycles_left_long)
summary(cycles_left_lmer)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: cycles ~ condition + (1 | image)
##    Data: wolfe_cycles_left_long
## 
## REML criterion at convergence: 1598.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.0504 -0.2570 -0.0166  0.1225  4.7867 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  image    (Intercept)  1.875   1.369   
##  Residual             31.872   5.645   
## Number of obs: 252, groups:  image, 126
## 
## Fixed effects:
##                  Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)        2.4619     0.5175 249.2305   4.757 3.33e-06 ***
## conditionflicker  11.6701     0.7113 125.0000  16.408  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## condtnflckr -0.687

wolfe_cycles_right_long <- wolfe_cycles_long %>%
  group_by(condition) %>%
  filter(grepl('_R', image)) 

wolfe_cycles_right_long %>% 
  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  2.40 0.039
## 2 flicker   cycles     127 14.1  0.805

wolfe_cycles_right_long %>% 
  with(t.test(cycles~condition,paired=TRUE))

## 
##  Paired t-test
## 
## data:  cycles by condition
## t = -14.689, df = 126, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -13.24567 -10.10044
## sample estimates:
## mean of the differences 
##               -11.67305

wolfe_cycles_right_long %>% 
  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_right <- wolfe_cycles %>%
  filter(grepl('_R', image)) 

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

wolfe_cycles_right %>%
  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")

cycles_right_lmer = lmer(cycles ~ condition + (1 | image), data = wolfe_cycles_right_long)
summary(cycles_right_lmer)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: cycles ~ condition + (1 | image)
##    Data: wolfe_cycles_right_long
## 
## REML criterion at convergence: 1662.1
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.8928 -0.3423 -0.0204  0.0617  5.0244 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  image    (Intercept)  1.148   1.071   
##  Residual             40.099   6.332   
## Number of obs: 254, groups:  image, 127
## 
## Fixed effects:
##                  Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)        2.4047     0.5699 251.8050    4.22 3.42e-05 ***
## conditionflicker  11.6731     0.7947 126.0000   14.69  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## condtnflckr -0.697