EM6_visualize_ETpilot

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

Visualize in a boxplot. This box plot uses the baseline corrected pupil changes with the pre-trial baseline and the mean of the entire trial’s pupil change.

# 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_classic,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_ETdata2 <- 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_ETdata2 %>%
  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)

BUT Now I want to plot the pupil change when we just take the last 500ms minus the first 500 ms as our per-trip baseline:

Last_min_first <- ETdata %>% 
  select(participant, condsFile, trial, adjustTrip, last_500ms, last500_minus_first500, last500_minus_baseline) %>%
  distinct()

# remove this row. Its another duplicate.. there aren't any other 
# weird duplicates like that, but I can't seem to track down why this one stays
Last_min_first <- Last_min_first[-5, ]

# Now we want to just look at regular trials
Last_min_first <- Last_min_first %>%
  filter(!condsFile %in% c("delayAfterListClosing", "delayBeforeListClosing", "no_costClosing"))

boxplot(last500_minus_first500 ~ condsFile, data = Last_min_first,
        main = "Last 500ms minus first 500ms of list time",
        xlab = "Condition", ylab = "Last 500ms minus first 500ms of list time",
        col = "lightgray", ylim = c(-1.5, 1.0))

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

# Calculate mean for each condition
means <- tapply(Last_min_first$last500_minus_first500, Last_min_first$last500_minus_first500, 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)

Below uses the pre-trial baseline

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