Analysis code for SOC-XSIT project.

Load libraries.

source("/Users/kmacdonald/Documents/Projects/SOC_XSIT/XSIT-MIN/analysis/Ranalysis/useful.R")
library(reshape2)
library(plyr)
library(dplyr)
library(bootstrap)
library(lme4)
library(ggplot2)

Read in the master data file

setwd("/Users/kmacdonald/Documents/Projects/SOC_XSIT/processed_data/adult-looks/")
d.all_df <- read.csv("soc_xsit_data_all.csv")

Get the number of subjects in each experiment and condition.

## Source: local data frame [14 x 4]
## Groups: experiment, condition
## 
##              experiment      condition gazeLength n_subs
## 1           look_length         Social       Long     40
## 2           look_length         Social     Medium     47
## 3           look_length         Social      Short     40
## 4         noisy_channel      No-social      Short     91
## 5         noisy_channel         Social      Noisy     91
## 6         noisy_channel         Social      Short     92
## 7     soc_vs_no_soc_btw      No-social      Short     47
## 8     soc_vs_no_soc_btw         Social      Short     45
## 9  soc_vs_no_soc_within No-socialFirst      Short     39
## 10 soc_vs_no_soc_within    SocialFirst      Short     43
## 11             this_one            One      Short     46
## 12             this_one           This      Short     40
## 13   within_replication No-socialFirst      Short     87
## 14   within_replication    SocialFirst      Short     84

Flag whether participants chose target of eye gaze on exposure.

#change values of faceIdx to correspond to values of chosenIdx 
#(LU = 0, RU = 1, LD = 2, RD = 3, striaight = -1)
d.all_df$faceIdx <- revalue(d.all_df$face, 
                            c("silentLUlong"= 0, "silentLUmedium" = 0,
                              "silentLUshort"= 0, "LUkidslonger" = 0,
                              "noisyLU" = 0,
                              "silentRUlong" = 1, "silentRUmedium"= 1,
                              "silentRUshort" = 1, "RUkidslonger" = 1,
                              "noisyRU" = 1,
                              "silentLDlong" = 2, "silentLDmedium" = 2,
                              "silentLDshort" = 2, "LDkidslonger" = 2,
                              "noisyLD" = 2,
                              "silentRDlong" = 3, "silentRDmedium" = 3,
                              "silentRDshort" = 3, "RDkidslonger" = 3, 
                              "noisyRD" = 3,
                              "straightahead" = -1, "straightaheadlonger" = -1))

#flag trial, if subs chose target of gaze
d.expo_df <- d.all_df %>%
      filter(exposure_trial == 1) %>%
      mutate(correct_exposure = faceIdx == chosenIdx) %>%
      select(subids, itemNum, correct_exposure)

Get test trials and merge exposure trial information.

d.test_df <- d.all_df %>%
      filter(test_trial == 1)

d.test_df <- merge(d.expo_df, d.test_df, by = c("subids", "itemNum"))

Flag subs who got <25% of exposure trials correct. This can be used for exclusionary criteria in later analyses.

d.test_df <- d.test_df %>%
      group_by(subids) %>%
      summarise(mean_acc_exp = mean(correct_exposure)) %>%
      mutate(include_expo = ifelse(mean_acc_exp > 0.25,1,0)) %>%
      join(d.test_df, by = "subids")

Flag trials with extremely slow or fast RTs (+/- 2SD).

d.test_df <- d.test_df %>%
      mutate(include_good_rt = ifelse(log(rt) > mean(log(rt)) + 2 * sd(log(rt)) |
                                            log(rt) < mean(log(rt)) - 2 * sd(log(rt)),
                                      0,1))

Summarize data set: means for acc on exposure and test

Experiment 1: Look-length manipulation.

Filter data and output the number of subjects removed in each condition based on filtering

glength_df <- filter(d.test_df, experiment == "look_length", 
                     include_good_rt == 1)

glength_filt_df <- filter(d.test_df, experiment == "look_length", 
                          include_good_rt == 1, include_expo == 1)

#get number of subjects filtered out
glength_n <- d.test_df %>%
      filter(experiment == "look_length") %>%
      group_by(gazeLength) %>%
      summarise(n_subs = n_distinct(subids))

glength_n_filtered <- glength_filt_df %>%
      filter(experiment == "look_length") %>%
      group_by(gazeLength) %>%
      summarise(n_subs_filt = n_distinct(subids)) %>%
      select(n_subs_filt)

cbind(glength_n, glength_n_filtered)
##   gazeLength n_subs n_subs_filt
## 1       Long     40          35
## 2     Medium     47          41
## 3      Short     40          27

Accuracy on exposure trials both filtered and unfiltered.

ms_exp_looks <- glength_df %>%
      group_by(gazeLength) %>%
      summarise(accuracy_exposure = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure))

ms_exp_looks_filt <- glength_filt_df %>%
      group_by(gazeLength) %>%
      summarise(accuracy_exposure = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure))

ms_exp_looks$gazeLength <- factor(ms_exp_looks$gazeLength, 
                                  levels = c("Short", "Medium", "Long"))
ms_exp_looks_filt$gazeLength <- factor(ms_exp_looks_filt$gazeLength, 
                                       levels = c("Short", "Medium", "Long"))

