Soc-Xsit Analysis and Vizualizations

Clear workspace and set working directory

## Loading required package: Matrix
## 
## Attaching package: 'Matrix'
## 
## The following objects are masked from 'package:base':
## 
##     crossprod, tcrossprod
## 
## Loading required package: Rcpp
## 
## Attaching package: 'dplyr'
## 
## The following objects are masked from 'package:plyr':
## 
##     arrange, count, desc, failwith, id, mutate, rename, summarise,
##     summarize
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
## 
## Loading required package: quadprog

Read in data from all 3 Experiments:

Large scale experiment manipulating attention and memory demands
Replication of Experiment 1 with more ecologically valid stimulus set
Parametric manipulation of cue reliablity

Experiment 1

Get the number of subjects in each condition.

nsubs <- df_expt1 %>% group_by(condition, intervalNum, numPicN) %>% summarise(n_subs = n_distinct(subids))

pandoc.table(nsubs, style = "rmarkdown")

## 
## 
## |  condition  |  intervalNum  |  numPicN  |  n_subs  |
## |:-----------:|:-------------:|:---------:|:--------:|
## |  No-Social  |       0       |     2     |   127    |
## |  No-Social  |       0       |     4     |   114    |
## |  No-Social  |       0       |     6     |    39    |
## |  No-Social  |       0       |     8     |   117    |
## |  No-Social  |       1       |     2     |   120    |
## |  No-Social  |       1       |     4     |   118    |
## |  No-Social  |       1       |     6     |    35    |
## |  No-Social  |       1       |     8     |   114    |
## |  No-Social  |       3       |     2     |   115    |
## |  No-Social  |       3       |     4     |   117    |
## |  No-Social  |       3       |     6     |    36    |
## |  No-Social  |       3       |     8     |   114    |
## |  No-Social  |       7       |     2     |   129    |
## |  No-Social  |       7       |     4     |   115    |
## |  No-Social  |       7       |     6     |    34    |
## |  No-Social  |       7       |     8     |   114    |
## |   Social    |       0       |     2     |    48    |
## |   Social    |       0       |     4     |    82    |
## |   Social    |       0       |     6     |    37    |
## |   Social    |       0       |     8     |    43    |
## |   Social    |       1       |     2     |    44    |
## |   Social    |       1       |     4     |    88    |
## |   Social    |       1       |     6     |    44    |
## |   Social    |       1       |     8     |    44    |
## |   Social    |       3       |     2     |    47    |
## |   Social    |       3       |     4     |    87    |
## |   Social    |       3       |     6     |    40    |
## |   Social    |       3       |     8     |    43    |
## |   Social    |       7       |     2     |    47    |
## |   Social    |       7       |     4     |    90    |
## |   Social    |       7       |     6     |    38    |
## |   Social    |       7       |     8     |    38    |

Do some minor data cleaning and create variables

Flag trials on which subs chose the target of eye gaze.

df_expo_expt1 <- df_expt1 %>%
    filter(exposureTrial == 1) %>%
    mutate(correct_exposure = ifelse(numPic == 6, 
                                     chosenIdx == faceIdx6,
                                     chosenIdx == faceIdx)) %>%
    select(subids, itemNum, correct_exposure)

Get test trials and merge with exposure trial information.

df_test_expt1 <- df_expt1 %>% filter(testTrial == 1)
df_test_expt1 <- join(df_expo_expt1, df_test_expt1, type = "full")

## Joining by: subids, itemNum

Flag subs in the social condition who performed worse than chance on exposure trials.

df_test_expt1 <- df_test_expt1 %>%
    filter(condition == "Social") %>%
    group_by(subids, numPic) %>%
    summarise(mean_acc_exp = mean(correct_exposure)) %>%
    mutate(include_expo = ifelse(numPic == 2 & mean_acc_exp > 0.5, 1, 
                                 ifelse(numPic == 4 & mean_acc_exp > 0.25, 1,
                                        ifelse(numPic == 6 & mean_acc_exp > 0.17, 1, 
                                               ifelse(numPic == 8 & mean_acc_exp > 0.125, 1, 
                                                      0))))) %>%
    join(df_test_expt1, by = "subids", type = "full")

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

df_test_expt1 <- df_test_expt1 %>%
    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))

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

