Simulate data to analyse with eyetrackingR.

simulate_eyetracking.R

#### eyetrackingR with simulated data  ###################
# Gonzalo García-Castro, gonzalo.garciadecastro@upf.edu
# Center for Brain and Cognition, Universitat Pompeu Fabra

#### set up ##############################################

# load packages
library(dplyr)        # for manipulating data
library(tidyr)        # for reshaping dataframes
library(eyetrackingR) # for processing eye-tracking data

# set params
time_bin_duration <- 100  # how long should time bins be in ms?
sampling_rate     <- 120  # how many samples are taken per second?
screen_x          <- 1920 # screen width in pixels
screen_y          <- 1080 # screen heigh in pixels
resolution        <- 23   # screen size in inches
left_aoi          <- c(280, 780, 290, 790) # left AOI coords
right_aoi         <- c(1140, 1640, 290, 790) # right AOI coords

# load functions
source("wrapper_functions.R")

#### simulate data ######################################
dat <- expand_grid(participant = paste0("participant", 1:10),
                   trial = 1:10,
                   time = seq(0, 2000, by = 1000/sampling_rate)) %>% 
  # simulate gaze across trials; simulate gaze validity by flagging as invalid samples out of screen 
  mutate(gaze_x = rnorm(n = nrow(.), mean = (screen_x/2), sd = (screen_x/4)),
         gaze_y = rnorm(n = nrow(.), mean = (screen_y/2), sd = (screen_y/4)),
         validity = between(gaze_x, 0, screen_x) & between(gaze_y, 0, screen_y)) %>% 
  # randomly allocate each trial to one target location and one experimental condition
  group_by(participant, trial) %>% 
  mutate(t_location = sample(c("right", "left"), size = 1),
         trial_type = sample(c("prime", "control"), size = 1)) %>% 
  ungroup() %>% 
  # evaluate if gaze is in target or distractor AOIs using wrapper functions (see functions.R)
  mutate(t_gaze = target_coords(data = ., x_gaze = gaze_x,
                                y_gaze = gaze_y,
                                l_coords = left_aoi,
                                r_coords = right_aoi,
                                target_location = t_location),
         d_gaze = distractor_coords(data = ., x_gaze = gaze_x,
                                    y_gaze = gaze_y,
                                    l_coords = left_aoi,
                                    r_coords = right_aoi,
                                    target_location = t_location)) %>% 
  select(-c(gaze_x, gaze_y)) # raw gaze coords are no longer necessary for eyetrackingR, but it doesn't hurt to keep them


#### eyetrackingR ###################################################
# introduce the data to eyetrackingR
dat_eyetracking <- make_eyetrackingr_data(data = dat,
                                          participant_column = "participant",
                                          trackloss_column   = "validity",
                                          time_column        = "time",
                                          trial_column       = "trial",
                                          aoi_columns        = c("t_gaze", "d_gaze"),
                                          treat_non_aoi_looks_as_missing = FALSE) %>% 
  # keep only time window of interest and re-centre the time
  subset_by_window(rezero = TRUE, remove = TRUE, window_start_time = 233, window_end_time = 2000)

wrapper_functions.R

#### wrapper functions ####################

# for evaluating whether gaze is in target
target_coords <- function(data, x_gaze, y_gaze, target_location,
                          l_coords = c(280, 780, 290, 790),
                          r_coords = c(1140, 1640, 290, 790)){
  require(rlang, quietly = TRUE, warn.conflicts = FALSE)
  require(dplyr, quietly = TRUE, warn.conflicts = FALSE)

  {{ data }} %>%
    mutate(
      t_xmin = case_when(({{ target_location }} == "right") ~ r_coords[1],
                         ({{ target_location }} == "left")  ~ l_coords[1],
                         TRUE                               ~ NA_real_),
      t_xmax = case_when(({{ target_location }} == "right") ~ r_coords[2],
                         ({{ target_location }} == "left")  ~ l_coords[2],
                         TRUE                               ~ NA_real_),
      t_ymin = case_when(({{ target_location }} == "right") ~ r_coords[3],
                         ({{ target_location }} == "left")  ~ l_coords[3],
                         TRUE                               ~ NA_real_),
      t_ymax = case_when(({{ target_location }} == "right") ~ r_coords[4],
                         ({{ target_location }} == "left")  ~ l_coords[4],
                         TRUE                               ~ NA_real_),
      gazeT = (({{x_gaze}} >= t_xmin) & ({{x_gaze}} <= t_xmax) & ({{y_gaze}} >= t_ymin) & ({{y_gaze}} <= t_ymax)),
    ) %>%
    pull(gazeT)
}

  # for evaluating whether gaze is in distractor
distractor_coords <- function(data, x_gaze, y_gaze, target_location,
                              l_coords = c(280, 780, 290, 790),
                              r_coords = c(1140, 1640, 290, 790)){
    require(rlang, quietly = TRUE, warn.conflicts = FALSE)
  require(dplyr, quietly = TRUE, warn.conflicts = FALSE)
  
  {{ data }} %>%
    mutate(
      d_xmin = case_when(({{ target_location }} == "left")  ~ r_coords[1],
                         ({{ target_location }} == "right") ~ l_coords[1],
                         TRUE                               ~ NA_real_),
      d_xmax = case_when(({{ target_location }} == "left")  ~ r_coords[2],
                         ({{ target_location }} == "right") ~ l_coords[2],
                         TRUE                               ~ NA_real_),
      d_ymin = case_when(({{ target_location }} == "left")  ~ r_coords[3],
                         ({{ target_location }} == "right") ~ l_coords[3],
                         TRUE                               ~ NA_real_),
      d_ymax = case_when(({{ target_location }} == "left")  ~ r_coords[4],
                         ({{ target_location }} == "right") ~ l_coords[4],
                         TRUE                               ~ NA_real_),
      gazeD = (({{x_gaze}} >= d_xmin) & ({{x_gaze}} <= d_xmax) & ({{y_gaze}} >= d_ymin) & ({{y_gaze}} <= d_ymax))
    ) %>%
    pull(gazeD)
}