Load in dataset and libraries!

ETdata <- read.csv("em6_eyetracking.csv", header = TRUE)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
# Remove participant 12 because their data was too messy!
ETdata <- ETdata %>% filter(participant != "pilotv2012")

Visualize in a boxplot. Weird pattern!

# First we need to summarize the data so that we have a value for each
# participant, for each condition, for each trial
Summarized_ETdata <- ETdata %>% 
  group_by(participant,condsFile,trial) %>% 
  summarise(averagePupilChange=mean(change_from_baseline,na.rm = T),
            baseline=first(baseline)
  )
## `summarise()` has grouped output by 'participant', 'condsFile'. You can
## override using the `.groups` argument.
# Now we want to just look at regular trials
Summarized_ETdataFR <- Summarized_ETdata %>%
  filter(!condsFile %in% c("delayAfterListClosing", "delayBeforeListClosing", "no_costClosing"))


boxplot(averagePupilChange ~ condsFile, data = Summarized_ETdataFR,
        main = "Average pupil change per trial, by condition",
        xlab = "Condition", ylab = "Average change from baseline",
        col = "lightgray", ylim = c(-1.5, 1.0))

# Add points for each participant's average
Summarized_ETdataFR$condsFile <- as.factor(Summarized_ETdataFR$condsFile)
points(jitter(as.numeric(Summarized_ETdataFR$condsFile)), 
       Summarized_ETdataFR$averagePupilChange, 
       col = "blue", pch = 16, cex = 0.7)

# Calculate mean for each condition
means <- tapply(Summarized_ETdataFR$averagePupilChange, Summarized_ETdataFR$condsFile, mean)

# Add mean values as text labels above each box
text(x = 1:length(means), y = means + 0.6,
     labels = round(means, 2), col = "red", cex = 1, font = 2)

Let’s do the same thing… but for the backup baseline (first 500ms of list phase instead of dedicated pre-trial baseline). This shows less of a change in general which makes sense. But I don’t think its the best period to get a baseline. I just wanted to compare if there was anything really crazy going on in the previous boxplot.

# First we need to summarize the data so that we have a value for each
# participant, for each condition, for each trial
Summarized_ETdata <- ETdata %>% 
  group_by(participant,condsFile,trial) %>% 
  summarise(averagePupilChange2=mean(change_from_baseline2,na.rm = T),
            baseline2=first(baseline2)
  )
## `summarise()` has grouped output by 'participant', 'condsFile'. You can
## override using the `.groups` argument.
# Now we want to just look at regular trials
Summarized_ETdataFR2 <- Summarized_ETdata %>%
  filter(!condsFile %in% c("delayAfterListClosing", "delayBeforeListClosing", "no_costClosing"))


boxplot(averagePupilChange2 ~ condsFile, data = Summarized_ETdataFR2,
        main = "Average pupil change per trial, by condition",
        xlab = "Condition", ylab = "Average change from baseline",
        col = "lightgray", ylim = c(-1.5, 1.0))

# Add points for each participant's average
Summarized_ETdataFR2$condsFile <- as.factor(Summarized_ETdataFR2$condsFile)
points(jitter(as.numeric(Summarized_ETdataFR2$condsFile)), 
       Summarized_ETdataFR2$averagePupilChange2, 
       col = "blue", pch = 16, cex = 0.7)

# Calculate mean for each condition
means <- tapply(Summarized_ETdataFR2$averagePupilChange2, Summarized_ETdataFR2$condsFile, mean)

# Add mean values as text labels above each box
text(x = 1:length(means), y = means + 0.6,
     labels = round(means, 2), col = "red", cex = 1, font = 2)

Now let’s look at some individual pupil traces. Here’s participant 10, on their first trip and first trial in Delay-after-list. We can see where the blinks are, and how Tobii doesn’t do a perfect job of automatically removing them, so we will have to go back and do a blink correction later.

# First we filter the data into a single chunk to make things easier
Trace_data <- ETdata %>%
  filter(participant == "pilotv2010" & 
           condsFile == "delayAfterList" & 
           trial == 1 & 
           adjustTrip == 1 & 
           !is.na(d_time))

plot(Trace_data$tripCalFrame, Trace_data$change_from_baseline, 
     type = "l",                        # 'l' specifies a line plot
     col = "blue",                      # Line color
     lwd = 2,                           # Line width
     main = "Pupil change from baseline, Participant 10, Trial 1, Trip 1, DAL", 
     xlab = "Frame", 
     ylab = "Pupil change",
     ylim = c(-1.0, 1.0))               # Set y-axis limits