df_expo_expt1_analysis <- df_expt1 %>% 
    filter(exposureTrial == 1, rt > 0) %>%
    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)) %>%
    filter(include_good_rt == 1)

Set up filters

Get test trials for analysis. Here we have 2 filters:

Remove fast/slow RTs
Remove fast/slow RTs & subjects who performed below chance selecting gaze target on exposure trials

# just RT filter
df_test_expt1 <- df_test_expt1 %>% 
    filter(include_good_rt == 1)

# subject and trial level filter
df_test_expt1_filt <- df_test_expt1 %>% 
    filter(include_good_rt == 1, include_expo == 1 | condition == "No-Social") %>%
    filter(correct_exposure == T | condition == "No-Social")

Get the number of subjects filtered out

df_n <- df_test_expt1 %>%
    group_by(condition) %>%
    summarise(n_subs = n_distinct(subids))

df_n_filt <- df_test_expt1_filt %>%
    group_by(condition) %>%
    summarise(n_subs_filt = n_distinct(subids)) %>%
    select(n_subs_filt)

df_n <- cbind(df_n, df_n_filt)

df_n

##   condition n_subs n_subs_filt
## 1 No-Social   1557        1557
## 2    Social    860         770

Accuracy on exposure trials in social condition

Get means and CIs for each combination of number of referents and interval

ms_expo_expt1 <-  df_test_expt1 %>%
    filter(condition == "Social") %>%
    group_by(numPic, intervalNum) %>%
    summarise(accuracy_exposure = mean(correct_exposure),
              ci_low = ci.low(correct_exposure),
              ci_high = ci.high(correct_exposure))

Now plot those means.

RT on exposure trials

Next we compare reaction times across social/no-social at different levels of attention and memory demands.

ms_expo_rt_expt1 <-  df_expo_expt1_analysis %>%
    group_by(numPic, intervalNum, condition) %>%
    summarise(mean_rt = mean(rt),
              ci_low = ci.low(rt),
              ci_high = ci.high(rt))

Now we plot mean reaction times for each condition.

## Warning: Removed 1 rows containing missing values (geom_segment).

## Warning: Removed 1 rows containing missing values (geom_segment).

Accuracy on test trials

First we aggregate for both unfiltered and filtered data.

ms_test_expt1 <- df_test_expt1  %>%
    group_by(condition, intervalNum, numPic, trialType) %>%
    summarise(accuracy = mean(correct),
              ci_low = ci.low(correct),
              ci_high = ci.high(correct),
              exclusionary_criteria = "none")

ms_test_filt_expt1 <- df_test_expt1_filt  %>%
    group_by(condition, intervalNum, numPic, trialType) %>%
    summarise(accuracy = mean(correct),
              ci_low = ci.low(correct),
              ci_high = ci.high(correct),
              exclusionary_criteria = "Subject and Trial level")

ms_test_all_expt1 <- rbind(ms_test_expt1, ms_test_filt_expt1)

Now we plot the both the filtered and unfiltered means.

LMERs

Predicting RT on exposure trials.

m1_rt_expt1 <- lmer(rt ~ condition * log2(intervalNum + 1) * log2(numPicN) + 
                  (1|subids), data=df_expo_expt1_analysis)

Predict accuracy on test trials.

# 2-way model
m1_2way_expt1 <- glmer(correct ~ (trialType + condition + 
                                      log2(intervalNum + 1) + log2(numPicN))^2 + 
                           (trialType | subids), 
                       data=df_test_expt1_filt, family=binomial, nAGQ=0)

# 3-way model
m1_3way_expt1 <- glmer(correct ~ (trialType + condition + 
                                      log2(intervalNum + 1) + log2(numPicN))^3 + 
                           (trialType | subids), 
                       data=df_test_expt1_filt, family=binomial, nAGQ=0)


# 4-way model
m1_4way_expt1 <- glmer(correct ~ (trialType + condition + 
                                      log2(intervalNum + 1) + log2(numPicN))^4 + 
                           (trialType | subids), 
                       data=df_test_expt1_filt, family=binomial, nAGQ=0)


# model comparison
model_comp <- anova( m1_2way_expt1, m1_3way_expt1, m1_4way_expt1)

pandoc.table(model_comp, style="rmarkdown")

