Load required libraries.

rm(list = ls())
library(ggplot2)
library(data.table)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:data.table':
## 
##     between, last

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(tidyr)
library(langcog) # Langcog Lab useful R functions -- www.github.com/langcog/langcog

## 
## Attaching package: 'langcog'

## The following object is masked from 'package:base':
## 
##     scale

theme_set(theme_bw())

d_et <- rbind(
  fread("../eye-tracking/processed_data/simpimp_et_age2.csv", data.table=FALSE),
  fread("../eye-tracking/processed_data/simpimp_et_age3.csv", data.table=FALSE),
  fread("../eye-tracking/processed_data/simpimp_et_age4.csv", data.table=FALSE),
  fread("../eye-tracking/processed_data/simpimp_et_age5.csv", data.table=FALSE),
  fread("../eye-tracking/processed_data/simpimp_et_adult.csv", data.table=FALSE)) %>%
  mutate(trial_type = factor(trial_type, labels = c("control-double", "control-single", "inference")))

head(d_et)

##      expt     subid       stimulus order     trial_type age_group correct
## 1 et_2vs1 140217-06 simpkidsL1.012     1 control-single         2    TRUE
## 2 et_2vs1 140217-06 simpkidsL1.012     1 control-single         2    TRUE
## 3 et_2vs1 140217-06 simpkidsL1.012     1 control-single         2    TRUE
## 4 et_2vs1 140217-06 simpkidsL1.012     1 control-single         2    TRUE
## 5 et_2vs1 140217-06 simpkidsL1.012     1 control-single         2    TRUE
## 6 et_2vs1 140217-06 simpkidsL1.012     1 control-single         2    TRUE
##      t.crit targetAtOnset t.crit.binned
## 1 -6.233667          TRUE        -6.233
## 2 -6.225333          TRUE        -6.233
## 3 -6.217000          TRUE        -6.233
## 4 -6.208667          TRUE        -6.200
## 5 -6.200333          TRUE        -6.200
## 6 -6.192000          TRUE        -6.200

d_ip <- fread("../ipad/simpimp_ipad_short.csv", data.table=FALSE) %>%
  mutate(expt = "ipad") %>%
  filter(trial_type != "practice",
         age_group != "2",
         age_group != "6") %>%
  mutate(trial_type = factor(trial_type, labels = c("control-double", "control-single", "inference"))) %>%
  mutate(
    subid = as.factor(subid),
    age_group = as.factor(age_group), 
    item_num = as.factor(item_num),
    item_rel = as.factor(item_num))
levels(d_ip$item_rel) <- c("fewer", "fewer", "more", "more")
head(d_ip)

##          subid age_group     trial_type item_num correct   rt expt
## 1 141204-01-sc         3 control-single     2vs2       1 1997 ipad
## 2 141204-01-sc         3      inference     3vs1       1 1897 ipad
## 3 141204-01-sc         3 control-double     3vs1       1 3739 ipad
## 4 141204-01-sc         3 control-single     1vs1       1 1517 ipad
## 5 141204-01-sc         3 control-single     1vs1       1 3315 ipad
## 6 141204-01-sc         3 control-single     2vs2       1 2443 ipad
##   item_rel
## 1     more
## 2     more
## 3     more
## 4    fewer
## 5    fewer
## 6     more

clip outliers from rt data.

# remove outliers, by rt
top_bound <- mean(log(d_ip$rt)) + 3*sd(log(d_ip$rt))
bottom_bound <- mean(log(d_ip$rt)) - 3*sd(log(d_ip$rt))

d_ip <- d_ip %>%
  filter(log(rt) < top_bound, 
         log(rt) > bottom_bound)

clip outliers from eye-tracking data.

et_rts <- d_et %>%
  filter(t.crit > 0, targetAtOnset == FALSE & correct == TRUE) %>%
  group_by(subid, expt, order, trial_type, age_group, stimulus) %>%
  summarize(rt = min(t.crit))

# remove outliers, by rt
top_bound <- mean(log(et_rts$rt)) + 3*sd(log(et_rts$rt))
bottom_bound <- mean(log(et_rts$rt)) - 3*sd(log(et_rts$rt))

et_rts <- et_rts %>%
  filter(log(rt) < top_bound, 
         log(rt) > bottom_bound)

iPad

Replicate Stiller et al.’s findings: can 3-5-year-olds compute implicatures?
Test validity of ipad measure
Test saliency hypothesis: does children’s failures on implicature tasks have to do with the demand to inhibit responses toward a more salient object?

accuracy

Children are really good at implicature computation. Fours and fives are at ceiling, and even threes are well above chance.

ms <- d_ip %>%
  group_by(age_group, trial_type, item_rel, subid) %>%
  summarize(correct = mean(correct, na.rm=TRUE)) %>%
  group_by(age_group, trial_type, item_rel) %>%
  multi_boot_standard(column = "correct") %>%
  mutate(correct = mean)