# Add grid lines for a cleaner look
grid()

Here is participant 7, trial 1 and trip 1 on Delay-before-list.

Trace_data <- ETdata %>%
  filter(participant == "pilotv2007" & 
           condsFile == "delayBeforeList" & 
           trial == 1 & 
           adjustTrip == 1 & 
           !is.na(d_time))

plot(Trace_data$tripCalFrame, Trace_data$change_from_baseline, 
     type = "l",                        # 'l' specifies a line plot
     col = "blue",                      # Line color
     lwd = 2,                           # Line width
     main = "Pupil change from baseline, Participant 7, Trial 1, Trip 1, DBL", 
     xlab = "Frame", 
     ylab = "Pupil change from baseline",
     ylim = c(-1.0, 1.0))               # Set y-axis limits

# Add grid lines for a cleaner look
grid()

Here’s participant 13, trial 2 trip 1 on no-cost. See how the frame number on the x axis is less than previous graphs? Its because people are spending less time checking the list in the no_cost condition.

Trace_data <- ETdata %>%
  filter(participant == "pilotv2013" & 
           condsFile == "no_cost" & 
           trial == 2 & 
           adjustTrip == 1 & 
           !is.na(d_time))

plot(Trace_data$tripCalFrame, Trace_data$change_from_baseline, 
     type = "l",                        # 'l' specifies a line plot
     col = "blue",                      # Line color
     lwd = 2,                           # Line width
     main = "Pupil change from baseline, Participant 13, Trial 2, Trip 1, No cost", 
     xlab = "Frame", 
     ylab = "Pupil change from baseline",
     ylim = c(-1.0, 1.0))               # Set y-axis limits

# Add grid lines for a cleaner look
grid()

Now I want to make an averaged pupil trace for a condition and a participant.

# Step 1: Aggregate data by participant, condition, trial, and tripCalFrame
average_trace <- ETdata %>%
  group_by(participant, condsFile, trial, tripCalFrame) %>%
  filter(!is.na(d_time)) %>%
  summarize(mean_change = mean(change_from_baseline, na.rm = TRUE)) %>%
  ungroup()
## `summarise()` has grouped output by 'participant', 'condsFile', 'trial'. You
## can override using the `.groups` argument.
Trace_data <- average_trace %>%
  filter(participant == "pilotv2007" & 
           condsFile == "delayAfterList")

# Get the unique trials for this participant and condition
trials <- unique(Trace_data$trial)

# Set up the plot area with labels and limits
plot(NULL, xlim = range(Trace_data$tripCalFrame), ylim = c(-0.5, 0.5),
     xlab = "Frame", ylab = "Average pupil change",
     main = paste("Participant 7, Delay-after-lsit"))

# Choose a set of colors for each trial
colors <- rainbow(length(trials)) 

# Plot each trial's average trace as a separate line in the plot
for (i in seq_along(trials)) {
  trial_data <- subset(Trace_data, trial == trials[i])
  lines(trial_data$tripCalFrame, trial_data$mean_change, col = colors[i], lwd = 1)
}

# Add a legend to differentiate each trial
legend("topright", legend = paste("Trial", trials), col = colors, lwd = 2)

Let’s look at another random participant for Delay-before-list, how about number 9.

Trace_data <- average_trace %>%
  filter(participant == "pilotv2009" & 
           condsFile == "delayBeforeList")

# Get the unique trials for this participant and condition
trials <- unique(Trace_data$trial)

# Set up the plot area with labels and limits
plot(NULL, xlim = range(Trace_data$tripCalFrame), ylim = c(-0.6, 0.6),
     xlab = "Frame", ylab = "Average pupil change",
     main = paste("Participant 9, Delay-before-lsit"))

# Choose a set of colors for each trial
colors <- rainbow(length(trials)) 

# Plot each trial's average trace as a separate line in the plot
for (i in seq_along(trials)) {
  trial_data <- subset(Trace_data, trial == trials[i])
  lines(trial_data$tripCalFrame, trial_data$mean_change, col = colors[i], lwd = 1)
}

# Add a legend to differentiate each trial
legend("topright", legend = paste("Trial", trials), col = colors, lwd = 2)

Now let’s average over condition and look at each participant.

# Step 1: Aggregate data by participant and condition
average_trace_condition <- ETdata %>%
  group_by(participant, condsFile, tripCalFrame) %>%
  filter(!is.na(d_time)) %>%
  summarize(mean_change = mean(change_from_baseline, na.rm = TRUE)) %>%
  filter(!condsFile %in% c("delayAfterListClosing", "delayBeforeListClosing", "no_costClosing")) %>%
  ungroup()