## 
## 
## |       &nbsp;        |  Df  |  AIC  |  BIC  |  logLik  |  deviance  |
## |:-------------------:|:----:|:-----:|:-----:|:--------:|:----------:|
## |  **m1_2way_expt1**  |  14  | 17219 | 17328 |  -8595   |   17191    |
## |  **m1_3way_expt1**  |  18  | 17211 | 17351 |  -8588   |   17175    |
## |  **m1_4way_expt1**  |  19  | 17213 | 17361 |  -8588   |   17175    |
## 
## Table: Table continues below
## 
##  
## 
## |       &nbsp;        |  Chisq  |  Chi Df  |  Pr(>Chisq)  |
## |:-------------------:|:-------:|:--------:|:------------:|
## |  **m1_2way_expt1**  |   NA    |    NA    |      NA      |
## |  **m1_3way_expt1**  |  15.44  |    4     |   0.003878   |
## |  **m1_4way_expt1**  | 0.1762  |    1     |    0.6747    |

3-way model is best based on model comparison.

Compare the 3-way model for filtered and unfiltered data.

# 2-way model unfiltered
m1_2way_expt1_unfilt <- glmer(correct ~ (trialType + condition + 
                                      log2(intervalNum + 1) + log2(numPicN))^2 + 
                           (trialType | subids), 
                       data=df_test_expt1, family=binomial, nAGQ=0)

# 3-way model unfiltered
m1_3way_expt1_unfilt <- glmer(correct ~ (trialType + condition + 
                                      log2(intervalNum + 1) + log2(numPicN))^3 + 
                           (trialType | subids), 
                       data=df_test_expt1, family=binomial, nAGQ=0)

Experiment 2: Replication with ecologically valid stimulus set

In Experiment 2, we chose a subset of the referent/interval conditions: numPic = 4, and interval = 0 and 3.

Get the number of subjects in each condition.

df_expt2 %>% 
    group_by(condition, interval) %>%
    summarise(n_subs = n_distinct(subids))

## Source: local data frame [4 x 3]
## Groups: condition
## 
##        condition interval n_subs
## 1 No-socialFirst    Three     90
## 2 No-socialFirst     Zero     92
## 3    SocialFirst    Three     92
## 4    SocialFirst     Zero     93

Minor data cleaning, variable creation, and filters

Create variable to track experiment block.

df_expt2 <- df_expt2 %>%
    mutate(block = ifelse(itemNum <= 7, "first","second"))

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

df_expt2 <- df_expt2 %>%
    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))

Flag social vs. no-social trials

Create a variable to track the condition for each trial.

df_expt2 <- df_expt2 %>%
      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 subs who got <25% of exposure trials correct.

ss_exposure <- df_expt2 %>%
      filter(trial_cat == "exposure" & condition_trial == "social") %>%
      group_by(subids) %>%
      summarise(mean_acc_exp = mean(correct))

# Merge mean acc with the rest of the dataset.
df_expt2 <- merge(df_expt2, ss_exposure, by = "subids")

Flag test trials on which subject chose target of gaze on exposure

df_expt2 <- df_expt2 %>%
    filter(trial_cat == "exposure") %>%
    mutate(correct_exposure = faceIdx == chosenIdx,
             rt_exposure = rt) %>%
    select(subids, itemNum, correct_exposure, rt_exposure) %>%
    merge(df_expt2, by = c("subids", "itemNum"))

Set up filters

Exposure trials.

# just RT filter
df_expo_expt2 <- filter(df_expt2,
                      include_good_rt == 1,
                      condition_trial == "social",
                      trial_cat == "exposure")

# RT, subject level and trial level filter 
df_expo_expt2_filt <- filter(df_expt2,
                           trial_cat == "exposure",
                           condition_trial == "social" & mean_acc_exp > 0.25,
                           include_good_rt == 1)

# filter that gets both social/no-social trials
df_expo_expt2_analysis <- df_expt2 %>%
    filter(trial_cat == "exposure",
           mean_acc_exp > 0.25,
           correct_exposure = T | condition_trial == "no-social",
           include_good_rt == 1)

Get the number of subjects filtered out by the subject level filter.

df_n_expt2 <- df_expo_expt2 %>%
    group_by(condition) %>%
    summarise(n_subs = n_distinct(subids))