## Joining by: c("age_group", "trial_type", "item_rel")

ggplot(ms, 
       aes(fill=item_rel, y=correct, x=age_group)) +
  geom_bar(position="dodge", stat="identity") + 
  ylab("accuracy rate") + 
  facet_grid(.~trial_type) +
  guides(fill=guide_legend(title=NULL)) +
  geom_hline(yintercept=.50,lty=4) + 
  geom_errorbar(aes(ymin=ci_lower,ymax=ci_upper,width=.2),position=position_dodge(width = 0.90))

rt

Reaction times are not different between different numbers of items.

ip_rt_ms <- d_ip %>%
  group_by(trial_type, item_rel, age_group, subid) %>%
  summarise(rt = mean(rt)) %>%
  group_by(trial_type, item_rel, age_group) %>%
  multi_boot_standard(column = "rt") %>%
  mutate(rt = mean)

## Joining by: c("trial_type", "item_rel", "age_group")

ggplot(ip_rt_ms, aes(x = age_group, y = rt, group = item_rel, col = item_rel)) + 
  geom_line() + 
  geom_pointrange(aes(ymin = ci_lower, ymax = ci_upper), 
                  position = position_dodge(width = .1)) + 
  facet_grid(. ~ trial_type)

eye-tracking

Replicate children’s implicature computation
But expected lower accuracy rate, based on tablet paper
Test the saliency hypothesis: timecourse-sensitive measure of information accumulation vs. inhibitory control

accuracy across both experiments and all trial types

## correct ~ t.crit.binned + trial_type + age_group
ms <- d_et %>%
  filter(t.crit > -1 & t.crit <= 3) %>%
  group_by(expt,trial_type, age_group, t.crit.binned) %>%
  summarise(correct = mean(correct, na.rm = TRUE))

ggplot(subset(ms, age_group != "adult"), 
       aes(x = t.crit.binned, y = correct, colour = age_group)) +
  geom_line() +
  facet_grid(expt~trial_type) +
  geom_vline(xintercept=0,lty=3) + 
  geom_vline(xintercept=0.78,lty=3) + 
  geom_hline(yintercept=.50,lty=4) + 
  xlab("Time (s)") + ylab("Proportion correct looking") + 
  scale_x_continuous(expand = c(0,0)) + 
  scale_y_continuous(limits=c(0,1),expand = c(0,0))

Performance is better on control than inference, and improves with age.

2vs1 vs. 3vs1

# compare 2-vs-1 vs. 3-vs-1
ggplot(subset(ms, age_group != "adult"), 
       aes(x = t.crit.binned, y = correct, colour = expt)) +
  geom_line() +
  facet_grid(age_group~trial_type) +
  geom_vline(xintercept=0,lty=3) + 
  geom_vline(xintercept=0.78,lty=3) + 
  geom_hline(yintercept=.50,lty=4) + 
  xlab("Time (s)") + ylab("Proportion correct looking") + 
  scale_x_continuous(expand = c(0,0)) + 
  scale_y_continuous(limits=c(0,1),expand = c(0,0))

There is no difference between the experiments.

rt

et_rt_ms <- et_rts %>%
  filter(age_group != "adult") %>%
  group_by(trial_type, expt, age_group, subid) %>%
  summarise(rt = mean(rt)) %>%
  group_by(trial_type, expt, age_group) %>%
  multi_boot_standard(column = "rt") %>%
  mutate(rt = mean)

## Joining by: c("trial_type", "expt", "age_group")

ggplot(et_rt_ms, aes(x = age_group, y = rt, group = trial_type, col = trial_type)) + 
  geom_line() + 
  geom_pointrange(aes(ymin = ci_lower, ymax = ci_upper), 
                  position = position_dodge(width = .1)) + 
  facet_grid(. ~ expt) +
  scale_colour_discrete(labels = c("control-double", "control-single", "inference"))

ggplot(et_rt_ms, aes(x = age_group, y = rt, group = expt, col = expt)) + 
  geom_line() + 
  geom_pointrange(aes(ymin = ci_lower, ymax = ci_upper), 
                  position = position_dodge(width = .1)) + 
  facet_grid(. ~ trial_type) +
  scale_colour_discrete(labels = c("2-vs-1", "3-vs-1")) +
  ggtitle("eye-tracking rt")

onset contingent analysis

ms <- d_et %>% 
  filter(age_group != "adult") %>%
  filter(trial_type == "inference") %>%
  group_by(expt, age_group, targetAtOnset, t.crit.binned) %>%
  summarize(correct = mean(correct, na.rm=TRUE)) %>%
  filter(targetAtOnset != "NA") %>%
  ungroup() %>%
  mutate(targetAtOnset = as.numeric(targetAtOnset),
         correct = ifelse(targetAtOnset==1, 1-correct, correct),
         targetAtOnset = as.factor(targetAtOnset),
         age_group = factor(age_group, levels = c("2","3","4", "5", "adult")))

levels(ms$targetAtOnset) <- c("distractor first", "target first")

