utils::globalVariables(
c("XLeft", "XRight", "XMean", "YLeft", "YRight", "YMean",
"ZLeft", "ZRight", "DiameterLeft", "DiameterRight",
"Location", "Stimulus", "DwellTime", "TotalDwellTime",
"Others", "Target", "NAs", "Elsewhere", "Proportion", "Looks",
"Time", "Frames", "WindowDur", "LastPossible", "FirstLook", "Weight",
"Earliness"),
add = TRUE)
#' Transform gazedata coordinates into AOI data
#'
#' AddAOIData() adds two new columns to the gazedata in a Trial object: (1)
#' \code{GazeByAOI}, the screen-location of the image where the gaze is fixated
#' (e.g., \code{ImageL} or \code{UpperLeftImage}) and (2) \code{GazeByImageAOI},
#' the stimulus contained in the image where the gaze is fixated (e.g.,
#' \code{TargetImage} or \code{PhonologicalFoil}).
#'
#' If the gaze is tracked but not fixated to a particular image on the screen,
#' it gets the default value of \code{tracked}. If the gaze is missing during a
#' particular frame, the value is \code{NA}.
#'
#' "AOI" stands for Area of Interest.
#'
#' @param x a Trial with \code{Task} or \code{Protocol} attributes or a
#' TrialList where each Trial has these attributes
#' @return the Trial object(s) with the AOI data attached as new columns.
#' @export
AddAOIData <- function(x) UseMethod("AddAOIData")
#' @export
AddAOIData.TrialList <- function(x) trial_lapply(x, AddAOIData)
#' @export
AddAOIData.Trial <- function(x) {
trial <- x
stim <- LookUpAOIs(trial)
# By default we set all values as `tracked`.
number_of_frames <- nrow(trial)
gaze_by_image_aoi <- rep("tracked", times = number_of_frames)
gaze_by_aoi <- rep("tracked", times = number_of_frames)
# If the gaze is in a specific AOI, overwrite `tracked` in the AOI location
# and AOI stimuli vectors.
for (i in seq_along(stim)) {
stim_img <- stim[[i]]
stim_name <- names(stim)[i]
location <- trial %@% stim_img
img_AOI <- GetImageAOI(location)
gaze_at_location <- GetFramesWithGazeInAOI(trial, img_AOI)
gaze_by_image_aoi[gaze_at_location] <- stim_name
gaze_by_aoi[gaze_at_location] <- location
}
# Overwrite `tracked` with `NA` when the x or y gaze values were not tracked.
gaze_mistracked <- is.na(trial$XMean) | is.na(trial$YMean)
gaze_by_image_aoi[gaze_mistracked] <- NA
gaze_by_aoi[gaze_mistracked] <- NA
# Add the AOI columns to the trial
trial$GazeByAOI <- gaze_by_aoi
trial$GazeByImageAOI <- gaze_by_image_aoi
trial
}
# Use task and protocol attributes to determine which stimuli and AOI are used.
LookUpAOIs <- function(trial) {
stim <- if (trial %@% "Task" == "RWL") {
list(Target = "TargetImage",
SemanticFoil = "SemanticFoilImage",
PhonologicalFoil = "PhonologicalFoilImage",
Unrelated = "UnrelatedImage")
} else {
list(Target = "TargetImage", Distractor = "DistractorImage")
}
# The WFF_Movie protocol has an additional AOI.
if (trial %@% "Protocol" == "WFF_Movie") {
stim <- c(stim, Fixation = "FixationImage")
}
stim
}
#' Get frames with gazedata within an Area of interest
#'
#' @keywords internal
#' @param trial a Trial with \code{XMean} and \code{YMean} columns.
#' @param img_AOI the coordinates of a rectangular Area of Interest given in
#' screen proportions.
#' @return a vector of boolean values indicating whether the gaze values fall
#' into the AOI at each time point in the trial.
GetFramesWithGazeInAOI <- function(trial, img_AOI) {
x_bounds <- img_AOI$x
y_bounds <- img_AOI$y
# A gaze is in an AOI if both the x and y gazes fall inside its boundaries
gaze_in_x_bounds <- CheckLooksInBounds(trial$XMean, x_bounds[1], x_bounds[2])
gaze_in_y_bounds <- CheckLooksInBounds(trial$YMean, y_bounds[1], y_bounds[2])
gaze_in_aoi <- gaze_in_x_bounds & gaze_in_y_bounds
gaze_in_aoi
}
#' Check whether values in a vector each fall between an upper and lower bound
#'
#' @keywords internal
#' @param xs a set of x or y gaze coordinates
#' @param lower_bound the lower bound of the range to check
#' @param upper_bound the upper bound of the range to check
#' @return a vector of boolean values indicating whether each x in \code{xs}
#' falls between the lower bound and upper bound (inclusive). \code{NA} values
#' in \code{xs} are missing looks so they are reported as \code{FALSE}.
CheckLooksInBounds <- function(xs, lower_bound, upper_bound) {
gaze_in_bounds <- lower_bound <= xs & xs <= upper_bound
gaze_in_bounds[is.na(gaze_in_bounds)] <- FALSE
gaze_in_bounds
}
#' Get the boundaries of an Area of Interest from its name
#'
#' @keywords internal
#' @param image_location a string naming an image location. It may be:
#' \code{UpperLeftImage}, \code{UpperRightImage}, \code{LowerRightImage},
#' \code{LowerLeftImage}, \code{FixationImage}, \code{ImageL}, or
#' \code{ImageR}.
#' @return a list specifying the boundaries of the named AOI
GetImageAOI <- function(image_location) {
# Stop on non-string input
if (!is.character(image_location)) stop("Invalid AOI name (not a string)")
AOIs <- list(
# Four image (RWL) tasks
UpperLeftImage = AOI(x_pix = c(410, 860), y_pix = c(700, 1150)),
LowerLeftImage = AOI(x_pix = c(410, 860), y_pix = c(50, 500)),
UpperRightImage = AOI(x_pix = c(1060, 1510), y_pix = c(700, 1150)),
LowerRightImage = AOI(x_pix = c(1060, 1510), y_pix = c(50, 500)),
# Wait for fixation tasks
FixationImage = AOI(x_pix = c(885, 1035), y_pix = c(525, 675)),
# Two image (MP) tasks
ImageL = AOI(x_pix = c(100, 700), y_pix = c(300, 900)),
ImageR = AOI(x_pix = c(1220, 1820), y_pix = c(300, 900))
)
if (!is.element(image_location, names(AOIs))) {
stop(paste0("Invalid AOI name: \"", image_location, "\""))
}
AOIs[[image_location]]
}
#' Convert pixel locations of an image to proportion-on-screen location
#'
#' AOI is a utility function for converting the pixel locations of the x- and
#' y-boundaries of an image to screen proportions. Note that the coordinate
#' (0,0) is the lower-left corner of the screen.
#'
#' @keywords internal
#' @param x_pix location (in pixels) of the left and right edges of the AOI
#' @param y_pix location (in pixels) of the upper and lower edges of the AOI
#' @param width width of the screen (in pixels)
#' @param height height of the screen (in pixels)
#' @return A list of the form \code{list(x = (left_prop, right_prop), y =
#' (lower_prop, upper_prop))}, where \code{prop} values describe the locations
#' of the boundaries in terms of screen proportion.
AOI <- function(x_pix, y_pix, width = lwl_constants$screen_width, height = lwl_constants$screen_height) {
# Compute AOI boundaries in proportions of the screen, using the lower-left
# corner as the origin.
left_prop <- min(x_pix) / width
right_prop <- max(x_pix) / width
lower_prop <- min(y_pix) / height
upper_prop <- max(y_pix) / height
# Bundle the screen proportions of the x- and y-boundaries in a list.
structure(list(
x = c(left_prop, right_prop),
y = c(lower_prop, upper_prop)), class = "AOI")
}
#' Find gaze location relative to target image
#'
#' Creates new columns that measure gaze location relative to the location of
#' the target image, so that the x and y gaze positions increase the gaze gets
#' closer to the target. The new columns are \code{XLeftToTarget},
#' \code{XRightToTarget}, \code{XMeanToTarget}, \code{YLeftToTarget},
#' \code{YRightToTarget}, \code{YMeanToTarget}.
#'
#' @details Normally, the x value (as in \code{trial$XMean}) increases as the gaze
#' moves right on screen. When the target is left side of the screen, small x
#' means the gaze approached the target, but when the target image is on the
#' right, larger x means the gaze approached the target. This function flips
#' the x value (sets x to 1-x) on trials where the target is on the left side
#' of the screen, so that bigger x means the gaze approached the target
#' regardless of which side of the screen the target was on. An analogous
#' transformation is done for the y coordinate.
#'
#' @param x a Trial with \code{Task} or \code{Protocol} attributes or a
#' TrialList where each Trial has these attributes
#' @return the Trial object(s) with the AOI data attached as new columns.
#' @export
AddRelativeGazes <- function(x) UseMethod("AddRelativeGazes")
#' @export
AddRelativeGazes.TrialList <- function(x) trial_lapply(x, AddRelativeGazes)
#' @export
AddRelativeGazes.Trial <- function(x) {
trial <- x
target_image <- trial %@% "TargetImage"
trial <- within(trial, {
# If the target image was on the left half of the screen, then the
# X__ToTarget gazedata is the inverse of the corresponding X__ gazedata.
if (is_image_on_left(target_image)) {
XLeftToTarget <- 1 - XLeft
XRightToTarget <- 1 - XRight
XMeanToTarget <- 1 - XMean
} else {
XLeftToTarget <- XLeft
XRightToTarget <- XRight
XMeanToTarget <- XMean
}
# If the target image was on the lower half of the screen, then the
# Y__ToTarget gazedata is the inverse of the corresponding Y__ gazedata.
if (is_image_on_bottom(target_image)) {
YLeftToTarget <- 1 - YLeft
YRightToTarget <- 1 - YRight
YMeanToTarget <- 1 - YMean
} else {
YLeftToTarget <- YLeft
YRightToTarget <- YRight
YMeanToTarget <- YMean
}
})
trial
}
is_image_on_left <- function(image) {
str_detect(image, "left|Left|^ImageL$")
}
is_image_on_bottom <- function(image) {
str_detect(image, "lower|Lower")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.