## `summarise()` has grouped output by 'participant', 'condsFile'. You can
## override using the `.groups` argument.
Trace_data <- average_trace_condition %>%
  filter(participant == "pilotv2011")

conditions <- unique(Trace_data$condsFile)

# Set up the plot area with labels and limits
plot(NULL, xlim = range(Trace_data$tripCalFrame), ylim = c(-1.0, 0.5),
     xlab = "Frame", ylab = "Average pupil change",
     main = paste("Participant 11"))

# Choose a set of colors for each trial
colors <- rainbow(length(conditions)) 

# Plot each trial's average trace as a separate line in the plot
for (i in seq_along(conditions)) {
  conditions_data <- subset(Trace_data, condsFile == conditions[i])
  lines(conditions_data$tripCalFrame, conditions_data$mean_change, col = colors[i], lwd = 1)
}

# Add a legend to differentiate each trial
legend("topright", legend = paste(conditions), col = colors, lwd = 2)

# Participant 8 ##########
Trace_data <- average_trace_condition %>%
  filter(participant == "pilotv2008")

conditions <- unique(Trace_data$condsFile)

# Set up the plot area with labels and limits
plot(NULL, xlim = range(Trace_data$tripCalFrame), ylim = c(-1.0, 0.5),
     xlab = "Frame", ylab = "Average pupil change",
     main = paste("Participant 8"))

# Choose a set of colors for each trial
colors <- rainbow(length(conditions)) 

# Plot each trial's average trace as a separate line in the plot
for (i in seq_along(conditions)) {
  conditions_data <- subset(Trace_data, condsFile == conditions[i])
  lines(conditions_data$tripCalFrame, conditions_data$mean_change, col = colors[i], lwd = 1)
}

# Add a legend to differentiate each trial
legend("topright", legend = paste(conditions), col = colors, lwd = 2)

# Participant 5 ##########################
Trace_data <- average_trace_condition %>%
  filter(participant == "pilotv2005")

conditions <- unique(Trace_data$condsFile)

# Set up the plot area with labels and limits
plot(NULL, xlim = range(Trace_data$tripCalFrame), ylim = c(-1.0, 0.5),
     xlab = "Frame", ylab = "Average pupil change",
     main = paste("Participant 5"))

# Choose a set of colors for each trial
colors <- rainbow(length(conditions)) 

# Plot each trial's average trace as a separate line in the plot
for (i in seq_along(conditions)) {
  conditions_data <- subset(Trace_data, condsFile == conditions[i])
  lines(conditions_data$tripCalFrame, conditions_data$mean_change, col = colors[i], lwd = 1)
}

# Add a legend to differentiate each trial
legend("topright", legend = paste(conditions), col = colors, lwd = 2)

Interesting. Keep in mind that the baseline was a pre-trial baseline. So most participants’ pupils are getting smaller in relation to their pre-trial baseline. Annoyance/boredom? Participants did report the game was tedious.

Now let’s average over each condition if we can.

# Step 1: Aggregate data by participant and condition
average_trace_OVERALL <- ETdata %>%
  group_by(condsFile, tripCalFrame) %>%
  filter(!is.na(d_time)) %>%
  summarize(mean_change = mean(change_from_baseline, na.rm = TRUE)) %>%
  filter(!condsFile %in% c("delayAfterListClosing", "delayBeforeListClosing", "no_costClosing")) %>%
  ungroup()
## `summarise()` has grouped output by 'condsFile'. You can override using the
## `.groups` argument.
conditions <- unique(average_trace_OVERALL$condsFile)

# Set up the plot area with labels and limits
plot(NULL, xlim = range(average_trace_OVERALL$tripCalFrame), ylim = c(-1.0, 0.5),
     xlab = "Frame", ylab = "Average pupil change",
     main = paste("Avg pupil change per condition"))

# Choose a set of colors for each trial
colors <- rainbow(length(conditions)) 

# Plot each trial's average trace as a separate line in the plot
for (i in seq_along(conditions)) {
  conditions_data <- subset(average_trace_OVERALL, condsFile == conditions[i])
  lines(conditions_data$tripCalFrame, conditions_data$mean_change, col = colors[i], lwd = 1)
}

# Add a legend to differentiate each trial
legend("topright", legend = paste(conditions), col = colors, lwd = 2)

It’s possible that the above graph is showing, at the end of the delay conditions, the cognitive load of having however many items in memory (along with messiness from blinks). Keep in mind these are all showing the raw pupil trace. Its all bound to look a little different after blink correction + smoothing filters.