Our goal today is to prepare our eyetracking data to be inserted into a database.
For database normalization, we want there to be five tables:
The first three tables are meant to be nice and nested "wide" dataframes. We have looks nested in trials nested in experiment administrations, and each row is one thing (a frame, a trial, an experiment). These three tables are experiment agnostic.
The other tables are meant to be a grab-bag of key-value pairs, containing things like the target word of each trial or the dialect of the experiment administration. These will be "long" dataframes, such that there are multiple rows for a single trial or experiment. The specific attributes that differentiate trials and experiments live in these tables. These tables will allow the other three to be completely task agnostic.
Use lookr to load and reduce some eye-tracking data.
library("knitr") library("lookr") library("dplyr") # manipulate tables library("tidyr") # wide/long tables opts_chunk$set(comment = "#>", collapse = TRUE)
# Load some example data bundled in lookr mp_long <- file.path(find.package("lookr"), "docs/data/MP_WFFArea_Long/") trials <- suppressMessages(Task(mp_long)) trials # Light preprocessing: Set time 0 to target onset, map gaze locations to AOIs, # interpolate spans of missing data up to 150ms in duration trials <- AdjustTimes(trials, "TargetOnset") # Can save a lot of space by just keep the looks from after the speech starts trials <- TimeSlice(trials, from = "CarrierOnset") trials <- AddAOIData(trials) trials <- InterpolateMissingFrames(trials) # Perform a bias calculation as in the RWL paper. (Measures the most viewed # image during a time window.) bias_window <- c(0, 245) trials <- CalculateBias(trials, bias_window)
Note that each Trial
object is just data.frame
with several associated
attributes
.
print(trials[[1]], width = 80, strict.width = "wrap")
Extracting just the data-frame parts and combining them will provide us with the rows for the Frames table. The Experiments/Trials rows will come from the attributes.
To link trials to administrations, we will create a new attribute TrialName
attibute that will uniquely identify trials.
# Uniquely name each trial trials %@% "TrialName" <- sprintf("%s_%02.0f", trials %@% "Basename", trials %@% "TrialNo")
Now we can create the three main "wide" (task-invariant) tables. We Basename
to link experiment administrations to TrialName
and TrialName
to link to
eye-tracking frames.
tbl_exps <- trials %>% gather_attributes(c("Basename", "DateTime", "Subject", "Task")) %>% as_data_frame %>% distinct tbl_exps tbl_trials <- trials %>% gather_attributes(c("TrialName", "Basename", "TrialNo")) %>% as_data_frame %>% distinct tbl_trials # Make a function that extracts the columns of gaze data from a Trial, then # apply it to each Trial collect_looks <- function(x) { x_name <- x %@% "TrialName" # c(x) to strip attributes x <- c(x) %>% as_data_frame %>% mutate(TrialName = x_name) %>% select(TrialName, Time, XMean, YMean, GazeByImageAOI, GazeByAOI) x } looks <- trials %>% purrr::map_df(collect_looks) # Convert screen proportions to pixel locations tbl_looks <- looks %>% mutate(XMean = round(XMean * lwl_constants$screen_width), YMean = round(YMean * lwl_constants$screen_height)) pryr::object_size(tbl_looks) tbl_looks
Now we need to make the grab-bags of trial and experiment attributes. But first let's unpack the implicit AOI definitions used in the experiments.
library("tidyr") library("stringr") # hard-coded inside lookr:::GetImageAOI AOIs <- list( UpperLeftImage = list(x_pix = c(410, 860), y_pix = c(700, 1150)), LowerLeftImage = list(x_pix = c(410, 860), y_pix = c(50, 500)), UpperRightImage = list(x_pix = c(1060, 1510), y_pix = c(700, 1150)), LowerRightImage = list(x_pix = c(1060, 1510), y_pix = c(50, 500)), FixationImage = list(x_pix = c(885, 1035), y_pix = c(525, 675)), ImageL = list(x_pix = c(100, 700), y_pix = c(300, 900)), ImageR = list(x_pix = c(1220, 1820), y_pix = c(300, 900))) # Break apart names from unlist(...) into separate columns aoi_table <- unlist(AOIs) %>% data_frame(Image = names(.), Pixel = .) %>% separate(Image, into = c("AOI", "Dimension", "Number")) %>% mutate(Number = str_replace(Number, "pix", ""), AOIBoundary = "AOI_Boundary") # Keep only values used in the data and combine columns into Key, Value aoi_table <- aoi_table %>% filter(AOI %in% unique(looks$GazeByAOI)) %>% unite(col = AOI_Boundary, AOIBoundary, AOI:Number) %>% rename(Key = AOI_Boundary, Value = Pixel) aoi_table
Now we assembly the experiment key-value grab-bag and attach the AOI definitions.
# Gather experiment attributes tbl_exps_gb <- trials %>% gather_attributes(c("Basename", "Dialect", "Protocol")) %>% as_data_frame %>% distinct %>% # Other hard-wired constants mutate(FrameRate = lwl_constants$ms_per_frame, ScreenWidth = lwl_constants$screen_width, ScreenHeight = lwl_constants$screen_height) %>% gather(key = Key, value = Value, -Basename) # # # Create all combinations of basename and AOI property name # aoi_rows <- list(Basename = tbl_exps$Basename, Key = aoi_table$Key) %>% # cross_n %>% # bind_rows %>% # left_join(aoi_table) %>% # mutate(Value = as.character(Value)) # aoi_rows # # # Combine AOI attributes with other ones # tbl_exps_attrs <- bind_rows(tbl_exps_gb, aoi_rows) %>% # arrange(Basename, Key) tbl_exps_attrs <- tbl_exps_gb tbl_exps_attrs
Now we can do the trials attributes.
# Collect the attributes that have only one value for a trial trial_attrs <- c("TrialName", "StimType", "WordGroup", "TargetWord", "TargetImage", "DistractorImage", "ImageL", "ImageR", "FamiliarImage", "UnfamiliarImage", "Audio", "Attention", "InterpolationWindow", # trial events "ImageOnset", "FixationOnset", "FixationDur", "CarrierOnset", "CarrierEnd", "TargetOnset", "TargetEnd", "AttentionOnset", "AttentionEnd") tbl_trial_attrs_gb <- trials %>% gather_attributes(trial_attrs, omit_na = TRUE) %>% as_data_frame %>% gather(Key, Value, -TrialName) %>% mutate(Key = as.character(Key)) # Collect the times of frames that underwent interpolation. Since there are # zero-to-many such frames for a trial, handle these separately. Use a function # to solve problem for one Trial, then map to all trials get_corrected_times <- function(x) { corrections <- x %@% "CorrectedTimes" names(corrections) <- rep("InterpolatedTime", length(corrections)) data_frame( TrialName = rep(x %@% "TrialName", length(corrections)), Key = names(corrections), Value = as.character(corrections)) } interpolated_times <- trials %>% purrr::map_df(get_corrected_times) # Do something similar with the bias measurements. Create a dataframe # summarizing which AOI was viewed the most/earliest during the bias window. get_bias_measures <- function(x, window) { bias_df <- x %@% "BiasSummary" if (nrow(bias_df) != 0) { # If eyetracking data available, return which image had most bias bias_df <- bias_df %>% filter(Bias == max(Bias)) %>% select(Bias_ImageAOI = GazeByImageAOI, Bias_FrameCount = Frames) } else { # Otherwise, give NAs bias_df <- data_frame(Bias_ImageAOI = NA, Bias_FrameCount = NA) } bias_df <- bias_df %>% mutate(TrialName = x %@% "TrialName", Bias_WindowStart = min(window), Bias_WindowEnd = max(window)) bias_df } bias_summary <- trials %>% purrr::map_df(get_bias_measures, window = bias_window) %>% gather(Key, Value, -TrialName) tbl_trial_attrs <- tbl_trial_attrs_gb %>% bind_rows(interpolated_times, bias_summary) %>% arrange(TrialName, Key, Value) pryr::object_size(tbl_trial_attrs) tbl_trial_attrs tbl_trial_attrs %>% distinct(Key)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.