--- title: "CSWL task TD vs DLD - Offline data" author: "Iris Broedelet" date: "25 August 2022" output: html_document: code_folding: show number_sections: yes theme: paper toc: yes toc_float: yes word_document: toc: yes --- # Introduction and hypotheses cross-situational word learning task 52 children (26 TD, 26 DLD) participated in this experiment. In the learning phase of the CSWL task, children could learn 8 word-referent pairings in 28 trials. On every trial, children saw two pictures (at the same time) and heard two words. Every trial was ambiguous in the sense that it was not clear which picture should be paired with which word. The order of the words (first/second) and the order of the pictures (left/right) was congruent in half of the trials. Each word-referent pair occurred 7 times. There were 2 learning conditions: low contextual diversity (LowCD) and high contextual diversity (highCD). In the HighCD condition, each word-referent pair appeared together with a different word-referent pair in each of the 7 trials, while in the LowCD condition, a word-referent pair appeared with only 3 different word-referent pairs in the 7 trials. Thus, in the HighCD condition there was a larger variety in the learning environment, meaning less ambiguity. In the test phase, participants heard each of the 8 words and had to choose between 4 pictures which one should be paired with that word. Learning should be reflected by above-chance (25%) performance on the test phase. We expect better learning in the HighCD Condition (main effect of Condition). Moreover, we expect the children with DLD to be less sensitive to cross-situational statistics than children with DLD (main effect of Group). Finally, it could be the case that children with DLD are more OR less hindered by the effect of Condition (interaction between Group and Condition). ```{r, eval=T, include=F} rm(list = ls()) # Empty environment library("ggplot2") library("lme4") library("plyr") library("psych") library("knitr") library("lmerTest") library("sjPlot") ``` # The data {.tabset} ## Load ```{r} CSL_Test <- read.delim("Data/CSL_Test.txt", sep="\t", dec=".") ``` ## Age check ```{r} #Age (months) per group #I selected 26 TD participants (from 49) based on age tapply(CSL_Test$Age_months, list(CSL_Test$Group), mean, na.rm=TRUE) t.test(CSL_Test$Age_months~CSL_Test$Group) ``` ## Look at the data {.active} ```{r} #Two participants kable(CSL_Test[1:16, ]) ``` ## Print some descriptives ```{r} # Mean accuracy per Group tapply(CSL_Test$Acc,list(CSL_Test$Group),mean,na.rm=TRUE) # SD accuracy per Group tapply(CSL_Test$Acc,list(CSL_Test$Group),sd,na.rm=TRUE) # Mean accuracy per Group and Condition tapply(CSL_Test$Acc,list(CSL_Test$Group, CSL_Test$Condition),mean,na.rm=TRUE) # SD accuracy per Group and Condition tapply(CSL_Test$Acc,list(CSL_Test$Group, CSL_Test$Condition),sd,na.rm=TRUE) # Check number of data points per participant table(CSL_Test$Subject) ``` Every participant contributes 8 data points, no missing data. # Plots {.tabset} ## Violin plot accuracy per Group ```{r, eval=T, echo=F} ## Create dataframe plot1 <- aggregate(Acc ~ Subject+Group,CSL_Test, mean) ``` ```{r, include=F, eval=T} p <- ggplot(plot1, aes(x=Group, y=Acc, color=Group, fill= Group))+ geom_violin(width = 0.4, alpha=0.4)+ stat_summary(fun=mean,geom="point", size=5, shape=23, color="black", fill="white", aes(group=Group))+ geom_jitter(color = "black", size = 2, shape = 1, alpha = 0.6, binwidth = 0.1, width = 0.1)+ scale_fill_manual(values=c("black", "#E69F00"))+ scale_color_manual(values=c("black", "#E69F00"))+ ylab("Accuracy")+ geom_hline(yintercept = .25, color="black", size=0.5, linetype = "dashed" )+ xlab("")+ theme_bw()+ theme(legend.position = "top", legend.direction = "horizontal")+ guides(colour = guide_legend(override.aes = list(shape = NA)))+ theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) ggsave("Graphs/accuracy_group.png", dpi = 600, width = 12, height = 12, units = "cm") dev.off() ``` ```{r} p ``` ## Violin plot accuracy per Group and Condition ```{r, echo=FALSE, eval=TRUE} plot2 <- aggregate(Acc~Subject+Group+Condition,CSL_Test, mean) plot2$Condition <- factor(plot2$Condition, labels=c( "High CD condition", "Low CD condition")) ``` ```{r, include=F, eval=T} p <- ggplot(plot2, aes(x=Group, y=Acc, fill=Condition, color=Condition))+ geom_violin(position=position_dodge(width=0.9),alpha=0.6)+ stat_summary(fun=mean,geom="point", size=5, shape=23, color="black", fill="white", aes(group=Condition), position = position_dodge(0.9))+ scale_fill_manual(values=c("#66CC99", "#CC6666"))+ scale_color_manual(values=c("#66CC99", "#CC6666"))+ ggforce::geom_sina(alpha=.6,shape=1, color="black",size=2)+ ylab("Accuracy")+ xlab("Group")+ geom_hline(yintercept = .25, color="black", size=0.5, linetype = "dashed")+ theme_bw()+ theme(legend.position = "top", legend.direction = "horizontal")+ guides(colour = guide_legend(override.aes = list(shape = NA)))+ theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) ggsave("Graphs/accuracy_group_condition.png", dpi=600, width = 12, height = 12, units = "cm") dev.off() ``` ```{r} p ``` # Statistical analysis {.tabset} ## Set contrasts for glmer model ```{r} CSL_Test$Group <- as.factor(CSL_Test$Group) CSL_Test$Condition <- as.factor(CSL_Test$Condition) contrast <- cbind(c(-0.5, +0.5)) # DLD, TD colnames (contrast) <- c("-DLD+TD") contrasts (CSL_Test$Group) <- contrast contrasts(CSL_Test$Group) contrast <- cbind(c(+0.5, -0.5)) # Condition HighCD, condition LowCD colnames (contrast) <- c("-LowCD+HighCD") contrasts (CSL_Test$Condition) <- contrast contrasts(CSL_Test$Condition) CSL_Test$Age_months <- scale(CSL_Test["Age_months"],center=T,scale=T) ``` ## glmer {.active} ```{r, eval=T, echo=T} model <- glmer(Acc~Group*Condition*Age_months+(1|Subject)+(1|Item), data=CSL_Test, family=binomial, control=glmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2e5))) isSingular(model) tab_model(model, show.se = T, show.stat = T, digits.p = 3, transform = NULL) ``` ## CIs for Group effect ```{r, eval=F, echo=T} ### Compute confidence intervals for the Group effect ci <- confint (model, parm = "Group-DLD+TD", method = "Wald") lower.bound.logodds.model <- ci ["Group-DLD+TD", 1] upper.bound.logodds.model <- ci ["Group-DLD+TD", 2] lower.bound.odds.model <- exp(lower.bound.logodds.model) upper.bound.odds.model <- exp(upper.bound.logodds.model) odds.estimate <- exp(1.3123) #Estimate and CIs Group effect: odds.estimate # 3.714708 lower.bound.odds.model #1.728753 upper.bound.odds.model #7.981304 ``` The TD children were 3.71 (95% CI: 1.73 ... 7.98) times more accurate than the children with DLD when choosing the referent of a word in the test phase of the CSL task: *z* = 3.363, *p* = 0.0008. ## CIs for Condition effect ```{r, eval=F, echo=T} ### Compute confidence intervals for the Condition effect ci <- confint (model, parm = "Condition-LowCD+HighCD", method = "Wald") lower.bound.logodds.model <- ci ["Condition-LowCD+HighCD", 1] upper.bound.logodds.model <- ci ["Condition-LowCD+HighCD", 2] lower.bound.odds.model <- exp(lower.bound.logodds.model) upper.bound.odds.model <- exp(upper.bound.logodds.model) odds.estimate <- exp(0.5147) #Estimate and CIs Condition effect: odds.estimate # 1.673136 lower.bound.odds.model # 0.7906569 upper.bound.odds.model # 3.540423 ``` Although accuracy in the HighCD condition was 1.67 (95% CI: 0.79 ... 3.54) times higher than in the LowCD condition, this effect was not significant: *z* = 1.346, *p* = 0.178367. ## CIs for the Codition * Group interaction ```{r, eval=F, echo=T} ### Compute confidence intervals for the Codition * Group interaction ci <- confint (model, parm = "Group-DLD+TD:Condition-LowCD+HighCD", method = "Wald") lower.bound.logodds.model <- ci ["Group-DLD+TD:Condition-LowCD+HighCD", 1] upper.bound.logodds.model <- ci ["Group-DLD+TD:Condition-LowCD+HighCD", 2] lower.bound.odds.model <- exp(lower.bound.logodds.model) upper.bound.odds.model <- exp(upper.bound.logodds.model) odds.estimate <- exp(-0.1038) #Estimate and CIs Codition * Group interaction: odds.estimate # 1.1 lower.bound.odds.model # 0.249212 upper.bound.odds.model # 4.938677 ``` Although the positive effect of contextual variability in the HighCD Condition was 1.1 (95% CI: 0.25 ... 4.94) times stronger in the children with DLD than the TD children, this interaction between Group and Condition was not significant: *z* = 0.136, *p* = 0.891607. # Exploratory analyses {.tabset} ## Seperate models per Group ```{r} modelDLD <- glmer(Acc~Condition*Age_months+(1|Subject)+(1|Item), data=subset(CSL_Test, Group=="DLD"), family=binomial, control=glmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2e5))) tab_model(modelDLD, show.se = T, show.stat = T, digits.p = 3, transform = NULL) summary(modelDLD) modelTD <- glmer(Acc~Condition*Age_months+(1|Subject)+(1|Item), data=subset(CSL_Test, Group=="TD"), family=binomial, control=glmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2e5))) tab_model(modelTD, show.se = T, show.stat = T, digits.p = 3, transform = NULL) summary(modelTD) ``` ## Compute confidence intervals to compare to chance level {.active} ### TD ```{r, eval=F, echo=T} ### Compute profile confidence intervals for the intercept (i.e. comparison with chance level) ci <- confint (modelTD, parm = "(Intercept)") lower.bound.logodds.modelTD <- ci ["(Intercept)", 1] upper.bound.logodds.modelTD <- ci ["(Intercept)", 2] ### Calculate the CIs of the odds and probabilities based on the logodds lower.bound.odds.modelTD <- exp (lower.bound.logodds.modelTD) upper.bound.odds.modelTD <- exp (upper.bound.logodds.modelTD) lower.bound.prob.modelTD <- lower.bound.odds.modelTD / (lower.bound.odds.modelTD + 1) upper.bound.prob.modelTD <- upper.bound.odds.modelTD / (upper.bound.odds.modelTD + 1) lower.bound.prob.modelTD # 0.6465745 upper.bound.prob.modelTD # 0.9412983 odds.estimate <- exp(1.5532) prob.estimate <- odds.estimate/(odds.estimate+1) prob.estimate # 0.8253754 ``` The estimate of the intercept for the TD children is 0.83 (95% CI: 0.65 ... 0.94), which is significantly higher than chance level (0.25). ### DLD ```{r, eval=F, echo=T} ### Compute profile confidence intervals for the intercept (i.e. comparison with chance level) ci <- confint (modelDLD, parm = "(Intercept)") lower.bound.logodds.modelDLD <- ci ["(Intercept)", 1] upper.bound.logodds.modelDLD <- ci ["(Intercept)", 2] ### Calculate the CIs of the odds and probabilities based on the logodds lower.bound.odds.modelDLD <- exp (lower.bound.logodds.modelDLD) upper.bound.odds.modelDLD <- exp (upper.bound.logodds.modelDLD) lower.bound.prob.modelDLD <- lower.bound.odds.modelDLD / (lower.bound.odds.modelDLD + 1) upper.bound.prob.modelDLD <- upper.bound.odds.modelDLD / (upper.bound.odds.modelDLD + 1) lower.bound.prob.modelDLD # 0.3914631 upper.bound.prob.modelDLD # 0.5951737 odds.estimate <- exp(-0.02625) prob.estimate <- odds.estimate/(odds.estimate+1) prob.estimate # 0.4934379 ``` The estimate of the intercept for the DLD children is 0.49 (95% CI: 0.39 ... 0.6), which is significantly higher than chance level (0.25).