1 Background

In this study, we compared the eye-movements of participants as they completed a joint attention game with a virtual partner or avatar. Half of the participants believed that the avatar was controlled by another human. The other half were correctly informed that the avatar was controlled by a computer algorithm.

The code imports trial and interest area reports and combines them into a single dataframe describing each trial. Accuracy and eyetracking data are presented via boxplots. Eyetracking data are analysed via ANOVAs and t-tests. We use non-parmetric stats to explore subject ratings of the task.

1.1 Reference

Caruana, N., Spirou, D., & Brock, J. (2017). Human agency beliefs influence joint attention behaviour. Manuscript submitted for publication.

2 Load required packages

library(reshape2)
library(tables)
library(ez)
library(knitr)
library(plyr)
library(gridExtra)
library(ReporteRs)
library(stringr)

sessionInfo()
## R version 3.3.2 (2016-10-31)
## Platform: x86_64-apple-darwin13.4.0 (64-bit)
## Running under: OS X El Capitan 10.11.6
## 
## locale:
## [1] en_AU.UTF-8/en_AU.UTF-8/en_AU.UTF-8/C/en_AU.UTF-8/en_AU.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] stringr_1.2.0       ReporteRs_0.8.8     ReporteRsjars_0.0.2
##  [4] gridExtra_2.2.1     plyr_1.8.4          knitr_1.15.1       
##  [7] ez_4.4-0            tables_0.8          Hmisc_4.0-2        
## [10] ggplot2_2.2.1       Formula_1.2-1       survival_2.40-1    
## [13] lattice_0.20-34     reshape2_1.4.2     
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_0.12.9         png_0.1-7           assertthat_0.1     
##  [4] rprojroot_1.2       digest_0.6.12       mime_0.5           
##  [7] R6_2.2.0            backports_1.0.5     acepack_1.4.1      
## [10] MatrixModels_0.4-1  evaluate_0.10       gdtools_0.1.3      
## [13] lazyeval_0.2.0      minqa_1.2.4         data.table_1.10.4  
## [16] SparseM_1.74        car_2.1-4           nloptr_1.0.4       
## [19] R.utils_2.5.0       R.oo_1.21.0         rpart_4.1-10       
## [22] Matrix_1.2-7.1      checkmate_1.8.2     rmarkdown_1.3      
## [25] splines_3.3.2       lme4_1.1-12         foreign_0.8-67     
## [28] htmlwidgets_0.8     munsell_0.4.3       shiny_1.0.0        
## [31] httpuv_1.3.3        base64enc_0.1-3     mgcv_1.8-15        
## [34] rvg_0.1.2           htmltools_0.3.5     nnet_7.3-12        
## [37] tibble_1.2          htmlTable_1.9       MASS_7.3-45        
## [40] R.methodsS3_1.7.1   grid_3.3.2          xtable_1.8-2       
## [43] nlme_3.1-128        gtable_0.2.0        magrittr_1.5       
## [46] scales_0.4.1        stringi_1.1.2       latticeExtra_0.6-28
## [49] xml2_1.1.1          RColorBrewer_1.1-2  tools_3.3.2        
## [52] parallel_3.3.2      pbkrtest_0.4-6      yaml_2.1.14        
## [55] colorspace_1.3-2    cluster_2.0.5       rJava_0.9-8        
## [58] quantreg_5.29

3 Functions

3.1 get_Boxplot

Draws boxplot with overlaid datapoints

get_Boxplot <- function (Data, DV, yMin=0, yMax=1, yBreaks=0.2, yLabel="Test") {
  ggplot(Data, aes_string(x="factor(Group)", y=DV, fill="Condition")) +
    geom_boxplot(outlier.colour=NA) +
    scale_fill_brewer(palette="BuGn") + 
    theme_minimal(base_size = 16, base_family = "") +
    scale_x_discrete("") +
    geom_point(position=position_jitterdodge(dodge.width=0.75, jitter.width=0.3), alpha=0.2, size=3) +
    scale_y_continuous(yLabel,limits=c(yMin,yMax), breaks=seq(yMin,yMax,yBreaks)) 
}

3.2 get_legend

Grabs the legend from one of the figures so it can be placed in a multi-panel figure Source: http://www.sthda.com/english/wiki/print.php?id=177