glen_acc_exp <- ggplot(data=ms_exp_looks, 
                       aes(x=gazeLength, y=accuracy_exposure,
                           fill=gazeLength)) + 
      geom_bar(stat="identity") +
      geom_pointrange(aes(ymin=accuracy_exposure-ci_low, 
                          ymax=accuracy_exposure+ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Unfiltered")

glen_acc_exp_filt <- ggplot(data=ms_exp_looks_filt, 
                            aes(x=gazeLength, y=accuracy_exposure,
                                fill=gazeLength)) + 
      geom_bar(stat="identity") +
      geom_pointrange(aes(ymin=accuracy_exposure-ci_low, 
                          ymax=accuracy_exposure+ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1))+
      ggtitle("Filtered")

multiplot(glen_acc_exp, glen_acc_exp_filt, cols=2)

Accuracy on test trials: same/switch. For both filtered and unfiltered.

ms_test_looks <- glength_df %>%
      group_by(gazeLength, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_looks_filt <- glength_filt_df %>%
      group_by(gazeLength, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_looks$gazeLength <- factor(ms_test_looks$gazeLength, 
                                   levels = c("Short", "Medium", "Long"))

ms_test_looks_filt$gazeLength <- factor(ms_test_looks_filt$gazeLength, 
                                        levels = c("Short", "Medium", "Long"))

glen_acc_test <- ggplot(ms_test_looks, 
                        aes(x=gazeLength, y=accuracy, 
                            group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Acc Test Unfiltered")

glen_acc_test_filt <- ggplot(ms_test_looks_filt, 
                             aes(x=gazeLength, y=accuracy, 
                                 group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Acc Test Filtered")

multiplot(glen_acc_test, glen_acc_test_filt, cols=2)

Experiment 2: Social vs. No-Social between subjects.

Only used the short gaze length condition.

First, set up filters.

btw_subs_df <- filter(d.test_df, experiment == "soc_vs_no_soc_btw", 
                      include_good_rt == 1)

btw_subs_filt_df <- filter(d.test_df, experiment == "soc_vs_no_soc_btw", 
                           include_good_rt == 1, include_expo == 1 | condition == "No-social")

#get number of subjects filtered out
btw_subs_n <- d.test_df %>%
      filter(experiment == "soc_vs_no_soc_btw") %>%
      group_by(condition) %>%
      summarise(n_subs = n_distinct(subids))

btw_subs_n_filtered <- btw_subs_filt_df %>%
      filter(experiment == "soc_vs_no_soc_btw") %>%
      group_by(condition) %>%
      summarise(n_subs_filt = n_distinct(subids)) %>%
      select(n_subs_filt)

cbind(btw_subs_n, btw_subs_n_filtered)
##   condition n_subs n_subs_filt
## 1 No-social     47          47
## 2    Social     45          39

Accuracy on exposure trials.

ms_exp_btw <- btw_subs_df %>%
      filter(condition == "Social") %>%
      summarise(accuracy_exposure = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure)) %>%
      mutate(filtering = "unfiltered")

ms_exp_btw_filt <- btw_subs_filt_df %>%
      filter(condition == "Social") %>%
      summarise(accuracy_exposure = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure)) %>%
      mutate(filtering = "filtered")

ms_exp_btw_bind <- rbind(ms_exp_btw, ms_exp_btw_filt)

qplot(data=ms_exp_btw_bind, x=filtering, y=accuracy_exposure, fill=filtering) +
      geom_bar(stat="identity") +
      geom_pointrange(aes(ymin=accuracy_exposure-ci_low, 
                          ymax=accuracy_exposure+ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1))

Accuracy on test trials

ms_test_btw <- btw_subs_df %>%
      group_by(condition, trialType) %>%
      summarise(accuracy_test = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_btw_filt <- btw_subs_filt_df %>%
      group_by(condition, trialType) %>%
      summarise(accuracy_test = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_btw$condition <- factor(ms_test_btw$condition, 
                                levels = c("Social", "No-social"))
ms_test_btw_filt$condition <- factor(ms_test_btw_filt$condition, 
                                     levels = c("Social", "No-social"))

#now plot
acc_test_btw <- ggplot(ms_test_btw, 
                       aes(x=condition, y=accuracy_test, 
                           group=trialType, colour=trialType)) +
      geom_point(size=2.5) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy_test - ci_low,
                          ymax=accuracy_test + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      xlab("Condition") +
      ylab("Proportion Correct") +
      labs(colour = "Trial Type") +
      ggtitle("Between-Subs (Smile) Unfiltered")

acc_test_btw_filt <- ggplot(ms_test_btw_filt, 
                            aes(x=condition, y=accuracy_test, 
                                group=trialType, colour=trialType)) +
      geom_point(size=2.5) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy_test - ci_low,
                          ymax=accuracy_test + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      xlab("Condition") +
      ylab("Proportion Correct") +
      labs(colour = "Trial Type") +
      ggtitle("Between-Subs (Smiley) Filtered")

multiplot(acc_test_btw, acc_test_btw_filt, cols=2)

Model the data.

inc.data <- filter(d.test_df, experiment == "soc_vs_no_soc_btw", 
                   include_good_rt == 1,
                   include_expo == 1 | condition == "No-social")
m1 <- glmer(correct ~ trialType * condition + (trialType | subids),
            data = inc.data,
            family=binomial)
summary(m1)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ trialType * condition + (trialType | subids)
##    Data: inc.data
## 
##      AIC      BIC   logLik deviance df.resid 
##    577.9    609.2   -281.9    563.9      640 
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -1.98339 -0.62566  0.02875  0.58440  1.60422 
## 
## Random effects:
##  Groups Name            Variance Std.Dev. Corr 
##  subids (Intercept)     31.00    5.568         
##         trialTypeSwitch 30.98    5.566    -0.99
## Number of obs: 647, groups:  subids, 86
## 
## Fixed effects:
##                                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                       7.1098     1.5021   4.733 2.21e-06 ***
## trialTypeSwitch                  -6.6739     1.5108  -4.417 9.99e-06 ***
## conditionSocial                  -0.2384     1.2183  -0.196    0.845    
## trialTypeSwitch:conditionSocial  -0.9717     1.2448  -0.781    0.435    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) trlTyS cndtnS
## trlTypSwtch -0.991              
## conditinScl -0.382  0.375       
## trlTypSwt:S  0.369 -0.386 -0.968
ms <- aggregate(correct ~ trialType + condition, FUN=mean,
                data = inc.data)

f <- fixef(m1)
ms$coef <- NA
ms$coef[1] <- inv.logit(f[1])
ms$coef[2] <- inv.logit(f[1] + f[2])
ms$coef[3] <- inv.logit(f[1] + f[3])
ms$coef[4] <- inv.logit(f[1] + f[2] + f[3] + f[4])
hist(ranef(m1)$subids[,1])

hist(ranef(m1)$subids[,2])

mss <- aggregate(correct ~ subids + trialType + condition, FUN=mean,
                 data = inc.data)

cmss <- dcast(mss, condition+ subids ~  trialType)
## Using correct as value column: use value.var to override.
qplot(Same,Switch, data=cmss, position="jitter") + 
      facet_wrap(~condition)

lm1 <- glm(correct ~ trialType * condition,
           data = inc.data,
           family=binomial)
summary(lm1) 
## 
## Call:
## glm(formula = correct ~ trialType * condition, family = binomial, 
##     data = inc.data)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.3224  -0.9044   0.3736   0.4202   1.4776  
## 
## Coefficients:
##                                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                       2.6271     0.2989   8.788  < 2e-16 ***
## trialTypeSwitch                  -2.2532     0.3345  -6.737 1.62e-11 ***
## conditionSocial                  -0.2445     0.4247  -0.576   0.5649    
## trialTypeSwitch:conditionSocial  -0.8121     0.4840  -1.678   0.0934 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 790.29  on 646  degrees of freedom
## Residual deviance: 601.42  on 643  degrees of freedom
## AIC: 609.42
## 
## Number of Fisher Scoring iterations: 5
f <- coef(lm1)
ms$lcoef <- NA
ms$lcoef[1] <- inv.logit(f[1])
ms$lcoef[2] <- inv.logit(f[1] + f[2])
ms$lcoef[3] <- inv.logit(f[1] + f[3])
ms$lcoef[4] <- inv.logit(f[1] + f[2] + f[3] + f[4])
m2 <- glmer(correct ~ trialType * condition + (1 | subids),
            data = inc.data,
            family=binomial)
f <- fixef(m2)
ms$m2coef <- NA
ms$m2coef[1] <- inv.logit(f[1])
ms$m2coef[2] <- inv.logit(f[1] + f[2])
ms$m2coef[3] <- inv.logit(f[1] + f[3])
ms$m2coef[4] <- inv.logit(f[1] + f[2] + f[3] + f[4])
summary(m2)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ trialType * condition + (1 | subids)
##    Data: inc.data
## 
##      AIC      BIC   logLik deviance df.resid 
##    599.3    621.7   -294.7    589.3      642 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.5453 -0.5871  0.2402  0.4111  3.2605 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  subids (Intercept) 0.6883   0.8297  
## Number of obs: 647, groups:  subids, 86
## 
## Fixed effects:
##                                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                       2.9429     0.3530   8.337  < 2e-16 ***
## trialTypeSwitch                  -2.4994     0.3605  -6.933 4.12e-12 ***
## conditionSocial                  -0.3042     0.4780  -0.636   0.5245    
## trialTypeSwitch:conditionSocial  -0.9147     0.5104  -1.792   0.0731 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) trlTyS cndtnS
## trlTypSwtch -0.835              
## conditinScl -0.676  0.570       
## trlTypSwt:S  0.511 -0.646 -0.800
anova(m1,m2)
## Data: inc.data
## Models:
## m2: correct ~ trialType * condition + (1 | subids)
## m1: correct ~ trialType * condition + (trialType | subids)
##    Df    AIC    BIC  logLik deviance  Chisq Chi Df Pr(>Chisq)    
## m2  5 599.32 621.68 -294.66   589.32                             
## m1  7 577.87 609.18 -281.94   563.87 25.451      2  2.974e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

model with simple linear model – do not use, just for kicks

summary(lm(correct ~ condition * trialType, data=mss))
## 
## Call:
## lm(formula = correct ~ condition * trialType, data = mss)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.91667 -0.09397  0.06560  0.08333  0.66453 
## 
## Coefficients:
##                                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                      0.93440    0.03598  25.969  < 2e-16 ***
## conditionSocial                 -0.01773    0.05343  -0.332  0.74043    
## trialTypeSwitch                 -0.34043    0.05089  -6.690 3.18e-10 ***
## conditionSocial:trialTypeSwitch -0.24077    0.07556  -3.186  0.00172 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2467 on 168 degrees of freedom
## Multiple R-squared:  0.4976, Adjusted R-squared:  0.4886 
## F-statistic: 55.46 on 3 and 168 DF,  p-value: < 2.2e-16

Experiment 3: Within Subjects Social vs. No-social

Replicate the social effect on switch trials with a within-subjects manipulation. This allows us to make stronger inferences about the difference between conditions because there is less between subjects variability.

Filter just trials from within-subjects experiment.

d_within_df <- filter(d.all_df, experiment == "soc_vs_no_soc_within" | 
                            experiment == "within_replication")

d_within_df %>%
      group_by(condition, experiment) %>%
      summarise(n_subs = n_distinct(subids))
## Source: local data frame [4 x 3]
## Groups: condition
## 
##        condition           experiment n_subs
## 1 No-socialFirst soc_vs_no_soc_within     39
## 2 No-socialFirst   within_replication     87
## 3    SocialFirst soc_vs_no_soc_within     43
## 4    SocialFirst   within_replication     84

Flag social vs. no-social trials

When we switched to within subjects, we tracked which block came first, but didn’t track social vs. no-social. So we create a column to track this information

d_within_df <- d_within_df %>%
      mutate(condition_trial = ifelse(condition == "No-socialFirst" 
                                      & itemNum <= 7, "no-social", 
                                      ifelse(condition == "SocialFirst" 
                                             & itemNum <= 7, "social", 
                                             ifelse(condition == "No-socialFirst" 
                                                    & itemNum >= 8, "social",
                                                    ifelse(condition == "SocialFirst" 
                                                           & itemNum >= 8, 
                                                           "no-social", NA)))))
#flag trial, if subs chose target of gaze
d_within_expo_df <- d_within_df %>%
      filter(exposure_trial == 1) %>%
      mutate(correct_exposure = faceIdx == chosenIdx) %>%
      select(subids, itemNum, correct_exposure)

#grab test trials
d_within_test_df <- d_within_df %>%
      filter(test_trial == 1)

#merge with test trials
d_within_test_df <- join(d_within_test_df, d_within_expo_df, c("subids", "itemNum"))

Flag subs who got <25% of exposure trials correct. This can be used for exclusionary criteria in later analyses.

d_within_soc_df <- filter(d_within_test_df, condition_trial == "social")

d_within_soc_df <- d_within_soc_df %>%
      group_by(subids) %>%
      summarise(mean_acc_exp = mean(correct_exposure)) %>%
      mutate(include_expo = ifelse(mean_acc_exp > 0.25,1,0)) 

d_within_test_df <- join(d_within_test_df, d_within_soc_df, by = "subids")

Flag trials with extremely slow or fast RTs (+/- 2SD).

d_within_test_df <- d_within_test_df %>%
      mutate(include_good_rt = ifelse(log(rt) > mean(log(rt)) + 2 * sd(log(rt)) |
                                            log(rt) < mean(log(rt)) - 2 * sd(log(rt)),
                                      0,1))

Set up filters

d_within_expo <- filter(d_within_test_df,
                        include_good_rt == 1, 
                        condition_trial == "social")


d_within_expo_filt <- filter(d_within_test_df,
                             include_good_rt == 1, include_expo == 1, 
                             correct_exposure == T, condition_trial == "social")

Get the number of subjects filtered out

#get number of subjects filtered out
within_n <- d_within_expo %>%
      summarise(n_subs = n_distinct(subids))

within_n_filt <- d_within_expo_filt %>%
      summarise(n_subs_filt = n_distinct(subids)) %>%
      select(n_subs_filt)

cbind(within_n, within_n_filt)
##   n_subs n_subs_filt
## 1    253         188

Accuracy on exposure trials

ms_expo_within <- d_within_expo %>%
      group_by(condition, condition_trial) %>%
      summarise(accuracy_exposure = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure))

ms_expo_within_filt <- d_within_expo_filt %>%
      group_by(condition, condition_trial) %>%
      summarise(accuracy_exposure = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure))

ms_expo_within$condition <- factor(ms_expo_within$condition)
ms_expo_within_filt$condition <- factor(ms_expo_within_filt$condition)

acc_exp_within <- ggplot(data=ms_expo_within, 
                         aes(x=condition, y=accuracy_exposure)) + 
      geom_bar(stat="identity", fill = I("grey50")) +
      geom_pointrange(aes(ymin=accuracy_exposure-ci_low, 
                          ymax=accuracy_exposure+ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Proportion chose target of eye gaze \n Schematic/Unfiltered")

acc_exp_within_filt <- ggplot(data=ms_expo_within_filt, 
                         aes(x=condition, y=accuracy_exposure)) + 
      geom_bar(stat="identity", fill = I("grey50")) +
      geom_pointrange(aes(ymin=accuracy_exposure-ci_low, 
                          ymax=accuracy_exposure+ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Proportion chose target of eye gaze \n Schematic/Filtered")

multiplot(acc_exp_within, acc_exp_within_filt, cols=2)

#Apply different filters
sub_level_filter <- filter(d_within_test_df,
                           include_good_rt == 1, include_expo == 1,
                           condition_trial == "social")

trial_level_filter <- filter(d_within_test_df,
                             include_good_rt == 1, condition_trial == "social")


mss_expo_within_sub_lev <- sub_level_filter %>%
      group_by(condition, condition_trial, subids) %>%
      summarise(accuracy_exposure = mean(correct_exposure))

mss_expo_within_trial_lev <- trial_level_filter %>%
      group_by(condition, condition_trial, subids) %>%
      summarise(accuracy_exposure = mean(correct_exposure))


sub_hist <- qplot(accuracy_exposure, geom="bar",
                  facets=.~condition, data=mss_expo_within_sub_lev)

trial_hist <- qplot(accuracy_exposure, geom="bar",facets=.~condition, 
                    main = c("Histogram Acc Exposure (Schematic)"), 
                    data=mss_expo_within_trial_lev)

trial_hist
## stat_bin: binwidth defaulted to range/30. Use 'binwidth = x' to adjust this.
## stat_bin: binwidth defaulted to range/30. Use 'binwidth = x' to adjust this.

dss <- d_within_test_df %>% filter(include_good_rt == 1, 
                                   include_expo == 1, 
                                   condition_trial == "social") %>%
      group_by(condition, condition_trial, trial.num) %>%
      summarise(accuracy_exposure = mean(correct_exposure))

qplot(trial.num, accuracy_exposure, col=condition, facets=.~condition, 
      geom=c("point","line"),
      data=dss) +
      scale_y_continuous(limits=c(0,1))

Accuracy on test trials within subjects experiment

#Set up filters
inc.data.within_sub_level <- filter(d_within_test_df, include_good_rt == 1, include_expo == 1)

inc.data.within_trial_level <- filter(d_within_test_df, include_good_rt == 1 & 
                                            correct_exposure == TRUE & include_expo == 1 | 
                                            condition_trial == "no-social")

inc.data.within_unfilt <- filter(d_within_test_df, include_good_rt == 1)

Test accuracy computations with different filters.

##Subject level
ms_test_within_sub_level <- inc.data.within_sub_level %>%
      group_by(condition, condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_within_sub_level$condition <- factor(ms_test_within_sub_level$condition)
ms_test_within_sub_level$condition_trial <- factor(ms_test_within_sub_level$condition_trial, 
                                                   levels = c("social", "no-social"))

acc_test_within_blocks_sub_level <- ggplot(ms_test_within_sub_level, 
                                           aes(x=condition_trial, y=accuracy, 
                                               group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      facet_wrap(~condition) + 
      ggtitle("Within-subs Subject-level")

##Trial level
ms_test_within_trial_level <- inc.data.within_trial_level %>%
      group_by(condition, condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_within_trial_level$condition <- factor(ms_test_within_trial_level$condition)
ms_test_within_trial_level$condition_trial <- factor(ms_test_within_trial_level$condition_trial, 
                                                     levels = c("social", "no-social"))

acc_test_within_blocks_trial_level <- ggplot(ms_test_within_trial_level, 
                                             aes(x=condition_trial, y=accuracy, 
                                                 group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width=.1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      facet_wrap(~condition) + 
      ggtitle("Within-subs-Trial-Level")

##Unfiltered
ms_test_within_unfilt <- inc.data.within_unfilt %>%
      group_by(condition, condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_within_unfilt$condition <- factor(ms_test_within_unfilt$condition)
ms_test_within_unfilt$condition_trial <- factor(ms_test_within_unfilt$condition_trial, 
                                                levels = c("social", "no-social"))

acc_test_within_blocks_unfilt <- ggplot(ms_test_within_unfilt, 
                                        aes(x=condition_trial, y=accuracy, 
                                            group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      facet_wrap(~condition) + 
      ggtitle("Within-subs Unfiltered")

multiplot(acc_test_within_blocks_sub_level, acc_test_within_blocks_trial_level, 
          acc_test_within_blocks_unfilt, cols = 2)

Now do the same accuracy computation but collapse across blocks

#Computations 
ms_test_within_collapse <- inc.data.within_sub_level %>%
      group_by(condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_within_collapse_trial <- inc.data.within_trial_level %>%
      group_by(condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_within_collapse_unfilt <- inc.data.within_unfilt %>%
      group_by(condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))
#refactor things for plotting
ms_test_within_collapse$condition_trial <- factor(ms_test_within_collapse$condition_trial,
                                                  levels = c("social", "no-social"))

ms_test_within_collapse_trial$condition_trial <- factor(ms_test_within_collapse_trial$condition_trial,
                                                        levels = c("social", "no-social"))

ms_test_within_collapse_unfilt$condition_trial <- factor(ms_test_within_collapse_unfilt$condition_trial,
                                                         levels = c("social", "no-social"))

#now plot
acc_test_within_sub <- ggplot(ms_test_within_collapse, 
                              aes(x=condition_trial, y=accuracy, 
                                  group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Within-subs Subject Filter")

acc_test_within_trial <- ggplot(ms_test_within_collapse_trial, 
                                aes(x=condition_trial, y=accuracy, 
                                    group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Within-subs Trial Filter")

acc_test_within_unfilt <- ggplot(ms_test_within_collapse_unfilt, 
                                 aes(x=condition_trial, y=accuracy, 
                                     group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Within-subs Unfiltered")

multiplot(acc_test_within_sub, acc_test_within_trial, acc_test_within_unfilt, cols=2)

Model the within subs data
m1_within <- glmer(correct ~ trialType * condition_trial + (trialType | subids),
                   data = inc.data.within_trial_level,
                   family=binomial)
summary(m1_within)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ trialType * condition_trial + (trialType | subids)
##    Data: inc.data.within_trial_level
## 
##      AIC      BIC   logLik deviance df.resid 
##   3165.9   3208.4  -1575.9   3151.9     3208 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.4354 -0.6860  0.1653  0.5233  2.1257 
## 
## Random effects:
##  Groups Name            Variance Std.Dev. Corr 
##  subids (Intercept)     3.306    1.818         
##         trialTypeSwitch 2.326    1.525    -0.95
## Number of obs: 3215, groups:  subids, 253
## 
## Fixed effects:
##                                       Estimate Std. Error z value Pr(>|z|)
## (Intercept)                             2.9206     0.2307  12.659  < 2e-16
## trialTypeSwitch                        -2.9730     0.2316 -12.837  < 2e-16
## condition_trialsocial                   0.2487     0.1971   1.262    0.207
## trialTypeSwitch:condition_trialsocial  -0.9878     0.2265  -4.361  1.3e-05
##                                          
## (Intercept)                           ***
## trialTypeSwitch                       ***
## condition_trialsocial                    
## trialTypeSwitch:condition_trialsocial ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) trlTyS cndtn_
## trlTypSwtch -0.947              
## cndtn_trlsc -0.278  0.277       
## trlTypSwt:_  0.245 -0.326 -0.863
m1_within_unfilt <- glmer(correct ~ trialType * condition_trial + (trialType | subids),
                          data = inc.data.within_unfilt,
                          family=binomial)
summary(m1_within_unfilt)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ trialType * condition_trial + (trialType | subids)
##    Data: inc.data.within_unfilt
## 
##      AIC      BIC   logLik deviance df.resid 
##   3845.2   3889.0  -1915.6   3831.2     3852 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.1129 -0.7079  0.1636  0.5362  1.8630 
## 
## Random effects:
##  Groups Name            Variance Std.Dev. Corr 
##  subids (Intercept)     3.698    1.923         
##         trialTypeSwitch 2.707    1.645    -0.96
## Number of obs: 3859, groups:  subids, 253
## 
## Fixed effects:
##                                       Estimate Std. Error z value Pr(>|z|)
## (Intercept)                             2.9918     0.2256  13.259  < 2e-16
## trialTypeSwitch                        -3.0612     0.2268 -13.497  < 2e-16
## condition_trialsocial                   0.1079     0.1654   0.652  0.51418
## trialTypeSwitch:condition_trialsocial  -0.5340     0.1911  -2.794  0.00521
##                                          
## (Intercept)                           ***
## trialTypeSwitch                       ***
## condition_trialsocial                    
## trialTypeSwitch:condition_trialsocial ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) trlTyS cndtn_
## trlTypSwtch -0.943              
## cndtn_trlsc -0.346  0.344       
## trlTypSwt:_  0.300 -0.401 -0.865

Experiment #5 Within-subjects replication

Goal is to replicate the dip in accuracy on same trials in the no-social condition because this effect only came out in the first within-subs experiment.

Filter just trials from within-subjects replication experiment.

d_within_rep_df <- filter(d.all_df, experiment == "within_replication")

d_within_rep_df %>%
      group_by(condition) %>%
      summarise(n_subs = n_distinct(subids))
## Source: local data frame [2 x 2]
## 
##        condition n_subs
## 1 No-socialFirst     87
## 2    SocialFirst     84

Flag social vs. no-social trials

When we switched to within subjects, we tracked which block came first, but didn’t track social vs. no-social. So we create a column to track this information

d_within_rep_df <- d_within_rep_df %>%
      mutate(condition_trial = ifelse(condition == "No-socialFirst" 
                                      & trial.num <= 20, "no-social", 
                                      ifelse(condition == "SocialFirst" 
                                             & trial.num <= 20, "social", 
                                             ifelse(condition == "No-socialFirst" 
                                                    & trial.num >= 21, "social",
                                                    ifelse(condition == "SocialFirst" 
                                                           & trial.num >= 21, 
                                                           "no-social", NA)))))
#flag trial, if subs chose target of gaze
d_within_rep_expo_df <- d_within_rep_df %>%
      filter(exposure_trial == 1) %>%
      mutate(correct_exposure = faceIdx == chosenIdx) %>%
      select(subids, itemNum, correct_exposure)

#grab test trials
d_within_rep_test_df <- d_within_rep_df %>%
      filter(test_trial == 1)

#merge with test trials
d_within_rep_test_df <- join(d_within_rep_test_df, d_within_rep_expo_df, c("subids", "itemNum"))

Flag subs who got <25% of exposure trials correct. This can be used for exclusionary criteria in later analyses.

d_within_rep_test_df <- d_within_rep_test_df %>%
      filter(condition_trial == "social") %>%
      group_by(subids) %>%
      summarise(mean_acc_exp = mean(correct_exposure)) %>%
      mutate(include_expo = ifelse(mean_acc_exp > 0.25,1,0)) %>%
      join(d_within_rep_test_df, by = "subids")

Flag trials with extremely slow or fast RTs (+/- 2SD).

d_within_rep_test_df <- d_within_rep_test_df %>%
      mutate(include_good_rt = ifelse(log(rt) > mean(log(rt)) + 2 * sd(log(rt)) |
                                            log(rt) < mean(log(rt)) - 2 * sd(log(rt)),
                                      0,1))

Set up filters

d_within_expo_rep <- filter(d_within_rep_test_df,
                            include_good_rt == 1, 
                            condition_trial == "social")


d_within_expo_rep_filt <- filter(d_within_rep_test_df,
                                 include_good_rt == 1, include_expo == 1, 
                                 condition_trial == "social")

Get number of subjects filtered out by subject level filtering process

#get number of subjects filtered out
within_n_rep<- d_within_expo_rep %>%
      summarise(n_subs = n_distinct(subids))

within_n_filt_rep <- d_within_expo_rep_filt %>%
      summarise(n_subs_filt = n_distinct(subids)) %>%
      select(n_subs_filt)

cbind(within_n_rep, within_n_filt_rep)
##   n_subs n_subs_filt
## 1    171         135

Within subs replication: Accuracy on exposure trials

ms_expo_within_rep <-  d_within_expo_rep %>%
      group_by(condition, condition_trial) %>%
      summarise(accuracy_exposure = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure))

ms_expo_within_rep_filt <- d_within_expo_rep_filt %>%
      group_by(condition, condition_trial) %>%
      summarise(accuracy_exposure = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure))
#factor for plotting
ms_expo_within_rep$condition <- factor(ms_expo_within_rep$condition)
ms_expo_within_rep_filt$condition <- factor(ms_expo_within_rep_filt$condition)

acc_expo_within_rep <- ggplot(data=ms_expo_within_rep, 
                              aes(x=condition, y=accuracy_exposure,
                                  fill=condition)) + 
      geom_bar(stat="identity") +
      geom_pointrange(aes(ymin=accuracy_exposure-ci_low, 
                          ymax=accuracy_exposure+ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Within-subs Replication Unfiltered")

acc_expo_within_rep_filt <- ggplot(data=ms_expo_within_rep_filt, 
                                   aes(x=condition, y=accuracy_exposure,
                                       fill=condition)) + 
      geom_bar(stat="identity") +
      geom_pointrange(aes(ymin=accuracy_exposure-ci_low, 
                          ymax=accuracy_exposure+ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Within-subs Replication Filtered")

multiplot(acc_expo_within_rep, acc_expo_within_rep_filt, cols=2)

Accuracy on test trials within subjects experiment

#subject filter
inc.data.within_rep_sub_level <- filter(d_within_rep_test_df, include_good_rt == 1, include_expo == 1 & 
                                              correct_exposure == TRUE | condition_trial == "no-social")
#trial filter
inc.data.within_rep_trial_level <- filter(d_within_rep_test_df, include_good_rt == 1 & 
                                                correct_exposure == TRUE | condition_trial == "no-social")

#unfiltered
inc.data.within_rep_unfilt <- filter(d_within_rep_test_df, include_good_rt == 1)

#accuracy computations
ms_test_within_rep_sub_level <- inc.data.within_rep_sub_level %>%
      group_by(condition, condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_within_rep_sub_level$condition <- factor(ms_test_within_rep_sub_level$condition)
ms_test_within_rep_sub_level$condition_trial <- factor(ms_test_within_rep_sub_level$condition_trial, 
                                                       levels = c("social", "no-social"))

acc_test_within_rep_blocks_sub_level <- ggplot(ms_test_within_rep_sub_level, 
                                               aes(x=condition_trial, y=accuracy, 
                                                   group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      facet_wrap(~condition) + 
      ggtitle("Within-subs Replication Subject Level")

ms_test_within_rep_trial_level <- inc.data.within_rep_trial_level %>%
      group_by(condition, condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_within_rep_trial_level$condition <- factor(ms_test_within_rep_trial_level$condition)
ms_test_within_rep_trial_level$condition_trial <- factor(ms_test_within_rep_trial_level$condition_trial, 
                                                         levels = c("social", "no-social"))

acc_test_within_rep_blocks_trial_level <- ggplot(ms_test_within_rep_trial_level, 
                                                 aes(x=condition_trial, y=accuracy, 
                                                     group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      facet_wrap(~condition) + 
      ggtitle("Within-subs Replication blocks")

multiplot(acc_test_within_rep_blocks_sub_level, acc_test_within_rep_blocks_trial_level)

Now do the same accuracy computation but collapse across blocks

ms_test_within_rep_collapse_sub <- inc.data.within_rep_sub_level %>%
      group_by(condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_within_rep_collapse_trial <- inc.data.within_rep_trial_level %>%
      group_by(condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ms_test_within_rep_collapse_unfilt <- inc.data.within_rep_unfilt %>%
      group_by(condition_trial, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))



ms_test_within_rep_collapse_sub$condition_trial <- factor(ms_test_within_rep_collapse_sub$condition_trial,
                                                          levels = c("social", "no-social"))
ms_test_within_rep_collapse_trial$condition_trial <- factor(ms_test_within_rep_collapse_trial$condition_trial,
                                                            levels = c("social", "no-social"))
ms_test_within_rep_collapse_unfilt$condition_trial <- factor(ms_test_within_rep_collapse_unfilt$condition_trial,
                                                             levels = c("social", "no-social"))

# subject filter
acc_test_within_rep_sub <- ggplot(ms_test_within_rep_collapse_sub, 
                                  aes(x=condition_trial, y=accuracy, 
                                      group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Within-subs Replication Sub-level")
# trial filter
acc_test_within_rep_trial <- ggplot(ms_test_within_rep_collapse_trial, 
                                    aes(x=condition_trial, y=accuracy, 
                                        group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Within-subs Replication Trial-level")

#unfiltered
acc_test_within_rep_unfilt <- ggplot(ms_test_within_rep_collapse_unfilt, 
                                     aes(x=condition_trial, y=accuracy, 
                                         group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Within-subs Replication Unfiltered")


multiplot(acc_test_within_rep_sub, acc_test_within_rep_trial, acc_test_within_rep_unfilt, cols=2)

Now model the within subs replication data

m1_within_rep <- glmer(correct ~ trialType * condition_trial + (trialType | subids),
                       data = inc.data.within_rep_sub_level,
                       family=binomial)
summary(m1_within_rep)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ trialType * condition_trial + (trialType | subids)
##    Data: inc.data.within_rep_sub_level
## 
##      AIC      BIC   logLik deviance df.resid 
##   2156.8   2196.5  -1071.4   2142.8     2156 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.0776 -0.7104  0.1595  0.5598  1.8998 
## 
## Random effects:
##  Groups Name            Variance Std.Dev. Corr 
##  subids (Intercept)     3.868    1.967         
##         trialTypeSwitch 2.840    1.685    -0.98
## Number of obs: 2163, groups:  subids, 171
## 
## Fixed effects:
##                                       Estimate Std. Error z value Pr(>|z|)
## (Intercept)                            3.14581    0.31578   9.962   <2e-16
## trialTypeSwitch                       -3.18187    0.31627 -10.061   <2e-16
## condition_trialsocial                  0.02114    0.23646   0.089   0.9288
## trialTypeSwitch:condition_trialsocial -0.67835    0.26950  -2.517   0.0118
##                                          
## (Intercept)                           ***
## trialTypeSwitch                       ***
## condition_trialsocial                    
## trialTypeSwitch:condition_trialsocial *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) trlTyS cndtn_
## trlTypSwtch -0.963              
## cndtn_trlsc -0.299  0.299       
## trlTypSwt:_  0.265 -0.339 -0.872
m1_within_rep_unfilt <- glmer(correct ~ trialType * condition_trial + (trialType | subids),
                              data = inc.data.within_rep_unfilt,
                              family=binomial)
summary(m1_within_rep_unfilt)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ trialType * condition_trial + (trialType | subids)
##    Data: inc.data.within_rep_unfilt
## 
##      AIC      BIC   logLik deviance df.resid 
##   2619.3   2660.4  -1302.7   2605.3     2608 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.0585 -0.7453  0.1643  0.6503  1.7956 
## 
## Random effects:
##  Groups Name            Variance Std.Dev. Corr 
##  subids (Intercept)     3.820    1.954         
##         trialTypeSwitch 2.766    1.663    -0.98
## Number of obs: 2615, groups:  subids, 171
## 
## Fixed effects:
##                                       Estimate Std. Error z value Pr(>|z|)
## (Intercept)                            3.12431    0.28614  10.919   <2e-16
## trialTypeSwitch                       -3.16062    0.28645 -11.034   <2e-16
## condition_trialsocial                 -0.06805    0.20144  -0.338    0.736
## trialTypeSwitch:condition_trialsocial -0.37105    0.23168  -1.602    0.109
##                                          
## (Intercept)                           ***
## trialTypeSwitch                       ***
## condition_trialsocial                    
## trialTypeSwitch:condition_trialsocial    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) trlTyS cndtn_
## trlTypSwtch -0.954              
## cndtn_trlsc -0.373  0.373       
## trlTypSwt:_  0.325 -0.420 -0.870

Experiment #6 Noisy Channel

Our goal is to see if a super short (“noisy channel”) gaze cue will result in intermediate accuracy performance on switch trials, between social and no-social.

We used a between subjects design with three conditions: Social-short, Social-noisy, No-social.Note, we might want to run this again using a within subjects design.

Grab noisy channel data

d.noisy <- filter(d.test_df, experiment == "noisy_channel")

Get number of subjects by condition

d.noisy %>%
      group_by(experiment, condition, gazeLength) %>%
      summarise(n_subs = n_distinct(subids))
## Source: local data frame [3 x 4]
## Groups: experiment, condition
## 
##      experiment condition gazeLength n_subs
## 1 noisy_channel No-social      Short     91
## 2 noisy_channel    Social      Noisy     91
## 3 noisy_channel    Social      Short     92

Analyze performance on exposure trials

ms_exp_noisy <- d.noisy %>%
      filter(condition != "No-social") %>%
      group_by(condition, gazeLength) %>%
      summarise(accuracy_exposure = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure))

noisy_acc_exp <- ggplot(data=ms_exp_noisy, 
                        aes(x=gazeLength, y=accuracy_exposure,
                            fill=gazeLength)) + 
      geom_bar(stat="identity") +
      geom_pointrange(aes(ymin=accuracy_exposure-ci_low, 
                          ymax=accuracy_exposure+ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Unfiltered")

Set up filters. We remove subjects who performed worse than chance on exposure trials and any other trials on which subjects didn’t choose the target of eye gaze.

d.noisy.filt <- filter(d.noisy,include_good_rt == 1, 
                       include_expo == 1 & correct_exposure == T | 
                             condition == "No-social")

Analyze accuracy on test trials for filtered dataset.

ms_test_noisy <- d.noisy.filt %>%
      group_by(gazeLength, condition, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))


#create new condition column for plotting
ms_test_noisy <- ms_test_noisy %>%
      mutate(condition_full = paste(gazeLength, condition, sep="-"))

#change factor levels for plotting 
ms_test_noisy$condition_full <- factor(ms_test_noisy$condition_full, 
                                       levels = c("Short-Social", "Noisy-Social", "Short-No-social"))

acc.test.noisy <- ggplot(ms_test_noisy, aes(x=condition_full, y=accuracy, 
                                            group=trialType, colour=trialType)) +
      geom_point(size=2) +
      geom_line() +
      geom_pointrange(aes(ymin=accuracy - ci_low,
                          ymax=accuracy + ci_high), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      ggtitle("Noisy Channel Test accuracy")

This vs. One Experiment

Filter this experiment

d.this.one <- filter(d.all_df,  experiment == "this_one")

Replot fyp data

read_path_fyp <- file.path("/Users", "kmacdonald", "Documents", 
                           "Projects", "SOC_XSIT", "processed_data", 
                           "adult-fyp/")

d_fyp_df <- tbl_df(read.csv(paste(read_path_fyp,
                                  "aggregate_soc_xsit.csv", sep="")))

d_fyp_df$condition <- factor(d_fyp_df$condition, 
                             levels = c("Social", "No-Social"))

acc_test_fyp <- ggplot(data=filter(d_fyp_df, intervalNum==0, numPicN==4),
                       aes(x=condition, y=correct, colour=trialType, group=trialType)) +
      geom_point(size = 2.5) +
      geom_line() +
      geom_pointrange(aes(ymin=correct - corr.cil,
                          ymax=correct + corr.cih), width = .1) +
      geom_hline(yintercept=0.25, linetype = "dashed") +
      scale_y_continuous(limits=c(0,1)) +
      xlab("Condition") +
      ylab("Proportion Correct") +
      labs(colour = "Trial Type") +
      scale_colour_manual(values=c("firebrick1", "dodgerblue")) +
      theme(text = element_text(size=20))

Plot all accuracy data together using subject-level filter (FYP data, Between-subs design, Within-subs design)

  • Removing subjects who got less than 25% correct on exp
multiplot(acc_test_fyp, acc_test_btw_filt, acc_test_within_blocks_sub_level, acc_test_within_rep_blocks_sub_level, acc_test_within_sub, acc_test_within_rep_sub, cols=3)

Plot all accuracy data together using trial-level filter (FYP data, Between-subs design, Within-subs design)

  • Removing trials on which subjects didn’t select the target of eye gaze
multiplot(acc_test_within_blocks_trial_level, acc_test_within_rep_blocks_trial_level, 
          acc_test_within_trial, acc_test_within_rep_trial, cols=2)

Plot all accuracy data together without filtering

multiplot(acc_test_btw, acc_test_within_blocks_unfilt, 
          acc_test_within_unfilt, acc_test_within_rep_unfilt, cols=2)