--- title: 'Using GazeR to Analyze Pupillometry Data' author: Jason Geller date: "2020-08-18 21:28:43" output: xaringan::moon_reader: css: xaringan-themer.css lib_dir: libs nature: highlightStyle: github highlightLines: true ratio: "16:9" countIncrementalSlides: false ---

Today



Pupillometry

.center[]

Pupil

Pupillary Light Reflex

.center[]


Pupillary Light Reflex

.center[]

Pupil Near Response


class: inverse, center

Which one is brighter?

.pull-left[ ]

.pull-right[ ] ---

class: inverse background-image: url('assets/img/image11.jpg') background-size: cover

# Which one is darker?

class: inverse background-image: url('assets/img/image13.jpg') background-size: cover # Brightness Illusion

Cognitive Pupillometry

PubMed search for the keyword [pupillometry] from 1940-2019

Figure 1: PubMed search for the keyword pupillometry from 1940-2019

Cognition and Pupil Size

Cognition and Pupil Size

Experimental Control

*We can and should control for this in analysis
# Experimental Control

Get Started

- Install the gazeR package from Github:
r remotes::install_github("dmirman/gazer")
library(gazer)

--

You are recommended to use the RStudio IDE, but you do not have to.


Pupil Pre-processing

Reading in data

To read in the pupil data included in gazeR:

# set working directory 
setwd("/Users/gellr/Desktop/r")
#folder path 
file_list <- list.files (path="/Users/gellr/Desktop/r", pattern=".xls")
#specify blink, pupil, and whether it is from sr or raw edf files
merge_files=merge_gazer_files(file_list, blink_colname="AVERAGE_IN_BLINK", pupil_colname="AVERAGE_PUPIL_SIZE", filetype="sr")

Reading in data

pupil_path <- system.file("extdata", "pupil_sample_files_edf.xls", package = "gazer")
pupil_raw<-fread(pupil_path)
pupil_raw<-as_tibble(pupil_raw)
pupil_raw
## # A tibble: 585,898 x 14
##    subject trial  time pupil     x     y blink message   acc block    rt item 
##    <chr>   <int> <int> <int> <dbl> <dbl> <int> <chr>   <int> <int> <int> <chr>
##  1 11c.edf     1     0  3635  972.  563.     0 MODERE…     1     0  3833 mour…
##  2 11c.edf     1     4  3634  973.  565.     0 <NA>        1     0  3833 mour…
##  3 11c.edf     1     8  3626  972.  567.     0 <NA>        1     0  3833 mour…
##  4 11c.edf     1    12  3622  971   566.     0 <NA>        1     0  3833 mour…
##  5 11c.edf     1    16  3621  972.  566.     0 <NA>        1     0  3833 mour…
##  6 11c.edf     1    20  3621  972.  566.     0 <NA>        1     0  3833 mour…
##  7 11c.edf     1    24  3618  972.  565.     0 <NA>        1     0  3833 mour…
##  8 11c.edf     1    28  3618  971.  564.     0 <NA>        1     0  3833 mour…
##  9 11c.edf     1    32  3617  971.  564.     0 <NA>        1     0  3833 mour…
## 10 11c.edf     1    36  3611  971.  565.     0 <NA>        1     0  3833 mour…
## # … with 585,888 more rows, and 2 more variables: script <chr>, alt <chr>

De-Blinking

pup_extend<- pupil_raw %>% 
  group_by(subject, trial) %>% 
  mutate(extendpupil=extend_blinks(pupil, fillback=100, fillforward=100, hz=250))
## group_by: 2 grouping variables (subject, trial)
## mutate (grouped): new variable 'extendpupil' with 1,877 unique values and 23% NA
pup_extend1 <- pup_extend %>%
  select(subject, trial, time, pupil, extendpupil)
## select: dropped 10 variables (x, y, blink, message, acc, …)
head(pup_extend1)
## # A tibble: 6 x 5
## # Groups:   subject, trial [1]
##   subject trial  time pupil extendpupil
##   <chr>   <int> <int> <int>       <int>
## 1 11c.edf     1     0  3635        3635
## 2 11c.edf     1     4  3634        3634
## 3 11c.edf     1     8  3626        3626
## 4 11c.edf     1    12  3622        3622
## 5 11c.edf     1    16  3621        3621
## 6 11c.edf     1    20  3621        3621

Smoothing/Filtering and Interpolation

--

--