df_n_expt2_filt <- df_expo_expt2_filt %>%
    group_by(condition) %>%
    summarise(n_subs_filt = n_distinct(subids)) %>%
    select(n_subs_filt)

nsubs_expt2 <- cbind(df_n_expt2, df_n_expt2_filt)

nsubs_expt2

##        condition n_subs n_subs_filt
## 1 No-socialFirst    181         159
## 2    SocialFirst    185         162

Test trial filters.

# just RT filter
df_test_expt2 <- df_expt2 %>%
    filter(trial_cat == "test",
           include_good_rt == 1)

# RT, subject level and trial level filter 
df_test_expt2_filt <- df_expt2 %>%
    filter(trial_cat == "test",
           mean_acc_exp > 0.25 ,
           include_good_rt == 1,
           correct_exposure == T | condition_trial == "no-social")

Analyze Exposure Trials

Accuracy, selecting target of gaze.

# unfiltered
ms_expo_expt2 <- df_expo_expt2 %>%
    group_by(intervalNum) %>%
    summarise(accuracy_exposure = mean(correct),
              ci_low = ci.low(correct),
              ci_high = ci.high(correct)) %>%
    mutate(filter = "Unfiltered")

# filtered
ms_expo_expt2_filt <- df_expo_expt2_filt %>%
    group_by(intervalNum) %>%
    summarise(accuracy_exposure = mean(correct),
              ci_low = ci.low(correct),
              ci_high = ci.high(correct)) %>%
    mutate(filter = "Filtered")

ms_expo_all_expt2 <- rbind(ms_expo_expt2, ms_expo_expt2_filt)

Now plot mean correct for exposure trials for each interval.

RT on exposure trials.

ms_rt_expo_expt2 <- df_expo_expt2_analysis %>%
    group_by(condition_trial, intervalNum) %>%
    summarise(rt_exposure = mean(rt),
              ci_low = ci.low(rt),
              ci_high = ci.high(rt))

Plot RT differences

Analyze test trials

Get means and CIs for each condition.

# unfiltered
ms_test_expt2 <- df_test_expt2 %>%
    group_by(trialType, condition_trial, intervalNum) %>%
    summarise(accuracy = mean(correct),
              ci_low = ci.low(correct),
              ci_high = ci.high(correct)) %>%
    mutate(filter = "Unfiltered")

# filtered (subject level)
ms_test_expt2_filt <- df_test_expt2_filt %>%
    group_by(trialType, condition_trial, intervalNum) %>%
    summarise(accuracy = mean(correct),
              ci_low = ci.low(correct),
              ci_high = ci.high(correct)) %>%
    mutate(filter = "Filtered")

ms_test_all_expt2 <- rbind(ms_test_expt2, ms_test_expt2_filt)

Now plot accuracy for test trials.

LMERs

Predicting RT on exposure trials.

m1_rt_expt2 <- lmer(rt ~ condition_trial * log2(intervalNum + 1) * log2(numPicN) + 
                  (1|subids), data=df_expo_expt2_analysis)

## fixed-effect model matrix is rank deficient so dropping 4 columns / coefficients

Comparing models with different levels of complexity.

# filtered 2-way
m1_expt2_2way_filt <- glmer(correct ~ (trialType + condition_trial + intervalNum)^2 + 
                             (trialType | subids), nAGQ=0,
                         data = df_test_expt2_filt,
                         family=binomial)

# filtered 3-way
m1_expt2_3_way_filt <- glmer(correct ~ (trialType + condition_trial + intervalNum)^3 + 
                             (trialType | subids), nAGQ=0,
                         data = df_test_expt2_filt,
                         family=binomial)

model_comp_expt2 <- anova(m1_expt2_2way_filt, m1_expt2_3_way_filt)

pandoc.table(model_comp_expt2, style="rmarkdown")

## 
## 
## |          &nbsp;           |  Df  |  AIC  |  BIC  |  logLik  |
## |:-------------------------:|:----:|:-----:|:-----:|:--------:|
## |  **m1_expt2_2way_filt**   |  10  | 4978  | 5042  |  -2479   |
## |  **m1_expt2_3_way_filt**  |  11  | 4979  | 5049  |  -2478   |
## 
## Table: Table continues below
## 
##  
## 
## |          &nbsp;           |  deviance  |  Chisq  |  Chi Df  |
## |:-------------------------:|:----------:|:-------:|:--------:|
## |  **m1_expt2_2way_filt**   |    4958    |   NA    |    NA    |
## |  **m1_expt2_3_way_filt**  |    4957    |  1.301  |    1     |
## 
## Table: Table continues below
## 
##  
## 
## |          &nbsp;           |  Pr(>Chisq)  |
## |:-------------------------:|:------------:|
## |  **m1_expt2_2way_filt**   |      NA      |
## |  **m1_expt2_3_way_filt**  |    0.254     |

