Script to analyze Soc-Xsit reliablity experiment

rm(list=ls())

Load libraries.

source("/Users/kmacdonald/Documents/programming/rscripts/useful.R")
library(reshape2)
library(plyr)
library(dplyr)
library(bootstrap)
library(lme4)
library(ggplot2)

Set directory and read in data.

Get the number of subjects in each experiment and condition.

## Source: local data frame [5 x 2]
## 
##   prop_cond_clean n_subs
## 1     0% Reliable     53
## 2    25% Reliable     47
## 3    50% Reliable     49
## 4    75% Reliable     48
## 5   100% Reliable     49

Filters and exclusionary criteria

# remove trials with 0 RT
df_reliability <- filter(df_reliability, rt > 0)

# clean RTs
df_reliability <- df_reliability %>%
    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))

# Create continuous variable for reliability
df_reliability$reliability[df_reliability$prop_cond_clean=="0% Reliable"] <- .00
df_reliability$reliability[df_reliability$prop_cond_clean=="25 Reliable"] <- .25
df_reliability$reliability[df_reliability$prop_cond_clean=="50% Reliable"] <- .50
df_reliability$reliability[df_reliability$prop_cond_clean=="75% Reliable"] <- .75
df_reliability$reliability[df_reliability$prop_cond_clean=="100% Reliable"] <- 1.00

Set up filters. First for exposure trials:

# all test trials
df_expo_all <- df_reliability %>% 
    filter(trial_category == "exposure",
           include_good_rt == 1)

# test trials in the familiarization block
df_expo_fam <- df_reliability %>%
    filter(trial_category == "exposure" & 
               block == "familiarization",
           include_good_rt == 1)

# test trials in the test block
df_expo_test <- df_reliability %>% 
    filter(trial_category == "exposure" & 
               block == "test",
           include_good_rt == 1)

Test trials:

# all test trials
df_test_all <- df_reliability %>% 
    filter(trial_category == "test",
           include_good_rt == 1)

# test trials in the familiarization block
df_test_fam <- df_reliability %>%
    filter(trial_category == "test" & 
               block == "familiarization",
           include_good_rt == 1)

# test trials in the test block
df_test_test <- df_reliability %>% 
    filter(trial_category == "test" & 
               block == "test",
           include_good_rt == 1)

Here we add whether participant chose the target of eye gaze on exposure trials in the test block.

df_correct_expo_test <- df_expo_test %>%
    select(subids, gaze_target, chosen, 
           correct_exposure = correct, itemNum) 

df_test_test <- merge(df_test_test, df_correct_expo_test, 
                          by=c("subids", "itemNum"))

Now we can add a filter that excludes those test trials on which the participant did not choose the target of eye gaze on exposure trials.

df_test_test_filt <- filter(df_test_test, correct_exposure == T)

Analyze Familiarization Block

RT on exposure trials.

ms_rt_expo_fam <- df_expo_fam %>%
    group_by(prop_cond_clean) %>%
    summarise(rt_exposure = mean(rt),
              ci_low = ci.low(rt),
              ci_high = ci.high(rt))

ggplot(ms_rt_expo_fam, 
       aes(x=prop_cond_clean, y=rt_exposure)) +
    geom_pointrange(aes(ymin=rt_exposure - ci_low,
                        ymax=rt_exposure + ci_high), 
                    width = .1, size = 0.8) + 
    scale_y_continuous(limits=c(500,4000)) +
    ylab("Response Time (ms)") +
    xlab("Level of Reliability") +
    theme(text = element_text(size=16),
          axis.text.x  = element_text(angle=0, vjust=0.5, size=12))

Test trials accuracy

ms_test_fam <- df_test_fam %>%
      group_by(prop_cond_clean, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ggplot(ms_test_fam, 
       aes(x=prop_cond_clean, y=accuracy, 
           group=trialType, colour=trialType)) +
    geom_pointrange(aes(ymin=accuracy - ci_low,
                        ymax=accuracy + ci_high), 
                    width = .1, size=0.7) +
    geom_hline(yintercept=0.5, linetype = "dashed") +
    scale_y_continuous(limits=c(0,1)) + 
    ggtitle("Accuracy on Test Trials in Familiarization Block")

Look at accuracy on familiarization test trials over time.

ms_test_fam_trials <- df_test_fam %>%
      group_by(prop_cond_clean, trialType, itemNum) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ggplot(ms_test_fam_trials, 
       aes(x=itemNum, y=accuracy, color = trialType)) +
    geom_line() +
    geom_pointrange(aes(ymin=accuracy - ci_low,
                        ymax=accuracy + ci_high), 
                    width = .1, size=0.7) +
    facet_wrap(~prop_cond_clean) +    
    geom_hline(yintercept=0.5, linetype = "dashed") +
    scale_y_continuous(limits=c(0,1)) + 
    ggtitle("Accuracy on Test Trials during Familiarization Trials")

Analyze performance on test block

Anayze RT on exposure trials in the test block.

ms_rt_expo_test <- df_expo_test %>%
    group_by(prop_cond_clean, trialType) %>%
    summarise(rt_exposure = mean(rt),
              ci_low = ci.low(rt),
              ci_high = ci.high(rt))

ggplot(ms_rt_expo_test, 
       aes(x=prop_cond_clean, y=rt_exposure, color = trialType)) +
    geom_pointrange(aes(ymin=rt_exposure - ci_low,
                        ymax=rt_exposure + ci_high), 
                    width = .1, size = 0.8) + 
    scale_y_continuous(limits=c(500,4000)) +
    ylab("Response Time (ms)") +
    xlab("Condition") +
    theme(text = element_text(size=14))

Accuracy on familiarization trials in test block

ms_expo_test <- df_test_test %>%
      group_by(prop_cond_clean) %>%
      summarise(accuracy = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure))

