SOL-analysis
Kyle MacDonald
June 9, 2015
Data processing, plotting, and analysis script for SOL PEEK data
rm(list=ls())
knitr::opts_chunk$set(warning=FALSE, message=FALSE, sanitize = T,
fig.height=8, fig.width=8)## [1] "loading library"Demographics
sol_demo <- read.csv("../../raw_data/sol_demo_all.csv", stringsAsFactors = F)
sol_demo$Sub.Num <- as.character(sol_demo$Sub.Num)Eye movement data
iChart <- read.csv("data-processing/sol-ichart-merged-post-gating.csv",
check.names=F, stringsAsFactors=F)
iChart$Sub.Num <- as.character(iChart$Sub.Num)Stimuli information
sol_target_signs_df <- read.csv("target_sign_lengths.csv")Filter dataset
Filter out participants that should not go into analyses based on exclusionary criteria: a) age, b) didn’t know signs in the task, c) not enough ASL exposure.
exclude <- sol_demo %>%
filter(include == "no", age_code != "adult") %>%
select(Sub.Num, reason_excluded)
include <- sol_demo %>%
filter(include == "yes") %>%
select(Sub.Num, include,
reason_excluded, stimuli,
age_code, signs_produced,
hearing_status_participant)
iChart <- left_join(iChart, include, by = c("Sub.Num", "stimuli"))
iChart <- filter(iChart, include == "yes")Filter unknown signs
Create a clean target image variable.
targets <- c("juice", "cookie", "cup", "ball", "shoe", "kitty",
"doll", "teddy", "book", "birdy", "car", "sock")
make_clean_target <- function (target_image, targets) {
target_img_clean <- targets[str_detect(target_image, targets)]
return(target_img_clean)
}
iChart$clean_target_img <- unlist(sapply(iChart$Target.Image,
function (x) make_clean_target(x, targets)))Add unknown signs variable. Taken from sol_demo data frame.
ss_unknown_signs <- sol_demo %>%
filter(include == "yes") %>%
select(Sub.Num, parent_report_unknown_signs)
iChart <- left_join(iChart, ss_unknown_signs, by = "Sub.Num")Now we can filter the iChart, removing the “unknown” signs.
ss_trials_df <- iChart %>%
group_by(Sub.Num, parent_report_unknown_signs) %>%
summarise(Trials = n())
# flag unknown trials
ss_unknown <- iChart %>%
rowwise() %>%
mutate(unknown_trial = ifelse(clean_target_img %in% parent_report_unknown_signs,
"unknown_sign", "known_sign")) %>%
select(Sub.Num, Tr.Num, unknown_trial)
# join this info with the original iChart
iChart$unknown_trial <- ss_unknown$unknown_trial
# now filter
iChart <- filter(iChart, unknown_trial == "known_sign")
# check to make sure our filtering worked correctly
post_filter_n <- iChart %>%
group_by(Sub.Num) %>%
summarise(Trials = n()) %>%
select(Trials)
ss_trials_df$post_filter <- post_filter_n$Trials
ss_trials_df <- ss_trials_df %>%
mutate(trials_removed = as.integer(Trials) - as.integer(post_filter))Get total number of trials removed because of known signs
sum(ss_trials_df$trials_removed)## [1] 22Remove prescreened out trials
ss_prescreened <- iChart %>%
group_by(Sub.Num) %>%
filter(Prescreen.Notes != "") %>%
summarise(num_prescreened = n())
ss_trials_df <- left_join(ss_trials_df, ss_prescreened, by = "Sub.Num")
ss_trials_df <- ss_trials_df %>%
mutate(good_trials = Trials - sum(trials_removed, num_prescreened, na.rm=T))
iChart <- filter(iChart, Prescreen.Notes == "")Remove participants for having too few trials
We define too few trials as less than or equal to 25% of the total number of trials in the task.
total_trials <- 32
trials_cut_point <- total_trials * .25
trials_filter <- ss_trials_df %>%
mutate(exclude_few_trials = ifelse(good_trials <= trials_cut_point,
"exclude", "include")) %>%
select(Sub.Num, good_trials, exclude_few_trials)
# get the number of participants removed by filter
trials_filter %>% group_by(exclude_few_trials) %>% summarise(n())## Source: local data frame [2 x 2]
##
## exclude_few_trials n()
## 1 exclude 5
## 2 include 45# merge filtering information with iChart
iChart <- left_join(iChart, trials_filter, by = "Sub.Num")
# now filter
iChart <- filter(iChart, exclude_few_trials == "include")Create final exclusions table
exclude_df <- trials_filter %>%
filter(exclude_few_trials == "exclude") %>%
select(Sub.Num) %>%
mutate(reason_excluded = "too few trials") %>%
bind_rows(exclude)
#write.csv(exclude_df, "../../paper/sol_exclusions.csv", row.names = F)Get median split by age
kids_age_descriptives <- iChart %>%
filter(age_code == "child") %>%
select(Sub.Num, Months) %>%
distinct() %>%
summarise(median(Months),
max(Months),
min(Months),
sd(Months),
n()) %>%
print()## median(Months) max(Months) min(Months) sd(Months) n()
## 1 27 53 16 9.140259 29# add median split variable to iChart
iChart$age_group <- ifelse(iChart$Months < kids_age_descriptives$`median(Months)`,
"< 26.5 Months",
ifelse(iChart$Months >= kids_age_descriptives$`median(Months)` &
iChart$Months <= kids_age_descriptives$`max(Months)`,
"> 26.5 Months",
"Adults"))gender_df <- iChart %>%
filter(age_code == "child") %>%
distinct(Sub.Num) %>%
group_by(Sex, age_group) %>%
summarise(count = unique(n())) %>%
print()## Source: local data frame [4 x 3]
## Groups: Sex
##
## Sex age_group count
## 1 F < 26.5 Months 8
## 2 F > 26.5 Months 9
## 3 M < 26.5 Months 6
## 4 M > 26.5 Months 6iChart %>% group_by(age_group) %>%
summarise(n_distinct(Sub.Num),
mean(Months),
min(Months),
max(Months))## Source: local data frame [3 x 5]
##
## age_group n_distinct(Sub.Num) mean(Months) min(Months) max(Months)
## 1 < 26.5 Months 14 20.71308 16 26
## 2 > 26.5 Months 15 36.18715 27 53
## 3 Adults 16 430.57634 246 695Process iChart
First, we need to process the data, keeping only those trials on which the child was looking at the signer at F0.
- C: Center
- D: Distractor
- T: Target
- A: Away
includeOffCenter == FALSE -> only include trials child was looking at center at F0
includeOffCenter == TRUE -> include trials child was looking at center, target, or distractor at F0
iChart %>% group_by("0", Response) %>% summarise(Trials = n())## Source: local data frame [4 x 3]
## Groups: "0"
##
## "0" Response Trials
## 1 0 A 22
## 2 0 C 1019
## 3 0 D 35
## 4 0 T 43# change all trials to "Vanilla"
iChart$Condition <- "Vanilla"
## define critical onset, change Cs to Ds and everything else to As
iChart <- defineOnsetSOL(iChart, critonset=0, end_critonset=300,
includeOffCenter=FALSE, includeWindow = FALSE)
iChart %>% group_by("0", Response) %>% summarise(Trials = n())## Source: local data frame [2 x 3]
## Groups: "0"
##
## "0" Response Trials
## 1 0 A 100
## 2 0 D 1019Flag C_T and C_D Trials
Datawiz does not tell us which shifts land on a target vs. a disctractor. So we need to use a function that flags each trial as one of the following:
- C_T: center to target
- C_D: center to distractor
- C-C: center to center (child leaves the signer, goes away, and comes back to signer)
- no_shift
- off_signer
# apply it to each row in our datase
trial_types <- apply(iChart, 1, trial_type_fun)
# merge this information back with the iChart
iChart <- cbind(iChart, trial_types)iChart %>% group_by(trial_types) %>% summarise(Trials = n())## Source: local data frame [5 x 2]
##
## trial_types Trials
## 1 C_C 1
## 2 C_D 128
## 3 C_T 824
## 4 no_shift 66
## 5 off_signer 100Next, we compute statistics over long window 0-5000 ms. This will allow us to see a distribution of RTs, which we will use to determine our analysis window.
First, for adults.
iChart_adults <- filter(iChart, age_group == "Adults")
iChart_adults <- computeStatistics(iChart_adults, startWindow=0, endWindow=5000)## [1] "### Trials left ###"
## [1] 500
## [1] 450
## [1] 400
## [1] 350
## [1] 300
## [1] 250
## [1] 200
## [1] 150
## [1] 100
## [1] 50
## [1] 0# get analyisis window where 90% of RTs occur for kids, include all shifts
rts_adults <- filter(iChart_adults, trial_types %in% c("C_T"))
analysis.window_adults <- quantile(rts_adults$RT, probs=c(0.05, 0.95), na.rm=T)
qplot(rts_adults$RT) +
geom_vline(x=analysis.window_adults[1], col="red", lwd=1.5) +
geom_vline(x=analysis.window_adults[2], col="red", lwd=1.5) +
annotate("text", x = 2500, y = 30,
label = "Analysis Window \n (90% RTs)")
Now, for kids.
iChart <- filter(iChart, age_group != "Adults")
iChart <- computeStatistics(iChart, startWindow=0, endWindow=5000)## [1] "### Trials left ###"
## [1] 550
## [1] 500
## [1] 450
## [1] 400
## [1] 350
## [1] 300
## [1] 250
## [1] 200
## [1] 150
## [1] 100
## [1] 50
## [1] 0# get analyisis window where 90% of RTs occur for kids, include all shifts
rts <- filter(iChart, trial_types %in% c("C_T"), age_group != "Adults")
analysis.window <- quantile(rts$RT, probs=c(0.05, 0.95), na.rm=T)
qplot(rts$RT) +
geom_vline(x=analysis.window[1], col="red", lwd=1.5) +
geom_vline(x=analysis.window[2], col="red", lwd=1.5) +
annotate("text", x = 2500, y = 30,
label = "Analysis Window \n (90% RTs)")
Compute statistics over analysis window: 0-2600ms. We use 2600 ms because it is 500 ms longer than the end of our analysis window (2100ms). This allows us to include trials in which the participant to initiates and completes a shift at the very end of the analysis window.
iChart <- computeStatistics(iChart, startWindow=0, endWindow=2600)## [1] "### Trials left ###"
## [1] 550
## [1] 500
## [1] 450
## [1] 400
## [1] 350
## [1] 300
## [1] 250
## [1] 200
## [1] 150
## [1] 100
## [1] 50
## [1] 0iChart_adults <- computeStatistics(iChart_adults, startWindow=0, endWindow=2600)## [1] "### Trials left ###"
## [1] 500
## [1] 450
## [1] 400
## [1] 350
## [1] 300
## [1] 250
## [1] 200
## [1] 150
## [1] 100
## [1] 50
## [1] 0Reject trials with really long RTs and with long gaps. Gaps are defined as a sequence of frames when the child is not looking at either picture or at the signer.
# filter for kids
iChart <- filteriChart(iChart, minRT = analysis.window[1],
maxRT = analysis.window[2],
maxfirstgap=15, maxlonggap=15)
# filter for adults
iChart_adults <- filteriChart(iChart_adults, minRT = analysis.window_adults[1],
maxRT = analysis.window_adults[2],
maxfirstgap=15, maxlonggap=15)Get mean Accuracy and RT for each participant
acc_ss <- poolData(meanAccuracy(iChart, startWindowAcc=600, endWindowAcc=2100),
RejectFirstGap=TRUE,RejectLongestGap=TRUE,
RejectRT=FALSE, color=TRUE, dependent="Accuracy",
group="", facet="", dodge="",
xlab="", ylab= "Proportion\n Looking\n to target",
paired=TRUE, miny = 0.2, maxy = 0.80,
size=13, legend.direction="horizontal",
legend.position="bottom",
breaks=c(0.25, 0.50, 0.75))
rt_ss <- poolData(iChart,
RejectFirstGap=TRUE, RejectLongestGap=TRUE,
RejectRT=TRUE, color=FALSE, dependent="RT", group="trial_types",
facet="", dodge="Response",
xlab="", ylab="mean RT (ms)",
paired=TRUE,
miny = 400, maxy=1300,
size=13,
legend.direction = "horizontal",
legend.position="bottom",
breaks=c(400, 800, 1200))
acc_ss_adults <- poolData(meanAccuracy(iChart_adults, startWindowAcc=600, endWindowAcc=2100),
RejectFirstGap=TRUE,RejectLongestGap=TRUE,
RejectRT=FALSE, color=TRUE, dependent="Accuracy",
group="", facet="", dodge="",
xlab="", ylab= "Proportion\n Looking\n to target",
paired=TRUE, miny = 0.2, maxy = 0.80,
size=13, legend.direction="horizontal",
legend.position="bottom",
breaks=c(0.25, 0.50, 0.75))
rt_ss_adults <- poolData(iChart_adults,
RejectFirstGap=TRUE, RejectLongestGap=TRUE,
RejectRT=TRUE, color=FALSE, dependent="RT", group="trial_types",
facet="", dodge="Response",
xlab="", ylab="mean RT (ms)",
paired=TRUE,
miny = 400, maxy=1300,
size=13,
legend.direction = "horizontal",
legend.position="bottom",
breaks=c(400, 800, 1200))Get mean Acc and RT for each participant by condition
acc <- poolData(meanAccuracy(iChart, startWindowAcc=600, endWindowAcc=2100),
RejectFirstGap=TRUE,RejectLongestGap=TRUE,
RejectRT=FALSE, color=TRUE, dependent="Accuracy",
group="age_group", facet="", dodge="",
xlab="", ylab= "Proportion\n Looking\n to target",
paired=TRUE, miny = 0.2, maxy = 0.80,
size=13, legend.direction="horizontal",
legend.position="bottom",
breaks=c(0.25, 0.50, 0.75))
rt <- poolData(iChart,
RejectFirstGap=TRUE, RejectLongestGap=TRUE,
RejectRT=TRUE, color=FALSE, dependent="RT", group="age_group",
facet="", dodge="Response",
xlab="", ylab="mean RT (ms)",
paired=TRUE,
miny = 400, maxy=1300,
size=13,
legend.direction = "horizontal",
legend.position="bottom",
breaks=c(400, 800, 1200))
acc_adults <- poolData(meanAccuracy(iChart_adults, startWindowAcc=600, endWindowAcc=2100),
RejectFirstGap=TRUE,RejectLongestGap=TRUE,
RejectRT=FALSE, color=TRUE, dependent="Accuracy",
group="age_group", facet="", dodge="",
xlab="", ylab= "Proportion\n Looking\n to target",
paired=TRUE, miny = 0.2, maxy = 0.80,
size=13, legend.direction="horizontal",
legend.position="bottom",
breaks=c(0.25, 0.50, 0.75))
rt_adults <- poolData(iChart_adults,
RejectFirstGap=TRUE, RejectLongestGap=TRUE,
RejectRT=TRUE, color=FALSE, dependent="RT", group="age_group",
facet="", dodge="Response",
xlab="", ylab="mean RT (ms)",
paired=TRUE,
miny = 400, maxy=1300,
size=13,
legend.direction = "horizontal",
legend.position="bottom",
breaks=c(400, 800, 1200))Statistics
Get mean accuracy and rt for each participant
Some munging to get data frame for analysis. Variables needed for each subject:
- Mean acc
- Mean rt
- Signs produced
- Age
- Age condition
ss_acc <- bind_rows(acc_ss, acc_ss_adults)
ss_rt <- bind_rows(rt_ss, rt_ss_adults)
# merge acc/rt van1
ss <- left_join(ss_acc, ss_rt, by="Sub.Num")
# merge with demo info
ss <- left_join(ss, filter(sol_demo, include=="yes"), by="Sub.Num")
# clean up variable names in data frame
names(ss)[names(ss)=="Vanilla"] <- "mean_accuracy"
names(ss)[names(ss)=="Vanilla_C_D_D"] <- "mean_incorrect_rt"
names(ss)[names(ss)=="Vanilla_C_T_D"] <- "mean_correct_rt"First shifts
# kids
ss_first_shifts <- iChart %>%
filter(trial_types %in% c("C_T", "C_D")) %>%
group_by(Sub.Num, trial_types, age_group, Months) %>%
summarise(count = n()) %>%
spread(trial_types, count) %>%
mutate(C_D = ifelse(is.na(C_D), 0, C_D),
total_trials_shifting = C_D + C_T,
C_D_prop = round(C_D / total_trials_shifting, 2),
C_T_prop = round(C_T / total_trials_shifting, 2))
# add adults
ss_first_shifts <- iChart_adults %>%
filter(trial_types %in% c("C_T", "C_D")) %>%
group_by(Sub.Num, trial_types, age_group, Months) %>%
summarise(count = n()) %>%
spread(trial_types, count) %>%
mutate(C_D = ifelse(is.na(C_D), 0, C_D),
total_trials_shifting = C_D + C_T,
C_D_prop = round(C_D / total_trials_shifting, 2),
C_T_prop = round(C_T / total_trials_shifting, 2)) %>%
bind_rows(ss_first_shifts)
# add shifts to full data frame
ss <- ss_first_shifts %>%
dplyr::rename(Sub.Num = Sub.Num, C_D_count = C_D, C_T_count = C_T) %>%
left_join(ss, by = "Sub.Num")
# flag chance first shifters -- more than 50% posterior mass on guessing strategy
# in latent mixture model
ss <- ss %>%
mutate(C_D_prop = ifelse(C_T_prop == 1, 0, C_D_prop),
exclude_chance_shifter = ifelse(Sub.Num %in% c("30018",
"30024",
"20028",
"30051",
"30086",
"30088"),
"exclude", "include"),
age_group_collapsed = ifelse(age_group == "Adults", "Adults", "Kids"))Set up filter to just include kids for correlation analyses.
ss_kids <- filter(ss, age_group != "Adults")
ss_rt <- filter(ss, age_group != "Adults", exclude_chance_shifter == "include")write.csv(ss, "../../paper/sol_ss_all.csv", row.names = F)Correlations
Hmisc::rcorr(as.matrix(select(ss_kids, mean_accuracy, C_T_prop,
mean_correct_rt,signs_produced, Months)))## mean_accuracy C_T_prop mean_correct_rt signs_produced
## mean_accuracy 1.00 0.55 -0.54 0.46
## C_T_prop 0.55 1.00 -0.14 0.33
## mean_correct_rt -0.54 -0.14 1.00 -0.43
## signs_produced 0.46 0.33 -0.43 1.00
## Months 0.63 0.36 -0.27 0.76
## Months
## mean_accuracy 0.63
## C_T_prop 0.36
## mean_correct_rt -0.27
## signs_produced 0.76
## Months 1.00
##
## n
## mean_accuracy C_T_prop mean_correct_rt signs_produced
## mean_accuracy 29 29 29 28
## C_T_prop 29 29 29 28
## mean_correct_rt 29 29 29 28
## signs_produced 28 28 28 28
## Months 29 29 29 28
## Months
## mean_accuracy 29
## C_T_prop 29
## mean_correct_rt 29
## signs_produced 28
## Months 29
##
## P
## mean_accuracy C_T_prop mean_correct_rt signs_produced
## mean_accuracy 0.0021 0.0027 0.0139
## C_T_prop 0.0021 0.4569 0.0902
## mean_correct_rt 0.0027 0.4569 0.0227
## signs_produced 0.0139 0.0902 0.0227
## Months 0.0003 0.0563 0.1624 0.0000
## Months
## mean_accuracy 0.0003
## C_T_prop 0.0563
## mean_correct_rt 0.1624
## signs_produced 0.0000
## Monthsggpairs(data = select(ss_kids, mean_accuracy, C_T_prop, mean_correct_rt, signs_produced, Months),
upper = list(continuous = "smooth", combo = "cor",
params = c(method = "lm", color="darkblue")),
lower = list(continuous = "cor"),
diag = list(continuous = "density")) +
theme_bw() 
Just RT.
Hmisc::rcorr(as.matrix(select(ss_rt, mean_correct_rt, signs_produced, Months)))## mean_correct_rt signs_produced Months
## mean_correct_rt 1.0 -0.60 -0.40
## signs_produced -0.6 1.00 0.74
## Months -0.4 0.74 1.00
##
## n
## mean_correct_rt signs_produced Months
## mean_correct_rt 24 23 24
## signs_produced 23 23 23
## Months 24 23 24
##
## P
## mean_correct_rt signs_produced Months
## mean_correct_rt 0.0023 0.0538
## signs_produced 0.0023 0.0000
## Months 0.0538 0.0000ggpairs(data = select(ss_rt, mean_correct_rt, signs_produced, Months),
upper = list(continuous = "smooth", combo = "cor",
params = c(method = "lm", color="darkblue")),
lower = list(continuous = "cor"),
diag = list(continuous = "density")) +
theme_bw() 
T.tests
t.test(mean_correct_rt ~ age_group, alternative = "greater",
var.equal=T, data = ss_rt)##
## Two Sample t-test
##
## data: mean_correct_rt by age_group
## t = 2.0455, df = 22, p-value = 0.02647
## alternative hypothesis: true difference in means is greater than 0
## 95 percent confidence interval:
## 25.69813 Inf
## sample estimates:
## mean in group < 26.5 Months mean in group > 26.5 Months
## 1350.768 1190.691t.test(mean_accuracy ~ age_group, alternative = "less",
var.equal=T, data = ss_kids)##
## Two Sample t-test
##
## data: mean_accuracy by age_group
## t = -2.9596, df = 27, p-value = 0.003171
## alternative hypothesis: true difference in means is less than 0
## 95 percent confidence interval:
## -Inf -0.029803
## sample estimates:
## mean in group < 26.5 Months mean in group > 26.5 Months
## 0.5931446 0.6633542t.test(mean_correct_rt ~ age_group_collapsed, alternative = "less",
var.equal = T, data = ss)##
## Two Sample t-test
##
## data: mean_correct_rt by age_group_collapsed
## t = -9.1696, df = 43, p-value = 0.000000000005602
## alternative hypothesis: true difference in means is less than 0
## 95 percent confidence interval:
## -Inf -446.3837
## sample estimates:
## mean in group Adults mean in group Kids
## 698.6211 1245.2121Get confidence intervals for graph values
# keeping age bins
createPlots(iChart, startWindow=0, endWindow=2100, RejectLongestGap=FALSE,
RejectFirstGap=FALSE, RejectRT=FALSE, color=TRUE, smooth=400,
targetEnd=800, carrier="", targets=c(""),
group="age_group", plotStats="PP", miny = 0.4, maxy=0.95, size=15,
legend.direction = "vertical", legend.position=c(0.85, 0.9),
breaks=c(0.25, 0.50, 0.75), x.target=0.33)
# keeping age bins
createPlots(iChart_adults, startWindow=0, endWindow=2100, RejectLongestGap=FALSE,
RejectFirstGap=FALSE, RejectRT=FALSE, color=TRUE, smooth=400,
targetEnd=800, carrier="", targets=c(""),
group="age_group", plotStats="PP", miny = 0.4, maxy=0.95, size=15,
legend.direction = "vertical", legend.position=c(0.85, 0.9),
breaks=c(0.25, 0.50, 0.75), x.target=0.33)
# keeping target signs and separating by stimuli
iChart_v1 <- filter(iChart, stimuli == "V1")
iChart_v2 <- filter(iChart, stimuli == "V2")
createPlots(iChart_v1, startWindow=0, endWindow=2100, RejectLongestGap=FALSE,
RejectFirstGap=FALSE, RejectRT=FALSE, color=TRUE, smooth=400,
targetEnd=800, carrier="V1", targets=c(""),
group="clean_target_img", plotStats="PP", miny = 0.4, maxy=0.95, size=15,
legend.direction = "vertical", legend.position=c(0.85, 0.9),
breaks=c(0.25, 0.50, 0.75), x.target=0.33)
createPlots(iChart_v2, startWindow=0, endWindow=2100, RejectLongestGap=FALSE,
RejectFirstGap=FALSE, RejectRT=FALSE, color=TRUE, smooth=400,
targetEnd=800, carrier="V2", targets=c(""),
group="clean_target_img", plotStats="PP", miny = 0.4, maxy=0.95, size=15,
legend.direction = "vertical", legend.position=c(0.85, 0.9),
breaks=c(0.25, 0.50, 0.75), x.target=0.33)PP by participants
ss.et.kids <- read.table("sol-ichart-v1-post-gating_PP_graphValues_by_subs_0_2100_minRT_33_maxRT_2500_lg_60_fg_34_n_29.txt", header = T)
ss.et.adults <- read.table("sol-ichart-v1-post-gating_PP_graphValues_by_subs_0_2100_minRT_33_maxRT_2500_lg_34_fg_18_n_16.txt", header = T)
ss.et.kids$Sub.Num <- as.character(ss.et.kids$Sub.Num)
ss.et.adults$Sub.Num <- as.character(ss.et.adults$Sub.Num)
# merge
ss.et <- rbind(ss.et.kids, ss.et.adults)Some munging to format data for plotting
detach("package:reshape", unload=TRUE)
#strip X from header
names(ss.et) <- gsub("X", "", names(ss.et))
ss.et <- left_join(ss.et, ss_kids, by="Sub.Num")
#melt to long form for plotting
ss.et.long <- reshape2::melt(ss.et,
id.vars=c("Sub.Num", "Condition",
"Months", "signs_produced",
"groupping", "hearing_status_participant"),
variable.name = "Time.ms",
value.name = "accuracy")
#convert sub.num to a factor
ss.et.long <- ss.et.long %>%
mutate(Sub.Num = as.factor(Sub.Num),
Time.ms = as.numeric(as.character(Time.ms)),
Months = as.factor(Months),
accuracy = as.numeric(accuracy),
hearing_status = as.factor(hearing_status_participant)) %>%
rename(age_group = groupping)Summarise graph values for all participants and for CODAs and Deaf children.
ms_graph_values <- ss.et.long %>%
group_by(age_group, Time.ms) %>%
summarise(mean_accuracy = mean(accuracy),
ci.high = ci.high(accuracy),
ci.low = ci.low(accuracy))
ms_graph_values_coda <- ss.et.long %>%
filter(age_group != "Adults") %>%
group_by(hearing_status, Time.ms) %>%
summarise(mean_accuracy = mean(accuracy),
ci.high = ci.high(accuracy),
ci.low = ci.low(accuracy))Profile plot across children (younger, older) and adults.
Profile plot for CODAs vs. Deaf children.
Profile plot for individual participants, with loess curves.
PP by item
Read in graph values.
# read in wide data for each stimuli set
ss.et.item.v1 <- read.table("sol-ichart-v1-post-gating_PP_graphValues_0_2100_minRT_33_maxRT_2500_lg_60_fg_15_n_16.txt", header = T)
ss.et.item.v2 <- read.table("sol-ichart-v2-post-gating_PP_graphValues_0_2100_minRT_100_maxRT_2467_lg_37_fg_34_n_13.txt", header = T)
# add column to track stimuli
ss.et.item.v1$stimuli <- "V1"
ss.et.item.v2$stimuli <- "V2"
ss.et.item <- bind_rows(ss.et.item.v1, ss.et.item.v2)Munge data for plotting
#strip X from header
names(ss.et.item) <- gsub("X", "", names(ss.et.item))
#create long form df for plotting
ss.et.item.long <- ss.et.item %>%
select(-Condition) %>%
gather(key = Time.ms, value = value, `0`:`2100`) %>%
spread(key = statistic, value = value) %>%
mutate(Time.ms = as.numeric(as.character(Time.ms)),
groupping = as.character(groupping)) %>%
rename(sign = groupping)
#munge target sign df for merging
sol_target_signs_df %<>%
separate(sign, into = c("sign", "signer"), sep = "_") %>%
mutate(stimuli = ifelse(signer == "p", "V1", "V2"))
#merge with eye tracking data
ss.et.item.long <- sol_target_signs_df %>%
select(sign, stimuli, length_ms) %>%
left_join(x = ss.et.item.long, by = c("sign", "stimuli")) Plot by item eye movement data.
Plot all items for both stimulus sets together.
gridExtra::grid.arrange(x, y, ncol = 1)
Plot RT distribution for each stimulus set.
Add sign length information to iChart.
iChart <- left_join(iChart, rename(sol_target_signs_df, clean_target_img = sign),
by = c("clean_target_img", "stimuli"))Get only good RTs: Center to Target shifts, within the analysis window.
iChart_rt <- filter(iChart, trial_types == "C_T", RT >= analysis.window[1], RT <= analysis.window[2])Plot RT distribution for each stimulus set and each sign.
ggplot(data = iChart_rt, aes(x=RT, fill=stimuli)) +
geom_histogram(alpha=1, position="identity") +
facet_grid(stimuli ~ clean_target_img, scales = "fixed") +
geom_vline(aes(xintercept = length_ms), linetype = "dashed") +
geom_text(data = distinct(select(iChart, length_ms, stimuli, clean_target_img)),
aes(x = length_ms, y = 7), label = "sign offset") +
theme_bw()
Analyze
ms_rt_item <- iChart_rt %>%
group_by(Sub.Num, stimuli, clean_target_img, length_ms) %>%
summarise(mean_rt = mean(RT, na.rm=T)) %>%
mutate(diff_rt = mean_rt - length_ms) %>%
group_by(stimuli, clean_target_img, length_ms) %>%
summarise(mean_diff_rt = mean(diff_rt, na.rm=T))Plot the mean difference between participants’ shifts and the offset of that sign.
ggplot(data = ms_rt_item, aes(x=mean_diff_rt, fill=stimuli)) +
geom_histogram(alpha=1, position="dodge", colour="black") +
geom_vline(xintercept = 0, linetype = "dashed") +
geom_text(aes(x = mean_diff_rt, y = 1.5, label = clean_target_img),
angle = 90,
position = "jitter") +
theme_bw()
On 4 out of the 16 signs, participants on average shifted before the end of the target sign.
Model the probability of shifting before the end of the target sign.
iChart_rt %<>% mutate(shift_pre_offset = ifelse(RT <= length_ms, TRUE, FALSE))
fit <- glm(shift_pre_offset ~ length_ms + Months + signs_produced, data = iChart_rt, family = "binomial")
summary(fit)##
## Call:
## glm(formula = shift_pre_offset ~ length_ms + Months + signs_produced,
## family = "binomial", data = iChart_rt)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.5393 -0.8548 -0.3915 1.0142 1.9681
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -5.1525964 0.8833450 -5.833 0.00000000544230 ***
## length_ms 0.0038487 0.0005555 6.928 0.00000000000426 ***
## Months 0.0120277 0.0210418 0.572 0.568
## signs_produced 0.0030616 0.0129394 0.237 0.813
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 408.30 on 298 degrees of freedom
## Residual deviance: 334.76 on 295 degrees of freedom
## (10 observations deleted due to missingness)
## AIC: 342.76
##
## Number of Fisher Scoring iterations: 4Shifting before end of sign is strongly predicted by the length of the sign,