ggplot(ms, 
      aes(x = t.crit.binned, y = correct, colour = targetAtOnset)) +
  geom_line() +
  facet_grid(expt~age_group) + 
  scale_fill_brewer(palette="Set1") +
  geom_hline(yintercept=.5,lty=4) + 
  geom_vline(xintercept=.78,lty=3) + 
  geom_vline(xintercept=0,lty=3) + 
  scale_y_continuous(expand = c(0, 0), limits=c(0,20)) + 
  xlab("Time (s)") + ylab("Proportion switching") + 
  scale_x_continuous(limits=c(0,2.9),expand = c(0,0)) + 
  scale_y_continuous(limits=c(0,1),expand = c(0,0)) # make the axes start at 0

## Scale for 'y' is already present. Adding another scale for 'y', which
## will replace the existing scale.

## Warning: Removed 452 rows containing missing values (geom_path).

(data munging…)

###### data munging #######
d_et_comp <- d_et %>%
  filter(t.crit > 0.78 & t.crit <= 3) %>%
  mutate(item_num = substring(expt, 4)) %>%
  select(item_num, age_group, trial_type, t.crit, correct, subid) %>%
  mutate(correct = as.factor(correct))
levels(d_et_comp$correct) <- c(0,1)
d_et_comp$correct <- as.numeric(as.character(d_et_comp$correct))

d_et_comp <- d_et_comp %>%
  mutate(trial_type = as.factor(trial_type)) %>%
  group_by(age_group, trial_type, item_num, subid) %>%
  summarise(correct = mean(correct, na.rm = TRUE))
levels(d_et_comp$trial_type) <- c("control-double", "control-single", "inference")
d_et_comp$expt <- "eye-tracking"

d_ip_comp <- d_ip %>%
  select(age_group, trial_type, item_num, correct, subid) %>%
  group_by(age_group, trial_type, item_num, subid) %>%
  summarise(correct = mean(correct, na.rm = TRUE))
d_ip_comp$expt <- "iPad"

# combine the two 
d_comp <- rbind(d_et_comp, d_ip_comp)
#######################

eye-tracking vs. ipad

ipad paradigm more clearly shows children’s success in implicature computation
eye-tracking may be better at capturing the ambiguous nature of ad-hoc implicature
but children might have needed more time to respond in the eye-tracking

accuracy

ms <-  d_comp %>%
  filter(age_group != "adult",
         age_group != "2") %>%
  filter(trial_type != "control-single") %>%
  group_by(expt, age_group, item_num, trial_type) %>%
  multi_boot_standard(column = "correct") %>%
  mutate(correct = mean)

## Joining by: c("expt", "age_group", "item_num", "trial_type")

# bar graph
ggplot(ms, 
       aes(fill=item_num, y=correct, x=age_group)) +
  geom_bar(position="dodge", stat="identity") + 
  facet_grid(trial_type~expt) +
  ylab("Proportion correct looking") + 
  guides(fill=guide_legend(title=NULL)) +
  geom_hline(yintercept=.50,lty=4) + 
  geom_errorbar(aes(ymin=ci_lower,ymax=ci_upper,width=.2),position=position_dodge(width = 0.90)) +
  ggtitle("Inference trials: eye-t vs. iPad")

rt

et_rt_ms <- et_rt_ms %>%
  mutate(item_num = substring(expt, 4)) %>%
  select(age_group, trial_type, item_num, rt, ci_lower, ci_upper)
et_rt_ms$expt <- "eye-tracking"

ip_rt_ms <- d_ip %>%
  group_by(trial_type, item_num, age_group, subid) %>%
  summarise(rt = mean(rt)) %>%
  group_by(trial_type, item_num, age_group) %>%
  multi_boot_standard(column = "rt") %>%
  mutate(rt = mean) %>%
  select(age_group, trial_type, item_num, rt, ci_lower, ci_upper) %>%
  mutate(expt = "iPad") %>%
  mutate(rt = rt/1000,
         ci_lower = ci_lower/1000,
         ci_upper = ci_upper/1000)

## Joining by: c("trial_type", "item_num", "age_group")

rt_ms <- rbind(et_rt_ms, ip_rt_ms)

ggplot(subset(rt_ms, trial_type != "control-single" & age_group != "2" & age_group != "adult"), 
       aes(x = age_group, y = rt, group = trial_type, col = trial_type)) + 
  geom_line() + 
  geom_pointrange(aes(ymin = ci_lower, ymax = ci_upper), 
                  position = position_dodge(width = .1)) + 
  facet_grid(expt ~ item_num) +
  scale_colour_discrete(labels = c("control-double", "control-single", "inference"))

simpimp paper draft

Erica Yoon, Mike Frank

February 11, 2016

iPad

accuracy

rt

eye-tracking

accuracy across both experiments and all trial types

2vs1 vs. 3vs1

rt

onset contingent analysis

eye-tracking vs. ipad

accuracy

rt