ggplot(ms_expo_test, 
       aes(x=prop_cond_clean, y=accuracy)) +
    geom_line(size=0.7) +
    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)) +
    xlab("Level of Reliablity") + 
    ylab("Prop. Chose Target of Gaze") +
    labs(colour = "Trial Type") +
    theme(text = element_text(size=16))
## geom_path: Each group consist of only one observation. Do you need to adjust the group aesthetic?

Accuracy on exposure trials in test block for each subject.

ss_expo_test <- df_test_test %>%
      group_by(prop_cond_clean, subids) %>%
      summarise(accuracy = mean(correct_exposure),
                ci_low = ci.low(correct_exposure),
                ci_high = ci.high(correct_exposure))

qplot(accuracy, data = ss_expo_test, facets = ~ prop_cond_clean)
## 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.
## 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.
## stat_bin: binwidth defaulted to range/30. Use 'binwidth = x' to adjust this.

Accuracy on test trials in the test block

ms_test_test <- df_test_test %>%
      group_by(prop_cond_clean, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ggplot(ms_test_test, 
       aes(x=prop_cond_clean, y=accuracy, 
           group=trialType, colour=trialType)) +
    geom_point(size=2.5) +
    geom_line(size=0.7) +
    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)) +
    scale_colour_manual(values=c("firebrick1", "dodgerblue")) +
    xlab("Level of Reliablity") + 
    ylab("Prop. Choosing Repeated Referent") +
    labs(colour = "Trial Type") +
    theme(text = element_text(size=16))

Now look at accuracy over test trials in the test block

ms_test_trials <- df_test_test %>%
      group_by(prop_cond_clean, trialType, itemNum) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ggplot(ms_test_trials, 
       aes(x=itemNum, y=accuracy, 
           colour=prop_cond_clean,
           linetype=trialType)) +
    geom_line(size = 0.8) +
    geom_pointrange(aes(ymin=accuracy - ci_low,
                        ymax=accuracy + ci_high), 
                    width=.1, size = 0.7) +
    geom_hline(yintercept=0.25, linetype = "dashed") +
    scale_y_continuous(limits=c(0,1)) +
    xlab("Trial Number") + 
    ylab("Proportion Correct") +
    labs(colour = "Condition", linetype = "Trial Type") +
    theme(text = element_text(size=16))

Plot accuracy on test trials in test block, filtering out trials on which participant did not choose target of gaze.

ms_test_test_filt <- df_test_test_filt %>%
      group_by(prop_cond_clean, trialType) %>%
      summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

ggplot(ms_test_test_filt, 
       aes(x=prop_cond_clean, y=accuracy, 
           group=trialType, colour=trialType)) +
    geom_point(size=2.5) +
    geom_line(size=0.7) +
    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)) +
    scale_colour_manual(values=c("firebrick1", "dodgerblue")) +
    xlab("Level of Reliablity") + 
    ylab("Prop. Choosing Repeated Referent") +
    labs(colour = "Trial Type") +
    theme(text = element_text(size=16))

Look at individual subs accuracy

ss_test <- df_test_test %>%
    group_by(subids, trialType, prop_cond_clean) %>%
    summarise(accuracy = mean(correct),
                ci_low = ci.low(correct),
                ci_high = ci.high(correct))

qplot(accuracy, geom="bar", facets=trialType~prop_cond_clean, 
      main = c("Histogram Acc Test"), data=ss_test)
## 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.
## 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.
## 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.
## 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.
## 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.

Boxplot accuracy on test

qplot(prop_cond_clean, accuracy, data=ss_test, geom=c("boxplot", "jitter"), 
   fill=prop_cond_clean) + facet_grid(~trialType)

Model test performance

