Data analysis of social referencing and uncertainty study.
Preliminaries.
## [1] "dplyr" "langcog" "tidyr" "ggplot2" "lme4"
##
## Attaching package: 'langcog'
## The following object is masked from 'package:base':
##
## scale
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
## Warning: package 'ggplot2' was built under R version 3.2.3
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
## The following object is masked from 'package:tidyr':
##
## expand
## Warning: package 'knitr' was built under R version 3.2.3
Read in files and consolidate to the same directory.
d.raw <- data.frame()
files <- dir("../data_e2/coder_1")
for (f in files) {
jf <- paste("../data_e2/coder_1/",f,sep="")
jd <- read.csv(jf)
id <- data.frame(SID = f,
line = jd$phase.ordinal,
phase = as.numeric(jd$phase.1_2_3_4),
phase_onset = jd$phase.onset,
phase_offset = jd$phase.offset,
num_looks = jd$reference.num_looks,
exclude = as.numeric(jd$reference.exclude))
d.raw <- bind_rows(d.raw, id)
}
files <- dir("../data_e2/coder_2")
for (f in files) {
jf <- paste("../data_e2/coder_2/",f,sep="")
jd <- read.csv(jf)
id <- data.frame(SID = f,
line = as.numeric(jd$phase.ordinal),
phase = as.numeric(jd$phase.1_2_3_4),
phase_onset = as.numeric(jd$phase.onset),
phase_offset = as.numeric(jd$phase.offset),
num_looks = as.numeric(jd$reference.num_looks),
exclude = as.numeric(jd$reference.exclude))
d.raw <- bind_rows(d.raw, id)
}
d.raw$SID <- str_replace(d.raw$SID, ".csv", "")
d.raw <- distinct(d.raw, SID, line)
Read in trial info and demographics.
demo <- read.csv("../demo_soc_ref_uncert_exp2.csv")
demo$age <- as.numeric(demo$age)
demo$age_years <- trunc(demo$age, digits = 0)
demo$age_months <- demo$age*12
demo$Condition <- str_replace(demo$Condition, " ", "")
trial_info <- read.csv("trial_info_e2.csv")
Join trial info and demographics with raw data.
d <- left_join(d.raw, demo) %>%
select(SID, phase, num_looks, exclude, age_years, age_months, gender, line, Condition, Gaze, phase_onset, phase_offset) %>%
mutate(phase_length = phase_offset - phase_onset) %>%
mutate(social_ref = as.numeric(num_looks>0))%>%
left_join(trial_info, by = c("Condition","line"))%>%
mutate(first_half = between(trial, 1, 4))
Plot social referencing by trial type (familiar, novel, mutual exclusivity) and presence of referential gaze.
Get means.
#get means for participants by condition for number of looks
msslooks <- filter(d, exclude == 0) %>%
group_by(SID, phase_name, trial_type, Gaze, age_years) %>%
summarise(num_looks = mean(num_looks))
#get means and CIs across participants for number of looks
mslooks <- filter(d, exclude == 0) %>%
group_by(phase_name, trial_type, Gaze, age_years) %>%
multi_boot_standard(col = "num_looks")
msslooks$phase_name <- factor(msslooks$phase_name, levels = c("label-begin_slide","begin_slide-end_slide","end_slide-touch","touch-release"))
mslooks$phase_name <- factor(mslooks$phase_name, levels = c("label-begin_slide","begin_slide-end_slide","end_slide-touch","touch-release"))
Plots.
#plot number of looks.
ggplot(msslooks, aes(x = phase_name, y = num_looks,
col = trial_type, group = trial_type)) +
geom_jitter(width = .3, height = .05) +
geom_line(data = mslooks, aes(y = mean)) +
geom_pointrange(data = mslooks,
aes(y = mean, ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width =.1)) +
facet_grid(age_years ~ Gaze) +
ylim(c(0,3)) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = .5))
#plot number of looks NO INDIVIDUAL DATA PLOTTED.
ggplot(msslooks, aes(x = phase_name, y = num_looks,
col = trial_type, group = trial_type)) +
geom_line(data = mslooks, aes(y = mean)) +
geom_pointrange(data = mslooks,
aes(y = mean, ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width =.1)) +
facet_grid(age_years ~ Gaze) +
ylim(c(0,2.5)) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = .5))
Get phase lengths.
# phase_lengths <- d %>%
# group_by(phase_name) %>%
# summarise(phase_length = mean(phase_length)) %>%
# mutate(time = cumsum(phase_length),
# middle_time = time - phase_length/2,
# middle_time_s = middle_time / 1000)
#
# ms <- left_join(ms, phase_lengths)
# mss <- left_join(mss, phase_lengths)
#plot to include phase lenghts.
# ggplot(mss, aes(x = middle_time_s, y = social_ref,
# col = familiarity, group = familiarity)) +
# geom_jitter(width = .4, height = .05) +
# geom_line(data = ms, aes(y = mean)) +
# geom_pointrange(data = ms,
# aes(y = mean, ymin = ci_lower, ymax = ci_upper),
# position = position_dodge(width =.1)) +
# facet_grid(.~num_objs) +
# ylim(c(0,1)) +
# xlim(c(0, 9)) +
# xlab("Time (s)") +
# ylab("Probability of social referencing") +
# theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = .5))
Plot average phase lengths.
#plot phase lenghts of four phases.
phase_lengths <- d %>%
group_by(phase_name) %>%
multi_boot_standard(col = "phase_length")
ggplot(phase_lengths, aes(x = phase_name, y = mean)) +
geom_bar(stat="identity") +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width = .9))+
xlab("Phase") +
ylab("Phase Length (ms)")
Plot phase lengths by condition by age.
msslengths <- filter(d, exclude == 0) %>%
group_by(SID, phase_name, trial_type, Gaze, age_years) %>%
summarise(phase_length = mean(phase_length))
mslengths <- filter(d, exclude == 0) %>%
group_by(phase_name, trial_type, Gaze, age_years) %>%
multi_boot_standard(col = "phase_length")
msslengths$phase_name <- factor(msslengths$phase_name, levels = c("label-begin_slide","begin_slide-end_slide","end_slide-touch","touch-release"))
mslengths$phase_name <- factor(mslengths$phase_name, levels = c("label-begin_slide","begin_slide-end_slide","end_slide-touch","touch-release"))
ggplot(msslengths, aes(x = phase_name, y = phase_length,
col = trial_type, group = trial_type)) +
geom_line(data = mslengths, aes(y = mean)) +
geom_pointrange(data = mslengths,
aes(y = mean, ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width =.1)) +
facet_grid(age_years ~ Gaze) +
ylim(c(0,12000)) +
xlab("Phase") +
ylab("Phase Length (ms)") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = .5))
# st_maximal_mod <- lmer(num_looks ~ trial_type * Gaze * scale(age_months) +
# (trial_type * Gaze | SID),
# data = filter(d,
# exclude == 0,
# phase_name == "end_slide-touch"))
#
# tr_maximal_mod <- lmer(num_looks ~ trial_type * Gaze * scale(age_months) +
# (trial_type * Gaze | SID),
# data = filter(d,
# exclude == 0,
# phase_name == "touch-release"))
#
# filter(d, exclude == 0, phase_name == "request_touch") %>%
# group_by(age_years, trial_type, Gaze) %>%
# summarise(num_looks = mean(num_looks))
#
# filter(d, exclude == 0, phase_name == "touch_response") %>%
# group_by(age_years, num_objs, familiarity) %>%
# summarise(num_looks = mean(num_looks))
#
# # takes a long time
# omni_maximal_mod <- lmer(num_looks ~ factor(trial_type) * Gaze *
# scale(age_months) * phase_name +
# (trial_type + Gaze + phase_name | SID),
# data = filter(d, exclude == 0))
# glm_maximal_mod <- glmer(social_ref ~ trial_type * Gaze +
# (trial_type + Gaze | SID),
# family = "binomial",
# data = filter(d,
# exclude == 0,
# phase_name == "label-begin_slide"))
Preliminary data suggest that children (particularly 4-year-olds) engage in more social referencing during labeling (phase 1) when they do NOT receive referential gaze information. They might continue checking for ref. gaze when they don’t get it? Our hypothesis that children might selectively social reference for novel trials during phase 1 with helpful gaze is not supported by the current data.
Soc ref patterns in phases 3 and 4 replicate Experiment 1: 3- and 4-year-olds do more referencing for novel trials in phase 4; only 4-year-olds do more referencing for novel trials in phase 3. Patterns for mutual exclusivity trials are similar to familiar trials.