3-way is no better than the 2-way.

LMERs comparing filtered vs. unfiltered data.

# unfilt 2-way
m1_expt2_unfilt <- glmer(correct ~ (trialType + condition_trial + intervalNum)^2 + 
                             (trialType | subids), nAGQ=0,
                         data = df_test_expt2,
                         family=binomial)

# filtered 2-way
m1_expt2_filt <- glmer(correct ~ (trialType + condition_trial + intervalNum)^2 + 
                             (trialType | subids), nAGQ=0,
                         data = df_test_expt2_filt,
                         family=binomial)

Model output is no different when we use the filtered data.

Experiment 3: Parametric reliability manipulation

Minor data cleaning and variable creation.

# create clean reliablity variable
df_expt3$prop_cond_clean <- revalue(df_expt3$condition,
                                    c("0%_reliable" = "0%",
                                      "25%_reliable" = "25%",
                                      "50%_reliable" = "50%",
                                      "75%_reliable" = "75%",
                                      "100%_reliable" = "100%"))

# change order of condition factor for plotting
df_expt3$prop_cond_clean <- factor(df_expt3$prop_cond_clean, 
                                   levels = c("0%", "25%", 
                                              "50%", "75%", "100%"))

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

Clean up RTs.

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

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

Get the number of subjects in each experiment and condition.

df_expt3 %>%
      group_by(prop_cond_clean) %>%
      summarise(n_subs = n_distinct(subids))

## Source: local data frame [5 x 2]
## 
##   prop_cond_clean n_subs
## 1              0%     99
## 2             25%     97
## 3             50%    100
## 4             75%     98
## 5            100%     96

Set up filters

Exposure trials:

# all expsoure trials
df_expo_all_expt3 <- df_expt3 %>% 
    filter(trial_category == "exposure",
           include_good_rt == 1)

# exposures trials in the familiarization block
df_expo_fam_expt3 <- df_expt3 %>%
    filter(trial_category == "exposure" & 
               block == "familiarization",
           include_good_rt == 1)

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

Test trials:

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

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

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

Flag whether participant chose the target of eye gaze on exposure trials in the test block.

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

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

Analyze Familiarization Block

RT on exposure trials.

ms_rt_expo_fam <- df_expo_fam_expt3 %>%
    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,4500)) +
    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))

Accuracy on test trials in familiarization block

ms_test_fam <- df_test_fam_expt3 %>%
      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)) + 
    geom_smooth(method='lm') +
    ggtitle("Accuracy on Test Trials in Familiarization Block")

Split this by first and second half.

ms_test_fam <- df_test_fam_expt3 %>%
    mutate(second_half = itemNum > 3) %>%
      group_by(prop_cond_clean, trialType, second_half) %>%
      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)) + 
    geom_smooth(method='lm') +
    facet_grid(.~second_half) + 
    ggtitle("Accuracy on Test Trials in Familiarization Block")

Analyze performance on test block

Anayze RT on exposure trials in the test block.

ms_rt_expo_test <- df_expo_test_expt3 %>%
    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))

Now plot chose target of gaze

expt3_chose_gazetar_plot <- ggplot(ms_expo_test, 
                                   aes(x=prop_cond_clean, y=accuracy, group=1)) +
    geom_smooth(method="lm", se=F, color="black") +
    geom_pointrange(aes(ymin=accuracy - ci_low,
                        ymax=accuracy + ci_high), width=.1, size=0.5) +
    geom_hline(yintercept=0.25, linetype = "dashed") +
    scale_y_continuous(limits=c(0,1)) +
    xlab("Level of Reliablity") + 
    ylab("Prop. Chose \n Target of Gaze") + 
    theme(axis.title.x = element_text(colour="black",size=16,
                                      angle=0,hjust=0.5,vjust=0,face="plain"),
          axis.title.y = element_text(colour="black",size=16,
                                      angle=0,hjust=0.5,vjust=0.5,face="plain"),
          axis.text.x = element_text(colour="grey20",size=12,
                                     angle=0,hjust=0.5,vjust=0,face="plain"),
          axis.text.y = element_text(colour="grey20",size=12,
                                     angle=0,hjust=0.5,vjust=0,face="plain"),
          legend.position=c(0.85,0.85),
          legend.text = element_text(size=13),
          legend.title = element_text(size=13, face="bold"))