# reliablity as factor
m1 <- glmer(correct ~ trialType * prop_cond_clean +
                              (trialType | subids),
            data = df_test_test, nAGQ = 0,
            family = binomial)
summary(m1)
## Generalized linear mixed model fit by maximum likelihood (Adaptive
##   Gauss-Hermite Quadrature, nAGQ = 0) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ trialType * prop_cond_clean + (trialType | subids)
##    Data: df_test_test
## 
##      AIC      BIC   logLik deviance df.resid 
##   1788.4   1859.9   -881.2   1762.4     1790 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.6750 -0.6742  0.2078  0.4996  1.8621 
## 
## Random effects:
##  Groups Name            Variance Std.Dev. Corr 
##  subids (Intercept)     3.022    1.739         
##         trialTypeSwitch 2.490    1.578    -0.89
## Number of obs: 1803, groups:  subids, 246
## 
## Fixed effects:
##                                              Estimate Std. Error z value
## (Intercept)                                    2.5971     0.3735   6.953
## trialTypeSwitch                               -2.6163     0.3889  -6.727
## prop_cond_clean25% Reliable                    0.0467     0.5541   0.084
## prop_cond_clean50% Reliable                   -0.6923     0.5190  -1.334
## prop_cond_clean75% Reliable                    0.3905     0.5732   0.681
## prop_cond_clean100% Reliable                  -0.1553     0.5357  -0.290
## trialTypeSwitch:prop_cond_clean25% Reliable   -0.4027     0.5764  -0.699
## trialTypeSwitch:prop_cond_clean50% Reliable    0.5330     0.5433   0.981
## trialTypeSwitch:prop_cond_clean75% Reliable   -0.5009     0.5938  -0.844
## trialTypeSwitch:prop_cond_clean100% Reliable  -0.6571     0.5619  -1.170
##                                              Pr(>|z|)    
## (Intercept)                                  3.57e-12 ***
## trialTypeSwitch                              1.73e-11 ***
## prop_cond_clean25% Reliable                     0.933    
## prop_cond_clean50% Reliable                     0.182    
## prop_cond_clean75% Reliable                     0.496    
## prop_cond_clean100% Reliable                    0.772    
## trialTypeSwitch:prop_cond_clean25% Reliable     0.485    
## trialTypeSwitch:prop_cond_clean50% Reliable     0.327    
## trialTypeSwitch:prop_cond_clean75% Reliable     0.399    
## trialTypeSwitch:prop_cond_clean100% Reliable    0.242    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) trlTyS p__25R p__50R p__75R p__10R tTS:__2R tTS:__5R
## trlTypSwtch -0.885                                                     
## prp_cn_25%R -0.674  0.597                                              
## prp_cn_50%R -0.720  0.637  0.485                                       
## prp_cn_75%R -0.652  0.577  0.439  0.469                                
## prp_c_100%R -0.697  0.617  0.470  0.502  0.454                         
## trTS:__25%R  0.597 -0.675 -0.889 -0.430 -0.389 -0.416                  
## trTS:__50%R  0.634 -0.716 -0.427 -0.875 -0.413 -0.442  0.483           
## trTS:__75%R  0.580 -0.655 -0.391 -0.417 -0.898 -0.404  0.442    0.469  
## tTS:__100%R  0.613 -0.692 -0.413 -0.441 -0.399 -0.879  0.467    0.496  
##             tTS:__7R
## trlTypSwtch         
## prp_cn_25%R         
## prp_cn_50%R         
## prp_cn_75%R         
## prp_c_100%R         
## trTS:__25%R         
## trTS:__50%R         
## trTS:__75%R         
## tTS:__100%R  0.453
# # reliablity as continuous 
m2 <- glmer(correct ~ trialType * reliability +
                              (trialType | subids),
            data = df_test_test_filt, 
            family = binomial)
summary(m2)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ trialType * reliability + (trialType | subids)
##    Data: df_test_test_filt
## 
##      AIC      BIC   logLik deviance df.resid 
##    909.3    943.3   -447.7    895.3      937 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.5900 -0.5217  0.1410  0.3861  1.7466 
## 
## Random effects:
##  Groups Name            Variance Std.Dev. Corr 
##  subids (Intercept)     4.101    2.025         
##         trialTypeSwitch 4.059    2.015    -0.86
## Number of obs: 944, groups:  subids, 189
## 
## Fixed effects:
##                             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                   3.2293     0.8993   3.591 0.000329 ***
## trialTypeSwitch              -3.6680     0.9215  -3.981 6.87e-05 ***
## reliability                   0.3440     0.6987   0.492 0.622457    
## trialTypeSwitch:reliability  -0.7553     0.7520  -1.004 0.315140    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) trlTyS rlblty
## trlTypSwtch -0.964              
## reliability -0.345  0.316       
## trlTypSwtc:  0.301 -0.378 -0.883