get_legend<-function(myggplot){
  tmp <- ggplot_gtable(ggplot_build(myggplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)
}

4 Data wrangling

We used Eyelink DataViewer software to export trial and interest area reports as text files.

Extract accuracy data from trial report.

  AccData <- read.delim("data/Trial_Report_Accuracy.txt", stringsAsFactors=FALSE)
  Data <- AccData[,c("RECORDING_SESSION_LABEL", "trial_id_num", "INDEX", "ERROR_TYPE")]
  Data$SubNum <- as.numeric(lapply(Data$RECORDING_SESSION_LABEL, function(x) substr(x, 1, 3)))
  Data$UTI <- Data$SubNum*1000 + Data$trial_id_num

Extract saccadic reaction times from interest area report and add to trial data.

  SRTData <- read.delim("data/IA_Report_RJA_SRT.txt", stringsAsFactors=FALSE)
  SRTData <- SRTData [(SRTData$IA_LABEL=="IA_BURGLAR "),]
  SRTData$IPStartTime <- SRTData$IP_START_TIME - SRTData$TRIAL_START_TIME
  SRTData$IA_FIRST_SACCADE_START_TIME[SRTData$IA_FIRST_SACCADE_START_TIME=="."] <- NA
  SRTData$IA_FIRST_SACCADE_START_TIME <- as.numeric(SRTData$IA_FIRST_SACCADE_START_TIME)
  SRTData$SRT <- SRTData$IA_FIRST_SACCADE_START_TIME - (SRTData$IP_START_TIME - SRTData$TRIAL_START_TIME)
  SRTData$SubNum <- as.numeric(lapply(SRTData$RECORDING_SESSION_LABEL, function(x) substr(x, 1, 3)))
  SRTData$UTI <- SRTData$SubNum*1000 + SRTData$trial_id_num
  Data$FirstSaccadeSRT <- SRTData$SRT[match(Data$UTI, SRTData$UTI)]

Extract dwell times from interest area report and add to trial data.

  DwellData <- read.delim("data/IA_Report_IJA_Dwell.txt", stringsAsFactors=FALSE) 
  DwellData <- DwellData [(DwellData$IA_LABEL=="IA_BURGLAR "),] 
  DwellData$SubNum <- as.numeric(lapply(DwellData$RECORDING_SESSION_LABEL, function(x) substr(x, 1, 3)))
  DwellData$UTI <- DwellData$SubNum*1000 + DwellData$trial_id_num 
  Data$BurglarDwellTime <- DwellData$IA_DWELL_TIME[match(Data$UTI, DwellData$UTI)]

Extract premature saccade data from interest area report and add to trial data.

  PremiData <- read.delim("data/IA_Report_IJA_Premi.txt", stringsAsFactors=FALSE)
  PremiData <- PremiData [(PremiData$IA_LABEL=="IA_BURGLAR "),]
  PremiData$PrematureSaccade <- lapply(PremiData$IA_FIXATION_COUNT, function(x) if(x==0){0}else{1})
  PremiData$SubNum <- as.numeric(lapply(PremiData$RECORDING_SESSION_LABEL, function(x) substr(x, 1, 3)))
  PremiData$UTI <- PremiData$SubNum*1000 + PremiData$trial_id_num
  Data$PrematureSaccade <- PremiData$PrematureSaccade[match(Data$UTI, PremiData$UTI)]
  Data$PrematureSaccade <- vapply(Data$PrematureSaccade, paste, collapse = ", ", character(1L)) # For some reason PrematureSaccade is identified as a list. This command "flattens" the list, allowing it to be written to csv.

Decode correct response / error type

  Data$CorrectResponse <- ifelse(Data$ERROR_TYPE==0,1,0) 
  Data$SearchError <- ifelse(Data$ERROR_TYPE==1,1,0) 
  Data$TimeOut <- ifelse(Data$ERROR_TYPE==2,1,0) 
  Data$LocationError <- ifelse(Data$ERROR_TYPE==3,1,0) 
  Data$RecalibrationError <- ifelse(Data$ERROR_TYPE==4,1,0)

Add information about trials.

  TrialInfo <- read.csv("data/TrialInfo.csv", stringsAsFactors=FALSE)
  Data$Condition <- TrialInfo$Condition[match(Data$trial_id_num, TrialInfo$trial_id_num)] 
  Data$Interface <- TrialInfo$Interface[match(Data$trial_id_num, TrialInfo$trial_id_num)]
  Data$SubjectRole <- TrialInfo$SubjectRole[match(Data$trial_id_num, TrialInfo$trial_id_num)]

Add information about subjects.

  SubjectData <- read.csv("data/SubjectData.csv", stringsAsFactors=FALSE)
  Data$Group <- SubjectData$Group[match(Data$SubNum, SubjectData$SubNum)]

Exclude two participants who weren’t deceived.

  Data$Exclude <- SubjectData$Exclude[match(Data$SubNum, SubjectData$SubNum)] 
  Data <- Data [(Data$Exclude==0),]

Rename dataframe columns for consistency with other datasets.

  names(Data)[names(Data)=="trial_id_num"] <- "TrialID" 
  names(Data)[names(Data)=="INDEX"] <- "TrialNum" 

Remove columns that are now redundant.

Data <- subset(Data, select = -c(Exclude, RECORDING_SESSION_LABEL, ERROR_TYPE))

Write trial data to CSV file.

  write.csv(Data, file="output/data/Data.csv", row.names=FALSE)

Identify factors

FactorNames <- c("SubNum", "TrialID", "Interface", "SubjectRole", "Group", "Condition")
Data[,FactorNames] <- colwise(as.factor)(Data[,FactorNames])
str(Data)
## 'data.frame':    10368 obs. of  16 variables:
##  $ TrialID           : Factor w/ 432 levels "1","2","3","4",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ TrialNum          : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ SubNum            : Factor w/ 48 levels "101","102","103",..: 3 3 3 3 3 3 3 3 3 3 ...
##  $ UTI               : num  103001 103002 103003 103004 103005 ...
##  $ FirstSaccadeSRT   : num  NA NA 486 NA NA 504 627 NA NA NA ...
##  $ BurglarDwellTime  : int  0 2956 0 1256 698 0 0 636 624 1938 ...
##  $ PrematureSaccade  : chr  "0" "1" "0" "1" ...
##  $ CorrectResponse   : num  1 1 1 1 1 1 1 0 1 1 ...
##  $ SearchError       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ TimeOut           : num  0 0 0 0 0 0 0 1 0 0 ...
##  $ LocationError     : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ RecalibrationError: num  0 0 0 0 0 0 0 0 0 0 ...
##  $ Condition         : Factor w/ 4 levels "IJA","IJAc","RJA",..: 4 2 4 2 2 4 3 1 1 1 ...
##  $ Interface         : Factor w/ 2 levels "Control","Test": 1 1 1 1 1 1 2 2 2 2 ...
##  $ SubjectRole       : Factor w/ 2 levels "Initiate","Respond": 2 1 2 1 1 2 2 1 1 1 ...
##  $ Group             : Factor w/ 2 levels "Computer","Human": 1 1 1 1 1 1 1 1 1 1 ...

5 Respond condition

CurrentData <- Data [(Data$SubjectRole=="Respond"), ]
CurrentData$Condition <- factor(CurrentData$Condition)

5.1 Correct responses

CurrentData$ScreenIn <-ifelse((CurrentData$RecalibrationError==0 & CurrentData$SearchError==0 & !is.na(CurrentData$CorrectResponse)), 1, 0)
mean(CurrentData$ScreenIn)
## [1] 0.9876543
ScreenedData <- CurrentData [(CurrentData$ScreenIn==1), ]
BySubjectsData <- ddply(ScreenedData, .(Group, SubNum, Condition), summarise, ProportionCorrect = mean(CorrectResponse))
RJA_Acc_Boxplot <- get_Boxplot(BySubjectsData, "ProportionCorrect", yMin=0, yMax=1, yBreaks=0.2, yLabel="Proportion Correct")
RJA_Acc_Boxplot

5.2 Saccadic reaction times

CurrentData$ScreenIn <-ifelse((CurrentData$CorrectResponse==1 & CurrentData$FirstSaccadeSRT>=150 & CurrentData$FirstSaccadeSRT<=3000 & !is.na(CurrentData$FirstSaccadeSRT)), 1, 0)
mean(CurrentData$ScreenIn)
## [1] 0.8661265
ScreenedData <- CurrentData [(CurrentData$ScreenIn==1), ]

BySubjectsData <- ddply(ScreenedData, .(Group, SubNum, Condition), summarise, FirstSaccadeSRT = mean(FirstSaccadeSRT))
RJA_SRT_Boxplot <- get_Boxplot(BySubjectsData, "FirstSaccadeSRT", yMin=0, yMax=1200, yBreaks=200, yLabel="Reaction Time")
RJA_SRT_Boxplot

kable(ezANOVA(BySubjectsData, dv = FirstSaccadeSRT, wid = SubNum, within = .(Condition), between = Group, type = 3), row.names=FALSE, caption="First saccade reaction time", digits=3)
First saccade reaction time
Effect DFn DFd F p p<.05 ges
Group 1 46 5.710 0.021 * 0.075
Condition 1 46 264.629 0.000 * 0.664
Group:Condition 1 46 2.340 0.133 0.017

6 Initiating condition

CurrentData <- Data [(Data$SubjectRole=="Initiate"), ]
CurrentData$Condition <- factor(CurrentData$Condition)

6.1 Correct responses

CurrentData$ScreenIn <-ifelse((CurrentData$RecalibrationError==0 & CurrentData$SearchError==0 & !is.na(CurrentData$CorrectResponse)), 1, 0)
mean(CurrentData$ScreenIn)
## [1] 0.9907407
ScreenedData <- CurrentData [(CurrentData$ScreenIn==1), ]
BySubjectsData <- ddply(ScreenedData, .(Group, SubNum, Condition), summarise, ProportionCorrect = mean(CorrectResponse))
IJA_Acc_Boxplot <- get_Boxplot(BySubjectsData, "ProportionCorrect", yMin=0, yMax=1, yBreaks=0.2, yLabel="Proportion Correct")
IJA_Acc_Boxplot