expt3_chose_gazetar_plot

# save plot
ggsave("exp3-acc-exposure.pdf", expt3_chose_gazetar_plot, width=5.5, height=3.5)

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))

Now plot.

## Loading required package: proto

Analyze subject reported reliablity

df_test_test$rel_subj <- as.numeric(as.character(df_test_test$rel_subj))

## Warning: NAs introduced by coercion

ms_test_subj_rel <- df_test_test %>%
      group_by(prop_cond_clean) %>%
      summarise(accuracy = mean(rel_subj,na.rm=TRUE),
                ci_low = ci.low(rel_subj),
                ci_high = ci.high(rel_subj))

qplot(x=prop_cond_clean, y=accuracy, data=ms_test_subj_rel) + 
    ylim(c(0,1))

qplot(rel_subj, facets=.~prop_cond_clean, data=df_test_test, binwidth=.1)

Reported reliability vs. number correct on exposure - individual consistency.

df_test_test <- df_test_test %>%
    group_by(subids) %>% 
    mutate(total_exposure_correct = sum(correct_exposure)) 

ms_test_subj_rel <- df_test_test %>%
    group_by(subids, prop_cond_clean, add=FALSE) %>%
    summarise(total_exposure_correct = total_exposure_correct[1], 
              subj = rel_subj[1])

qplot(total_exposure_correct, subj, col = prop_cond_clean, 
      data=ms_test_subj_rel) + geom_smooth(method="lm", se=FALSE)

## Warning: Removed 2 rows containing missing values (stat_smooth).

## Warning: Removed 4 rows containing missing values (stat_smooth).

## Warning: Removed 1 rows containing missing values (stat_smooth).

## Warning: Removed 1 rows containing missing values (stat_smooth).

## Warning: Removed 2 rows containing missing values (stat_smooth).

## Warning: Removed 10 rows containing missing values (geom_point).

Reported reliability vs. number correct on exposure - means.

ms_test_subj_rel <- df_test_test %>%
    group_by(prop_cond_clean, total_exposure_correct, add=FALSE) %>%
    summarise(subj = mean(rel_subj, na.rm=TRUE), 
              cih = ci.high(rel_subj),
              cil = ci.low(rel_subj))

Now plot

expt3_subj_rel_plot <- qplot(total_exposure_correct, subj, col = prop_cond_clean, 
      ymin = subj - cil, ymax = subj + cih,
      geom="pointrange",
      position=position_dodge(width=.1),
      data=ms_test_subj_rel, ylab="Subjective\nReliability", 
      xlab="Num Trials Chose Gaze Target") + 
    geom_smooth(method="lm", se=FALSE) +
    scale_color_discrete(name="Reliability Level") +
    theme(axis.title.x = element_text(colour="black",size=16,
                                      angle=0,hjust=0.5,vjust=0,face="plain"),
          axis.title.y = element_text(colour="black",size=16,
                                      angle=0,hjust=0.5,vjust=0.5,face="plain"),
          axis.text.x = element_text(colour="grey20",size=12,
                                     angle=0,hjust=0.5,vjust=0,face="plain"),
          axis.text.y = element_text(colour="grey20",size=12,
                                     angle=0,hjust=0.5,vjust=0,face="plain"),
          legend.text = element_text(size=13),
          legend.title = element_text(size=13, face="bold"))

expt3_subj_rel_plot

# save output
ggsave("expt3-subj-rel-chose-gaze-target.pdf", expt3_subj_rel_plot, width=7, height=4)

LMERs

Accuracy on exposure trials in test block

m1_expo_expt3 <- glmer(correct ~ reliability +
                (1 | subids),
            data = df_expo_test_expt3, nAGQ = 0,
            family = binomial)

