Fragile-X Free-viewing Conversation Eye-tracking Analysis

Read in data (not shown).

Preliminaries

How many exclusions?

sum(d$exclude)

## [1] 2

d <- subset(d, exclude==0)

Make sure that the data match viola jones preliminary results (sanity check).

qplot(face.after.start.vj, face.dpm, colour=group,label=id,
      geom="text",
      data=d) + 
  ylim(c(0,1)) 

Generalized looking at faces

Group-level analysis (all error bars represent 95% confidence interval by non-parametric bootstrap).

ms <- ddply(d, .(group), summarise, 
            face.looking = na.mean(face.dpm),     
            face.cih = ci.high(face.dpm), 
            face.cil = ci.low(face.dpm))

qplot(group,face.looking, geom=c("bar","linerange"),
      fill=group,
      stat="identity",
      ymin=face.looking-face.cil,
      ymax=face.looking+face.cih,
      data=ms) + 
  ylim(c(0,1)) + 
  scale_fill_discrete(name="Participant Group") +  
  ylab("Proportion Looking at Face") + 
  xlab("Participant Group")

Now by individuals:

qplot(group, face.dpm, data=d, position=position_jitter(.1), col=group) + 
  geom_linerange(aes(x=group, y=face.looking, ymin=face.looking-face.cil,
                     ymax=face.looking+face.cih), col="black", data=ms) + 
  geom_errorbarh(aes(xmin=as.numeric(group)-.05, xmax=as.numeric(group)+.05, 
                     y=face.looking), 
                 data=ms, col="black", height=0, size=2) +
  ylab("Proportion Looking at Face") + 
  xlab("Participant Group")

Now boxplots:

qplot(group, face.dpm, data=d, 
      col=group,
      geom="boxplot") +
  ylim(c(0,1)) +
  ylab("Proportion Looking at Face") + 
  xlab("Participant Group")

Stickiness analyses

Group-level analysis, unsmoothed (1 frame off counts as a break in attention).

ms <- ddply(d, .(group), summarise, 
            stickiness = na.mean(stickiness.mean),     
            stickiness.cih = ci.high(stickiness.mean), 
            stickiness.cil = ci.low(stickiness.mean))

qplot(group,stickiness, geom=c("bar","linerange"),
      fill=group, 
      stat="identity",
      ymin=stickiness-stickiness.cil,
      ymax=stickiness+stickiness.cih,
      data=ms) + 
  ylab("Mean Length of Time Looking at Face (s)") + 
  xlab("Participant Group")

Now, smoothed (must be 4+ frames off - 133ms at 30hz). Same pattern, but looks are much longer.

ms <- ddply(d, .(group), summarise, 
            stickiness = na.mean(stickiness.sm.mean),     
            stickiness.cih = ci.high(stickiness.sm.mean), 
            stickiness.cil = ci.low(stickiness.sm.mean))

qplot(group,stickiness, geom=c("bar","linerange"),
      fill=group, 
      stat="identity",
      ymin=stickiness-stickiness.cil,
      ymax=stickiness+stickiness.cih,
      data=ms) + 
  ylab("Mean Length of Time Looking at Face (s)") + 
  xlab("Participant Group")

With individuals.

qplot(group, stickiness.sm.mean, data=d, position=position_jitter(.1), col=group) + 
  geom_linerange(aes(x=group, y=stickiness, ymin=stickiness-stickiness.cil,
                     ymax=stickiness+stickiness.cih), col="black", data=ms) + 
  geom_errorbarh(aes(xmin=as.numeric(group)-.05, xmax=as.numeric(group)+.05, 
                     y=stickiness), 
                 data=ms, col="black", height=0, size=2) +
  ylab("Mean Length of Time Looking at Face (s)") + 
  xlab("Participant Group") + 
  scale_colour_discrete(name="Participant Group")

Boxplots.

md <- melt(d,id.vars=c("id","group"), 
           measure.vars=c("stickiness.sm.mean","none.sm.mean"))