--

--

--

smooth_interp <- smooth_interpolate_pupil(pup_extend, pupil="pupil", extendpupil="extendpupil", extendblinks=TRUE, step.first="interp", filter="moving", maxgap=Inf, type="linear", hz=250, n=5)
## Performing linear interpolation
## Smoothing the pupil trace with moving average

Baseline Correction

baseline_pupil <- baseline_correction_pupil(smooth_interp, pupil_colname='pup_interp', baseline_window=c(500,1000))
## Calculating median baseline from:500-1000
## Merging baseline
## Joining, by = c("subject", "trial")
## ungroup: no grouping variables
## Performing subtractive baseline correction
baseline_pupil<-baseline_correction_pupil_msg(smooth_interp, pupil_colname='pup_interp', baseline_dur=100, event="target", baseline_method = "sub")
## Calculating median baseline from:target
## Joining, by = c("subject", "trial")
## Joining, by = c("subject", "trial")
## Merging baseline
## Performing subtractive baseline correction
baseline_pupil
## # A tibble: 585,898 x 19
##    subject trial baseline  time pupil     x     y blink message   acc block
##    <chr>   <int>    <dbl> <int> <int> <dbl> <dbl> <int> <chr>   <int> <int>
##  1 11c.edf     1    3584.     0  3635  972.  563.     0 MODERE…     1     0
##  2 11c.edf     1    3584.     4  3634  973.  565.     0 <NA>        1     0
##  3 11c.edf     1    3584.     8  3626  972.  567.     0 <NA>        1     0
##  4 11c.edf     1    3584.    12  3622  971   566.     0 <NA>        1     0
##  5 11c.edf     1    3584.    16  3621  972.  566.     0 <NA>        1     0
##  6 11c.edf     1    3584.    20  3621  972.  566.     0 <NA>        1     0
##  7 11c.edf     1    3584.    24  3618  972.  565.     0 <NA>        1     0
##  8 11c.edf     1    3584.    28  3618  971.  564.     0 <NA>        1     0
##  9 11c.edf     1    3584.    32  3617  971.  564.     0 <NA>        1     0
## 10 11c.edf     1    3584.    36  3611  971.  565.     0 <NA>        1     0
## # … with 585,888 more rows, and 8 more variables: rt <int>, item <chr>,
## #   script <chr>, alt <chr>, extendpupil <int>, interp <dbl>, pup_interp <dbl>,
## #   baselinecorrectedp <dbl>

Artifact Rejection: Missingness

pup_missing <- count_missing_pupil(baseline_pupil, pupil="pupil", missingthresh = .2)
## % trials excluded:0.079
## Participants taken out:character(0)

Histogram

puphist

pup_outliers <- pup_missing %>% 
  # based on visual inspection
  dplyr::filter(pup_interp  >= 2500, pup_interp <= 4000) 

Artifact rejection: MAD

mad_removal <- pup_outliers  %>% 
  group_by(subject, trial) %>% 
  mutate(speed=speed_pupil(pup_interp,time)) %>% 
  mutate(MAD=calc_mad(speed, n = 16)) %>% 
  filter(speed < MAD)
## group_by: 2 grouping variables (subject, trial)
## mutate (grouped): new variable 'speed' with 8,977 unique values and 0% NA
## mutate (grouped): new variable 'MAD' with 246 unique values and 0% NA
## filter (grouped): removed 961 rows (<1%), 531,078 rows remaining

Samples to bins

timebins1<- gazer::downsample_gaze(baseline_pupil_onset, bin.length=100, timevar = "time_zero", aggvars = c("subject", "script", "timebins"), type="pupil")
## mutate: new variable 'timebins' with 26 unique values and 0% NA
timebins1
## # A tibble: 156 x 4
##    subject script  timebins aggbaseline
##    <chr>   <chr>      <dbl>       <dbl>
##  1 11c.edf cursive        0       -2.87
##  2 11c.edf cursive      100       -3.56
##  3 11c.edf cursive      200       -4.04
##  4 11c.edf cursive      300       -1.73
##  5 11c.edf cursive      400        2.29
##  6 11c.edf cursive      500        4.69
##  7 11c.edf cursive      600       -2.86
##  8 11c.edf cursive      700      -10.1 
##  9 11c.edf cursive      800       -8.49
## 10 11c.edf cursive      900       -3.05
## # … with 146 more rows

Wrap-up


Thanks!