Accuracy on test trials in test block.

# reliablity as factor, linear interaction
m1_expt3 <- glmer(correct ~ trialType * prop_cond_clean +
                (trialType | subids),
            data = df_test_test, nAGQ = 0,
            family = binomial)

m1.b_expt3 <- glmer(correct ~ trialType + prop_cond_clean +
                (trialType | subids),
            data = df_test_test, 
            family = binomial)

## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl =
## control$checkConv, : Model failed to converge with max|grad| = 0.112285
## (tol = 0.001, component 9)

Reliablity as continuous

m2_expt3 <- glmer(correct ~ trialType * reliability +
                (trialType | subids),
            data = df_test_test, 
            family = binomial)

m2.noslope_expt3 <- glmer(correct ~ trialType * reliability +
                (1 | subids),
            data = df_test_test, 
            family = binomial)

# aggreate subject level then model
mss_expt3 <- df_test_test %>% 
    group_by(subids, trialType, reliability) %>%
    summarize(correct = mean(correct))

# now model
m2.lm_expt3 <- lm(correct ~ trialType * reliability,
            data = mss_expt3)

Predict test performance from selecting target of gaze on exposure trials

df_test_test <- df_test_test %>%
    group_by(subids) %>% 
    mutate(total_exposure_correct = sum(correct_exposure)) 

# now model
m4_expt3 <- glmer(correct ~ total_exposure_correct * trialType +
                (trialType | subids),
             data = df_test_test,
            family = binomial)

Now we plot the new analysis: accuracy on test trials as a funciton of accuracy on exposure trials (selecting the gaze target).

Now plot

expt3_acc_test_chose_gazetar <- ggplot(data=ms_acc_exp_test_expt3, 
       aes(x=total_exposure_correct, y=correct, group=trialType,
           color=trialType, label = trialType)) + 
    geom_pointrange(aes(ymin=correct - cil, 
                        ymax=correct + cih), 
                    width = .05, size=1) +
    geom_smooth(method='lm', se=F) +
    geom_hline(aes(yintercept=1/4), linetype = "dashed") +
    scale_x_continuous(limits=c(0,9), breaks=c(0:8)) +
    scale_y_continuous(limits=c(0,1)) +
    scale_colour_grey(start=0.3, end=0.6) +
    xlab("Number Correct on Exposure") + 
    ylab("Proportion Correct") +
    labs(color = "Trial Type") +
    guides(color=FALSE) +
    geom_dl(method=list("last.qp",cex=1,hjust=-.5)) +
    theme(axis.title.x = element_text(colour="black",size=18,
                                      angle=0,hjust=0.5,vjust=0,face="plain"),
          axis.title.y = element_text(colour="black",size=18,
                                      angle=90,hjust=0.5,vjust=0.8,face="plain"),
          axis.text.x = element_text(colour="grey20",size=12,
                                     angle=0,hjust=0.5,vjust=0,face="plain"),
          axis.text.y = element_text(colour="grey20",size=12,
                                     angle=0,hjust=0.5,vjust=0,face="plain"),
          legend.text = element_text(size=13),
          legend.title = element_text(size=13, face="bold")) 
    

expt3_acc_test_chose_gazetar

ggsave("expt3-acc-test-chosegazetar.pdf", expt3_acc_test_chose_gazetar, width=7.5, height=5)

Soc-Xsit Analysis and Vizualizations

Kyle MacDonald

January 17, 2015

Experiment 1

Get the number of subjects in each condition.

Do some minor data cleaning and create variables

Set up filters

RT on exposure trials

Accuracy on test trials

LMERs

Predicting RT on exposure trials.

Predict accuracy on test trials.

Compare the 3-way model for filtered and unfiltered data.

Experiment 2: Replication with ecologically valid stimulus set

Minor data cleaning, variable creation, and filters

Flag subs who got <25% of exposure trials correct.

Flag test trials on which subject chose target of gaze on exposure

Set up filters

Analyze Exposure Trials

Analyze test trials

LMERs

LMERs comparing filtered vs. unfiltered data.

Experiment 3: Parametric reliability manipulation

Clean up RTs.

Get the number of subjects in each experiment and condition.

Set up filters

Analyze Familiarization Block

Analyze performance on test block

LMERs

Predict test performance from selecting target of gaze on exposure trials