levels(md$variable) <- c("Face-Looking Bout","Inter-Bout Interval")
qplot(variable, value, data=md, col=group,
      geom="boxplot") +
  ylab("Mean Length (s)") + 
  ylim(c(0,12)) + 
  xlab("Participant Group") + 
  scale_colour_discrete(name="Participant Group")

Region-level analyses

Again, group-level:

md <- melt(d, id.var=c("id","group"), 
           measure.var=c("nose","l.eye","r.eye","mouth","l.jaw","r.jaw"))
levels(md$variable) <- c("Nose","L Eye", "R Eye","Mouth","L Jaw","R Jaw")

ms <- ddply(md, .(group,variable), summarise, 
            face.looking = na.mean(value), 
            face.cih = ci.high(value), 
            face.cil = ci.low(value))

qplot(variable,face.looking, geom=c("bar","linerange"),
      facets=. ~ group, fill=variable,
      stat="identity",
      position=position_dodge(width=.9),
      ymin=face.looking-face.cil,
      ymax=face.looking+face.cih,
      data=ms) + 
  ylim(c(0,.3)) + 
  ylab("Proportion Looking") + 
  xlab("Region") + 
  scale_fill_discrete(name="Region") + 
  theme(axis.text.x = element_text(angle = 90, vjust=.5, hjust = 1)) 

Showing individuals:

qplot(variable, value, data=md, position=position_jitter(.1), col=variable, 
      facets=.~ group) + 
  geom_linerange(aes(x=variable, y=face.looking, ymin=face.looking-face.cil,
                     ymax=face.looking+face.cih), col="black", data=ms) + 
  geom_errorbarh(aes(xmin=as.numeric(variable)-.25, xmax=as.numeric(variable)+.25, 
                     y=face.looking), col="black",
                 data=ms, height=0, size=2) + 
  ylab("Proportion Looking") + 
  xlab("Region") + 
  scale_fill_discrete(name="Region") + 
  theme(axis.text.x = element_text(angle = 90, vjust=.5, hjust = 1)) 

That’s a little messy, so let’s try boxplots:

qplot(variable, value, data=md,  col=group,
      geom="boxplot",adjust=1)+ 
  ylab("Proportion Looking") + 
  xlab("Region") + 
  scale_fill_discrete(name="Region") + 
  theme(axis.text.x = element_text(angle = 90, vjust=.5, hjust = 1)) 

Demographic variables

Plot face looking by age:

qplot(age, face.dpm, colour=group, data=d) + 
  geom_smooth(method="lm", se=FALSE) + 
  xlab("Age (years)") + 
  ylab("Proportion Face Looking") + 
  scale_colour_discrete(name="Participant Group")

IQ:

qplot(iq, face.dpm, colour=group, data=d) + 
  geom_smooth(method="lm", se=FALSE)+ 
  xlab("IQ (standardized)") + 
  ylab("Proportion Face Looking") + 
  scale_colour_discrete(name="Participant Group")

Statistical models

Clearly there’s a strong face looking by group effect:

l <- lm(face.dpm ~ group, data=d)
summary(l)

## 
## Call:
## lm(formula = face.dpm ~ group, data = d)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -0.458 -0.169 -0.070  0.145  0.673 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   0.5456     0.0531   10.28  1.7e-15 ***
## groupFXS     -0.3471     0.0622   -5.58  4.5e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.231 on 68 degrees of freedom
## Multiple R-squared:  0.314,  Adjusted R-squared:  0.304 
## F-statistic: 31.2 on 1 and 68 DF,  p-value: 4.47e-07

anova(l)

## Analysis of Variance Table
## 
## Response: face.dpm
##           Df Sum Sq Mean Sq F value  Pr(>F)    
## group      1   1.67   1.668    31.2 4.5e-07 ***
## Residuals 68   3.64   0.054                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Now look at age effects. No interaction, but main effects of age and group.

l.age <- lm(face.dpm ~ iq * group, data=d)
summary(l.age)

## 
## Call:
## lm(formula = face.dpm ~ iq * group, data = d)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -0.4188 -0.1361 -0.0761  0.1333  0.7353 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)  0.40388    0.20765    1.95    0.056 .
## iq           0.00187    0.00266    0.70    0.483  
## groupFXS    -0.47766    0.24377   -1.96    0.054 .
## iq:groupFXS  0.00224    0.00325    0.69    0.492  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.226 on 66 degrees of freedom
## Multiple R-squared:  0.366,  Adjusted R-squared:  0.337 
## F-statistic: 12.7 on 3 and 66 DF,  p-value: 1.22e-06

anova(l.age)

## Analysis of Variance Table
## 
## Response: face.dpm
##           Df Sum Sq Mean Sq F value  Pr(>F)    
## iq         1   0.62   0.620   12.16 0.00087 ***
## group      1   1.30   1.296   25.41 3.9e-06 ***
## iq:group   1   0.02   0.024    0.48 0.49185    
## Residuals 66   3.37   0.051                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Now look at IQ. Same story.

l.iq <- lm(face.dpm ~ iq * group, data=d)
summary(l.iq)

## 
## Call:
## lm(formula = face.dpm ~ iq * group, data = d)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -0.4188 -0.1361 -0.0761  0.1333  0.7353 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)  0.40388    0.20765    1.95    0.056 .
## iq           0.00187    0.00266    0.70    0.483  
## groupFXS    -0.47766    0.24377   -1.96    0.054 .
## iq:groupFXS  0.00224    0.00325    0.69    0.492  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.226 on 66 degrees of freedom
## Multiple R-squared:  0.366,  Adjusted R-squared:  0.337 
## F-statistic: 12.7 on 3 and 66 DF,  p-value: 1.22e-06

anova(l.iq)

## Analysis of Variance Table
## 
## Response: face.dpm
##           Df Sum Sq Mean Sq F value  Pr(>F)    
## iq         1   0.62   0.620   12.16 0.00087 ***
## group      1   1.30   1.296   25.41 3.9e-06 ***
## iq:group   1   0.02   0.024    0.48 0.49185    
## Residuals 66   3.37   0.051                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Time-course analyses

Read in data, first.

tc <- data.frame()
fs <- dir("Data/timecourse",pattern="*.csv")

for (f in fs) {
  s <- read.csv(paste("Data/timecourse/",f,sep=""))
  s <- s[-c(1,2),] ## remove the first two rows, IQ and age 
  tc <- rbind.fill(tc, 
                   data.frame(id=as.numeric(strsplit(f,"\\.")[[1]][2]),
                              t=1:length(s),
                              region=s))
  
  }

tc$face <- tc$region != 0
tc$t.sec <- tc$t / 5 # 5 hz downsampling

head(tc)

## [1] face  t.sec
## <0 rows> (or 0-length row.names)

Now aggregate this over time. First a sanity check to make sure we’re coming up with the DPM data. As you can see, this does in fact recover the correct mapping.

head(tc)

## [1] face  t.sec
## <0 rows> (or 0-length row.names)

ms <- ddply(tc, .(id), summarise, face = mean(face,na.rm=TRUE))
dm <- merge(d,ms)
qplot(face.dpm, face, data=dm)

Now figure out the timing. I believe we are at 60hz.

{r, cache=TRUE} # qplot(t.sec, data=ms) + # xlab("Session length (min)") # #

Now compute timecourses.

{r, cache=TRUE} # ms <- ddply(tc, .(id), summarise, t.sec = max(t.sec)/60) # d <- merge(d, ms) # # tc <- merge(tc, d[,c("id","group")]) # merge in group labels # tc$t.bin <- floor(tc$t.sec/10)*10 # break into 10s bins # tcs <- ddply(tc, .(t.bin, group), summarise, # face.mean = mean(face), # face.cil = ci.low(face), # face.cih = ci.high(face)) #

{r} # qplot(t.bin/60, face.mean, # ymin=face.mean - face.cil, # ymax=face.mean + face.cih, # geom="pointrange", # col=group, data=tcs) + # xlim(c(0,10)) + # ylim(c(0,.8)) + # xlab("Time (min)") + # ylab("Proportion Face Looking") + # geom_smooth() #

Write output.

{r, cache=TRUE} #write.csv(d,"Data/output.csv",row.names=FALSE) #