diff --git a/documentation/imotionsApi_2.9.4.2.pdf b/documentation/imotionsApi_2.9.4.2.pdf new file mode 100644 index 0000000..ed4ad18 Binary files /dev/null and b/documentation/imotionsApi_2.9.4.2.pdf differ diff --git a/documentation/imotionsApi_2.9.5.pdf b/documentation/imotionsApi_2.9.5.pdf deleted file mode 100644 index f4b8849..0000000 Binary files a/documentation/imotionsApi_2.9.5.pdf and /dev/null differ diff --git a/imotionsApi/DESCRIPTION b/imotionsApi/DESCRIPTION index 45ffd3b..8b56c31 100644 --- a/imotionsApi/DESCRIPTION +++ b/imotionsApi/DESCRIPTION @@ -1,7 +1,7 @@ Package: imotionsApi Type: Package Title: iMotions R library -Version: 2.9.5-0000000000 +Version: 2.9.4.2-0000000000 Date: 2026-07-08 Authors@R: c( person("Amandine", "Grappe", role = "aut"), diff --git a/imotionsApi/NAMESPACE b/imotionsApi/NAMESPACE index 553dc10..4bcd975 100644 --- a/imotionsApi/NAMESPACE +++ b/imotionsApi/NAMESPACE @@ -7,6 +7,9 @@ S3method(getAoiDetailsUrl,imStimulus) S3method(getAoiMetricsUrl,imRespondent) S3method(getSensorsUrl,imRespondent) S3method(getSensorsUrl,imSegment) +S3method(getTouchActorDetailsUrl,imStimulus) +S3method(getTouchActorDetailsUrl,imTouchAOI) +S3method(getTouchActorDetailsUrl,imTouchActor) S3method(getUploadAoiMetricsUrl,imRespondent) S3method(getUploadAoiMetricsUrl,imSegment) S3method(getUploadEventsUrl,imRespondent) @@ -22,6 +25,7 @@ S3method(privateAoiFiltering,imStudy) S3method(privateRespondentFiltering,imAOI) S3method(privateRespondentFiltering,imStimulus) S3method(privateRespondentFiltering,imStudy) +S3method(privateRespondentFiltering,imTouchAOI) S3method(privateUploadAoiMetrics,imRespondent) S3method(privateUploadAoiMetrics,imSegment) export(convertRecordingTsToIntervals) @@ -29,6 +33,8 @@ export(createExport) export(getAoi) export(getAoiRespondentData) export(getAoiRespondentMetrics) +export(getAoiRespondentTouchData) +export(getAoiRespondentTouchMetrics) export(getAois) export(getRespondent) export(getRespondentIntervals) @@ -40,6 +46,10 @@ export(getSensors) export(getSensorsMetadata) export(getStimuli) export(getStimulus) +export(getTouchActor) +export(getTouchActorAoi) +export(getTouchActorAois) +export(getTouchActors) export(imConnection) export(imStudy) export(listLoadedStudies) diff --git a/imotionsApi/R/imotionsApi.R b/imotionsApi/R/imotionsApi.R index 76f3d11..938aabf 100644 --- a/imotionsApi/R/imotionsApi.R +++ b/imotionsApi/R/imotionsApi.R @@ -707,7 +707,9 @@ getAoi <- function(study, AOIId) { #' #' @param study An imStudy object as returned from \code{\link{imStudy}}. #' @param stimulus Optional - An imStimulus object as returned from \code{\link{getStimuli}}. -#' @param AOI Optional - An imAOI object as returned from \code{\link{getAois}}. +#' @param AOI Optional - An imAOI object as returned from \code{\link{getAois}}, or an imTouchAOI object as returned +#' from \code{\link{getTouchActorAois}} to get the respondents that have contact data for that specific +#' touch actor AOI instead of gaze data. #' @param segment Optional - An imSegment object as returned from \code{\link{getSegments}}. #' @param keepRespondentVariables Optional - A boolean indicating whether respondent variables should be kept (if they #' are available). If this has the default value of FALSE, only the "group" variable is @@ -736,6 +738,11 @@ getAoi <- function(study, AOIId) { #' ## Get all respondents for whom a specific AOI has been defined #' respondents <- imotionsApi::getRespondents(study, AOI = AOIs[1, ]) #' +#' ## Get all respondents that have contact data for a specific touch actor AOI +#' respondent <- imotionsApi::getRespondents(study)[1, ] +#' touchAoi <- imotionsApi::getTouchActorAois(study, stimuli[1, ], respondent)[1, ] +#' respondents <- imotionsApi::getRespondents(study, AOI = touchAoi) +#' #' ## Get all respondents in a specific segment exposed to a specific stimulus #' respondents <- imotionsApi::getRespondents(study, stimulus = stimuli[1, ], segment = segments[1, ]) #' @@ -870,6 +877,39 @@ privateRespondentFiltering.imAOI <- function(study, obj) { } +#' Get respondents that have contact data for a specific touch actor AOI. +#' +#' S3 method to get all respondents with contact in/out data for a specific (touch actor, AOI) pair. This exists +#' because \code{\link{privateRespondentFiltering.imAOI}} resolves respondents through the gaze in/out endpoint, which +#' returns nothing on a study without eyetracking data - exactly the case contact metrics exist to support. +#' +#' Resolved with a single stimulus-wide, respondent-less call to \code{\link{privateGetTouchActorDetails}} (see +#' \code{\link{getTouchActorDetailsUrl.imStimulus}}), which returns contact details for every respondent exposed to +#' the stimulus in one response - kept are only the respondents whose own contact details contain a matching +#' (touchActorId, aoiId) pair. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param obj An imTouchAOI object as returned from \code{\link{getTouchActorAois}} for which you would like to get +#' the respondents. +#' +#' @return A data.table with all respondents that have contact data for this specific touch actor AOI. +#' @keywords internal +#' @exportS3Method privateRespondentFiltering imTouchAOI +privateRespondentFiltering.imTouchAOI <- function(study, obj) { + stimulus <- getStimulus(study, obj$stimulusId) + respondents <- privateRespondentFiltering.imStimulus(study, stimulus) + + details <- suppressWarnings(privateGetTouchActorDetails(study, stimulus)) + + if (is.null(details) || nrow(details) == 0) { + return(respondents[0, ]) + } + + matchingRespIds <- details[details$touchActorId == obj$touchActorId & details$aoiId == obj$id, ]$respId + return(respondents[respondents$id %in% matchingRespIds, ]) +} + + #' Get a specific respondent from a study. #' #' Available respondents can be found with \code{\link{getRespondents}}. @@ -1794,6 +1834,540 @@ privateGetAoiDetails <- function(study, imObject, respondent = NULL) { } +## Touch actors ======================================================================================================= + +#' Get all touch actors defined for a specific stimulus. +#' +#' A touch actor detects hand-to-object contact on a recorded video and marks a set of AOIs as interactive. Contact +#' detection runs in the iMotions desktop application only, so this returns NULL for a remote study. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param stimulus An imStimulus object as returned from \code{\link{getStimuli}}. +#' +#' @return An imTouchActorList object (data.table) with one row per touch actor, or NULL if none are defined. +#' @export +#' @examples +#' \dontrun{ +#' connection <- imotionsApi::imConnection("xxxxxxxx") +#' studies <- imotionsApi::listStudies(connection) +#' study <- imotionsApi::imStudy(connection, studies$id[1]) +#' stimuli <- imotionsApi::getStimuli(study) +#' touchActors <- imotionsApi::getTouchActors(study, stimuli[1, ]) +#' } +getTouchActors <- function(study, stimulus) { + assertValid(hasArg(study), "Please specify a study loaded with `imStudy()`") + assertValid(hasArg(stimulus), "Please specify a stimulus loaded with `getStimuli()`") + + assertClass(study, "imStudy", "`study` argument is not an imStudy object") + assertClass(stimulus, "imStimulus", "`stimulus` argument is not an imStimulus object") + + endpoint <- paste0("Stimulus: ", stimulus$name) + + if (!study$connection$localIM) { + warning(paste("Touch actors are only available for local studies, none retrieved for", endpoint)) + return(NULL) + } + + touchActors <- getJSON(study$connection, getTouchActorsUrl(study, stimulus$id), + message = paste("Retrieving touch actors for", endpoint)) + + if (length(touchActors) == 0 || nrow(touchActors) == 0) { + warning(paste("No touch actor defined for", endpoint)) + return(NULL) + } + + setDT(touchActors) + + # The endpoint reports the stimulus database id as a number, while every other imObject carries it as a string + # (see privateAoiFormatting) - matching that here keeps joins against AOIs and stimuli working. + touchActors$stimulusId <- as.character(touchActors$stimulusId) + + setcolorder(touchActors, c("stimulusId", "stimulusName", "id", "name")) + touchActors <- createImObject(touchActors, "TouchActor") + return(touchActors) +} + + +#' Get a specific touch actor from a stimulus. +#' +#' Available touch actors can be found with \code{\link{getTouchActors}}. Passing the result on to +#' \code{\link{getTouchActorAois}} (instead of the whole stimulus) scopes the underlying contact detail fetch to just +#' this actor - see \code{getTouchActorDetailsUrl.imTouchActor} - rather than triggering signal generation for every +#' touch actor on the stimulus. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param stimulus An imStimulus object as returned from \code{\link{getStimuli}}. +#' @param touchActorId The id of the touch actor you would like to retrieve. +#' +#' @return An imTouchActor object (data.table) containing the touch actor of interest, or NULL if none is defined +#' for this stimulus or none matches touchActorId. +#' @export +#' @examples +#' \dontrun{ +#' connection <- imotionsApi::imConnection("xxxxxxxx") +#' studies <- imotionsApi::listStudies(connection) +#' study <- imotionsApi::imStudy(connection, studies$id[1]) +#' stimulus <- imotionsApi::getStimuli(study)[1, ] +#' touchActors <- imotionsApi::getTouchActors(study, stimulus) +#' touchActor <- imotionsApi::getTouchActor(study, stimulus, touchActors$id[1]) +#' } +getTouchActor <- function(study, stimulus, touchActorId) { + assertValid(hasArg(touchActorId), + "Please specify a touchActorId. Available touch actors can be found with `getTouchActors()`") + + touchActors <- getTouchActors(study, stimulus) + + if (is.null(touchActors)) { + return(NULL) + } + + touchActor <- touchActors[touchActors$id == touchActorId, ] + + if (nrow(touchActor) == 0) { + warning(paste("No touch actor found matching id:", touchActorId)) + return(NULL) + } + + return(touchActor) +} + + +#' Get the AOI definitions of every camera that supports contact, for a stimulus. +#' +#' Sibling of \code{\link{privateAoiFiltering}} for touch actors: that one only ever reaches the Stimulus/Scene +#' camera, while a touch actor's interactive AOIs can live on any camera contact detection supports (e.g. +#' Environment). Used by \code{\link{getTouchActorAois}} to resolve a name/type/group/area for every touch actor AOI, +#' not just the ones on Scene. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param stimulus An imStimulus object as returned from \code{\link{getStimuli}}. +#' +#' @return A data.table with one row per AOI (id, name, type, group, area, mediaSourceType) across every touch-capable +#' camera, or NULL if none are defined. +#' @keywords internal +privateGetTouchActorAoiDefinitions <- function(study, stimulus) { + endpoint <- paste0("Stimulus: ", stimulus$name) + + if (!study$connection$localIM) { + warning(paste("Contact AOI definitions are only available for local studies, none retrieved for", endpoint)) + return(NULL) + } + + aois <- getJSON(study$connection, getTouchActorAoisUrl(study, stimulus$id), + message = paste("Retrieving contact AOI definitions for", endpoint)) + + if (length(aois) == 0 || nrow(aois) == 0) { + return(NULL) + } + + setDT(aois) + # Renamed by name rather than position: unlike privateAoiFormatting's positional AOIs$aois unnest, this endpoint + # returns a flat, already-scoped-to-one-stimulus list with no nested column to unnest. + setnames(aois, "aoiType", "type") + return(aois) +} + + +#' Get the interactive AOIs of a stimulus's touch actors, optionally paired with their contact in/out data. +#' +#' Each touch actor marks one or more AOIs as interactive, and contact is recorded per (touch actor, AOI) pair. This +#' returns one row per pair, plus the touch actor that produced it, so it can be used anywhere an imAOI is expected. +#' It also carries the AOI's own definition (name, type, group, area), resolved from whichever camera the AOI is +#' actually defined on (see \code{\link{privateGetTouchActorAoiDefinitions}}), so a touch actor on a non-Scene camera +#' (e.g. Environment) is labelled the same as one on Scene. +#' +#' Providing a respondent additionally attaches that respondent's contact in/out fileId/resultId to each row, +#' triggering generation of any signal that is missing or older than the contact detection result it derives from. +#' Without one, only the AOI/touch actor definitions are returned - use \code{\link{getRespondents}} (e.g. +#' \code{getRespondents(study, AOI = touchAoi)}) to find which respondents have contact data for a given row. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param imObject An imStimulus object as returned from \code{\link{getStimuli}} to return every touch actor's AOIs +#' on it, or an imTouchActor object as returned from \code{\link{getTouchActors}} to return only that +#' actor's AOIs. +#' @param respondent Optional - An imRespondent object as returned from \code{\link{getRespondents}} to attach that +#' respondent's contact in/out fileId/resultId to each row. +#' +#' @return An imTouchAOIList object (data.table, a subclass of imAOIList so shared AOI functions still accept it) +#' with one row per (touch actor, AOI) combination, or NULL if none exist. A single-row result is an +#' imTouchAOI, subclassing imAOI the same way. +#' @export +#' @examples +#' \dontrun{ +#' connection <- imotionsApi::imConnection("xxxxxxxx") +#' studies <- imotionsApi::listStudies(connection) +#' study <- imotionsApi::imStudy(connection, studies$id[1]) +#' stimulus <- imotionsApi::getStimuli(study)[1, ] +#' +#' ## List the touch actor AOIs defined for a stimulus, without triggering signal generation +#' touchAois <- imotionsApi::getTouchActorAois(study, stimulus) +#' +#' ## Get the respondents that have contact data for one of them +#' respondents <- imotionsApi::getRespondents(study, AOI = touchAois[1, ]) +#' +#' ## Attach the contact in/out file for a specific respondent +#' touchAois <- imotionsApi::getTouchActorAois(study, stimulus, respondents[1, ]) +#' +#' touchActor <- imotionsApi::getTouchActors(study, stimulus)[1, ] +#' touchAois <- imotionsApi::getTouchActorAois(study, touchActor, respondents[1, ]) # only that actor's AOIs +#' +#' print(touchAois$fileId) # path to the contact in/out file for each (touch actor, AOI) pair +#' } +getTouchActorAois <- function(study, imObject, respondent = NULL) { + assertValid(hasArg(study), "Please specify a study loaded with `imStudy()`") + assertValid(hasArg(imObject), + "Please specify a stimulus loaded with `getStimuli()` or a touch actor loaded with `getTouchActors()`") + + assertClass(study, "imStudy", "`study` argument is not an imStudy object") + assertClass(respondent, "imRespondent", "`respondent` argument is not an imRespondent object") + + if (inherits(imObject, "imTouchActor")) { + # Already a single touch actor row (e.g. from getTouchActors()) - reuse it directly rather than fetching + # every touch actor on the stimulus again just to filter back down to this one. + touchActors <- imObject + stimulus <- getStimulus(study, imObject$stimulusId) + } else { + assertClass(imObject, "imStimulus", "`imObject` argument is not an imStimulus or imTouchActor object") + stimulus <- imObject + touchActors <- getTouchActors(study, stimulus) + + if (is.null(touchActors)) { + return(NULL) + } + } + + # One row per (touch actor, AOI): interactiveAoiIds is a list column holding each actor's own AOI ids. + # stimulusId/stimulusName are carried from the touch actor itself rather than picked up from the AOI join below, + # so they still land on rows that join can't see - see the comment on that join for why some rows would be. + pairs <- data.table(touchActorId = touchActors$id, touchActorName = touchActors$name, hand = touchActors$hand, + detectionMethod = touchActors$detectionMethod, + mediaSourceType = touchActors$mediaSourceType, stimulusId = touchActors$stimulusId, + stimulusName = touchActors$stimulusName, aoiId = touchActors$interactiveAoiIds) + + pairs <- unnest(pairs, cols = c("aoiId")) + setDT(pairs) + + if (nrow(pairs) == 0) { + warning(paste("No interactive AOI defined for any touch actor on stimulus:", stimulus$name)) + return(NULL) + } + + if (is.null(respondent)) { + touchAois <- pairs + } else { + # imObject is never reassigned above, so it still carries whichever class the caller passed in + # (imTouchActor or imStimulus) - passing it straight through lets dispatch scope the fetch to just that + # actor when one was requested, rather than triggering generation for every touch actor on the stimulus. + details <- privateGetTouchActorDetails(study, imObject, respondent) + + if (is.null(details) || nrow(details) == 0) { + return(NULL) + } + + touchAois <- merge(pairs, details[, c("touchActorId", "aoiId", "fileId", "resultId")], + by = c("touchActorId", "aoiId")) + + if (nrow(touchAois) == 0) { + warning("The contact in/out signals found do not match any touch actor AOI for this respondent/stimulus ", + "combination.") + return(NULL) + } + } + + # Fetched across every touch-capable camera (not just Stimulus/Scene, unlike privateAoiFiltering), so a + # non-Scene touch actor's AOI resolves to its real name/type/group/area instead of NA. AOI ids are unique per + # camera's own model, so joining on id alone (without also matching mediaSourceType) is safe. + aois <- privateGetTouchActorAoiDefinitions(study, stimulus) + + if (is.null(aois)) { + touchAois[, c("name", "type", "group", "area") := list(NA_character_, NA_character_, NA_character_, + NA_real_)] + } else { + touchAois <- merge(touchAois, aois[, c("id", "name", "type", "group", "area")], by.x = "aoiId", by.y = "id", + all.x = TRUE) + } + + # Named `id` so the AOI - not the touch actor - is what an imAOI consumer sees, which is what makes + # uploadAoiMetrics() and addMetricsInfoAoi() usable unchanged. + setnames(touchAois, "aoiId", "id") + setcolorder(touchAois, c("stimulusId", "stimulusName", "id", "name", "type", "group", "area")) + touchAois <- createImObject(touchAois, "AOI") + + # Subclassing rather than leaving this as a plain imAOI keeps a regular gaze AOI from being accepted where a + # touch AOI is required (touchActorId is not something a gaze imAOI carries). Prepending onto the class + # createImObject() just set keeps every shared AOI function working unchanged through inheritance. + if (inherits(touchAois, "imAOIList")) { + class(touchAois) <- c("imTouchAOIList", class(touchAois)) + } else { + class(touchAois) <- c("imTouchAOI", class(touchAois)) + } + + return(touchAois) +} + + +#' Get the touch actor AOI(s) matching a specific aoiId. +#' +#' Calls \code{\link{getTouchActorAois}} and filters the result down to aoiId. Passing an imTouchActor pins the +#' search to that one actor, so the result is a single imTouchAOI row. Passing an imStimulus can still return more +#' than one row (an imTouchAOIList) if several touch actors share that interactive AOI. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param imObject An imStimulus object as returned from \code{\link{getStimuli}} to look across every touch actor on +#' it, or an imTouchActor object as returned from \code{\link{getTouchActor}}/ +#' \code{\link{getTouchActors}} to only look at that one actor. +#' @param aoiId The id of the AOI you would like to retrieve. +#' @param respondent Optional - An imRespondent object as returned from \code{\link{getRespondents}} to attach that +#' respondent's contact in/out fileId/resultId to the result. +#' +#' @return An imTouchAOI object (data.table) if imObject narrows the match to a single (touch actor, AOI) +#' combination, an imTouchAOIList if more than one touch actor shares aoiId, or NULL if none match. +#' @export +#' @examples +#' \dontrun{ +#' connection <- imotionsApi::imConnection("xxxxxxxx") +#' studies <- imotionsApi::listStudies(connection) +#' study <- imotionsApi::imStudy(connection, studies$id[1]) +#' stimulus <- imotionsApi::getStimuli(study)[1, ] +#' touchAois <- imotionsApi::getTouchActorAois(study, stimulus) +#' +#' touchActor <- imotionsApi::getTouchActor(study, stimulus, touchAois$touchActorId[1]) +#' touchAoi <- imotionsApi::getTouchActorAoi(study, touchActor, touchAois$id[1]) +#' } +getTouchActorAoi <- function(study, imObject, aoiId, respondent = NULL) { + assertValid(hasArg(imObject), + "Please specify a stimulus loaded with `getStimuli()` or a touch actor loaded with `getTouchActors()`") + assertValid(hasArg(aoiId), + "Please specify an aoiId. Available touch actor AOIs can be found with `getTouchActorAois()`") + + touchAois <- getTouchActorAois(study, imObject, respondent) + + if (is.null(touchAois)) { + return(NULL) + } + + touchAoi <- touchAois[touchAois$id == aoiId, ] + + if (nrow(touchAoi) == 0) { + warning(paste("No touch actor AOI found matching aoiId:", aoiId)) + return(NULL) + } + + return(touchAoi) +} + + +#' Get the contact in/out data for a specific (touch actor, AOI)/respondent combination. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param touchAoi One row of \code{\link{getTouchActorAois}}, i.e. an AOI carrying a contact in/out fileId. +#' @param respondent An imRespondent object as returned from \code{\link{getRespondents}}. +#' +#' @return A list with an inOutContact data.table (change-only rows of Timestamp, IsContactInAOI, HandType, HandId) +#' and an imIntervalList object with the AOI's active fragments. NULL if no in/out file was found. +#' @export +#' @examples +#' \dontrun{ +#' connection <- imotionsApi::imConnection("xxxxxxxx") +#' studies <- imotionsApi::listStudies(connection) +#' study <- imotionsApi::imStudy(connection, studies$id[1]) +#' stimulus <- imotionsApi::getStimuli(study)[1, ] +#' respondent <- imotionsApi::getRespondents(study, stimulus = stimulus)[1, ] +#' touchAois <- imotionsApi::getTouchActorAois(study, stimulus, respondent) +#' contactData <- imotionsApi::getAoiRespondentTouchData(study, touchAois[1, ], respondent) +#' +#' # Retrieving list items +#' inOutContact <- contactData$inOutContact +#' intervals <- contactData$intervals +#' } +getAoiRespondentTouchData <- function(study, touchAoi, respondent) { + # set local variable to remove warnings in `devtools::check()` + IsActiveAOI <- IsContactInAOI <- HandType <- NULL + + assertValid(hasArg(study), "Please specify a study loaded with `imStudy()`") + assertValid(hasArg(touchAoi), "Please specify a touch actor AOI loaded with `getTouchActorAois()`") + assertValid(hasArg(respondent), "Please specify a respondent loaded with `getRespondents()`") + + assertClass(study, "imStudy", "`study` argument is not an imStudy object") + assertClass(touchAoi, "imTouchAOI", "`touchAoi` argument is not an imTouchAOI object") + assertClass(respondent, "imRespondent", "`respondent` argument is not an imRespondent object") + + details <- privateGetTouchActorDetails(study, touchAoi, respondent) + + if (length(details) == 0 || nrow(details) == 0) { + warning(paste("No contact data found for AOI", touchAoi$name, "and respondent", respondent$name)) + return(NULL) + } + + namesInout <- c("IsActiveAOI", "IsContactInAOI") + notActivatedAOI <- FALSE + + if (file.info(details$fileId)$size == 0) { + # An empty placeholder is what the desktop writes when the AOI was never active during the recording. + notActivatedAOI <- TRUE + } else { + data <- read_parquet(details$fileId) + data <- data |> mutate_at(namesInout, as.logical) + setDT(data) + data[, HandType := privateDecodeHandType(HandType)] + } + + if (notActivatedAOI) { + intervals <- data.table(fragments.start = NA_real_, fragments.end = NA_real_) + inOutContact <- data.table(matrix(data = NA_integer_, ncol = 4, nrow = 0)) + names(inOutContact) <- c("Timestamp", "IsContactInAOI", "HandType", "HandId") + } else { + # The file always opens with an activation and closes with a deactivation, so these two are equal in length. + activityChange <- data[data[, .I[1], by = rleid(IsActiveAOI)]$V1, ] + intervals <- data.table(fragments.start = activityChange[(IsActiveAOI), ]$Timestamp, + fragments.end = activityChange[!(IsActiveAOI), ]$Timestamp) + + # Keyed on HandType as well as contact, so a left-to-right handover mid-contact stays visible rather than + # being attributed wholly to the hand that started it. + contactChange <- data[data[, .I[1], by = rleid(IsContactInAOI, HandType)]$V1, ] + inOutContact <- contactChange[, c("Timestamp", "IsContactInAOI", "HandType", "HandId")] + } + + intervals <- intervals[, let(fragments.duration = intervals$fragments.end - intervals$fragments.start, + name = touchAoi$name, type = "AOI", parentId = touchAoi$stimulusId, + parentName = touchAoi$stimulusName, id = touchAoi$id, text = NA_character_, + respondent = list(respondent))] + + intervals[is.na(intervals$fragments.duration), ]$fragments.duration <- 0 + intervals <- createImObject(intervals, "Interval") + return(list(inOutContact = inOutContact, intervals = intervals)) +} + + +#' Get the contact metrics for a specific (touch actor, AOI)/respondent combination. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param touchAoi One row of \code{\link{getTouchActorAois}}, i.e. an AOI carrying a contact in/out fileId. +#' @param respondent An imRespondent object as returned from \code{\link{getRespondents}}. +#' +#' @return A data.table of one row (imMetrics object) with the contact metrics, or NULL if none were computed yet. +#' @export +#' @examples +#' \dontrun{ +#' connection <- imotionsApi::imConnection("xxxxxxxx") +#' studies <- imotionsApi::listStudies(connection) +#' study <- imotionsApi::imStudy(connection, studies$id[1]) +#' stimulus <- imotionsApi::getStimuli(study)[1, ] +#' respondent <- imotionsApi::getRespondents(study, stimulus = stimulus)[1, ] +#' touchAois <- imotionsApi::getTouchActorAois(study, stimulus, respondent) +#' metrics <- imotionsApi::getAoiRespondentTouchMetrics(study, touchAois[1, ], respondent) +#' } +getAoiRespondentTouchMetrics <- function(study, touchAoi, respondent) { + assertValid(hasArg(study), "Please specify a study loaded with `imStudy()`") + assertValid(hasArg(touchAoi), "Please specify a touch actor AOI loaded with `getTouchActorAois()`") + assertValid(hasArg(respondent), "Please specify a respondent loaded with `getRespondents()`") + + assertClass(study, "imStudy", "`study` argument is not an imStudy object") + assertClass(touchAoi, "imTouchAOI", "`touchAoi` argument is not an imTouchAOI object") + assertClass(respondent, "imRespondent", "`respondent` argument is not an imRespondent object") + + endpoint <- paste0("AOI: ", touchAoi$name, ", Respondent: ", respondent$name) + details <- privateGetTouchActorDetails(study, touchAoi, respondent) + + if (length(details) == 0 || nrow(details) == 0) { + warning(paste("No contact data found for", endpoint)) + return(NULL) + } + + if (is.na(details$resultId)) { + warning(paste0("No contact metrics found for ", endpoint)) + return(NULL) + } + + metrics <- fread(details$resultId) + metrics <- checkDataFormat(metrics) + return(metrics) +} + + +#' Private function returning where a stimulus's or a touch actor AOI's contact in/out signals live. +#' +#' Requesting these generates any signal that is missing or older than the contact detection result it derives from, +#' so this is also what makes the files exist. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param imObject An imStimulus object (all touch actors on it), an imTouchActor object as returned from +#' \code{\link{getTouchActors}} (that actor's AOIs only), or an imTouchAOI object as returned from +#' \code{\link{getTouchActorAois}} (that specific (touch actor, AOI) pair only). +#' @param respondent Optional - An imRespondent object as returned from \code{\link{getRespondents}}. Without one, +#' details for every respondent exposed to the stimulus are returned in a single response, +#' disambiguated by the `respId` column. +#' +#' @return A data.frame with one row per (touch actor, AOI[, respondent]) combination that has an in/out signal. +#' @keywords internal +privateGetTouchActorDetails <- function(study, imObject, respondent = NULL) { + endpoint <- paste0(gsub("^im|List", "", class(imObject)[1]), ": ", imObject$name) + + if (!is.null(respondent)) { + endpoint <- paste0(endpoint, ", Respondent: ", respondent$name) + } + + if (!study$connection$localIM) { + warning(paste("Contact data is only available for local studies, none retrieved for", endpoint)) + return(NULL) + } + + if (exists("fileId", imObject)) { + # in case the in/out file was already generated, we just return its path + return(imObject) + } + + dataUrl <- getTouchActorDetailsUrl(study, imObject, respondent) + details <- getJSON(study$connection, dataUrl, message = paste("Retrieving contact details for", endpoint)) + + if (length(details) == 0) { + warning(paste(endpoint, "has no contact in/out signals, has contact detection been run?")) + return(NULL) + } + + # Filtering out combinations without data if any - a null fileId means detection never ran for that touch actor, + # as opposed to a 0-byte one, which means the AOI was simply never active. + details <- details[!is.na(details$fileId), ] + + if (inherits(imObject, "imTouchAOI")) { + # Narrow back down to the single (touch actor, AOI) pair, + # so a multi-AOI touch actor doesn't leak its other AOIs' data. + details <- details[details$touchActorId == imObject$touchActorId & details$aoiId == imObject$id, ] + } + + return(details) +} + + +#' Private function translating the numeric hand codes stored in a contact in/out file into readable labels. +#' +#' @param codes A numeric vector of hand codes as stored in the HandType column. +#' +#' @return A character vector with one label per code. A code with no value at all (no touch on this row, so hand +#' type does not apply) stays \code{NA} rather than getting a label of its own - only a code that carries +#' an actual value but isn't a recognised one falls back to \code{"Unknown"}. +#' @keywords internal +privateDecodeHandType <- function(codes) { + # Codes are defined by TouchActorSampleMetaData in the desktop application: 1 = left, 2 = right, 3 = unknown. + # A row with no contact carries no HandType value at all rather than a dedicated code for it, so that stays NA + # here rather than getting a label of its own. Anything else unrecognised is reported as unknown rather than + # dropped, so a bad code never silently becomes a missing value in the metrics. + labels <- c("Left", "Right", "Unknown") + index <- as.integer(codes) + + # A merely missing `codes` entry is already NA and so never out of range here, leaving it to resolve to NA via + # `labels[NA]` below rather than getting relabelled - only a code that carries an actual but unrecognised value + # (e.g. a negative one, which would otherwise silently map to `labels[0]` and shrink the result instead of + # producing a value to overwrite) falls back to "Unknown". + outOfRange <- !is.na(index) & (index < 1L | index > length(labels)) + index[outOfRange] <- NA_integer_ + + decoded <- labels[index] + decoded[outOfRange] <- "Unknown" + return(decoded) +} + + ## Uploading Data ===================================================================================================== #' Create a new sensor for a specific respondent/segment in a study. @@ -1889,7 +2463,8 @@ uploadSensorData <- function(params, study, data, target, sensorName, scriptName #' Upload metrics for a specific respondent and AOI in a study. #' #' @param study An imStudy object as returned from imStudy() -#' @param AOI An imAOI object as returned from \code{\link{getAois}}. +#' @param AOI An imAOI object as returned from \code{\link{getAois}}, or an imTouchAOI object as returned from +#' \code{\link{getTouchActorAois}} to upload metrics for that specific touch actor AOI instead. #' @param target The target respondent/segment for the sensor (an imRespondent/imSegment object as returned from #' \code{\link{getRespondents}} or \code{\link{getSegments}}). #' @param metrics A data.table containing the metrics to upload. @@ -1954,7 +2529,8 @@ privateUploadToPresignedUrl <- function(connection, uploadUrl, postData, fileNam #' #' @param study An imStudy object as returned from \code{\link{imStudy}}. #' @param obj An imRespondent or imSegment object of interest. -#' @param AOI An imAOI object as returned from \code{\link{getAois}}. +#' @param AOI An imAOI object as returned from \code{\link{getAois}}, or an imTouchAOI object as returned from +#' \code{\link{getTouchActorAois}}. #' @param metrics A data.table containing the metrics to upload. #' #' @keywords internal @@ -1972,7 +2548,13 @@ privateUploadAoiMetrics <- function(study, obj, AOI, metrics) { #' @keywords internal #' @exportS3Method privateUploadAoiMetrics imRespondent privateUploadAoiMetrics.imRespondent <- function(study, obj, AOI, metrics) { - AOIDetails <- privateGetAoiDetails(study, AOI, obj) + # A touch AOI happens to carry enough of the same shape (fileId included) that privateGetAoiDetails() would + # "work" on it too, but only incidentally - dispatch explicitly so that overlap isn't relied upon. + AOIDetails <- if (inherits(AOI, "imTouchAOI")) { + privateGetTouchActorDetails(study, AOI, obj) + } else { + privateGetAoiDetails(study, AOI, obj) + } if (length(AOIDetails) == 0) { warning(paste("AOI", AOI$name, "was not found for respondent", obj$name)) @@ -2929,6 +3511,113 @@ getAoiDetailsUrl.imStimulus <- function(study, imObject, respondent = NULL) { } +#' Return the path/url to the touch actors defined for a specific stimulus. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param stimulusId The id of the stimulus of interest. +#' +#' @keywords internal +getTouchActorsUrl <- function(study, stimulusId) { + file.path(getStudyBaseUrl(study), "touchactors", study$id, "stimuli", stimulusId) +} + + +#' Return the path/url to the AOI definitions of every camera that supports contact, for a specific stimulus. +#' +#' Unlike \code{\link{getAoisUrl}}, which only ever reaches the Stimulus/Scene camera, this reports one row per AOI +#' across every touch-capable camera (e.g. Environment), tagged with mediaSourceType. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param stimulusId The id of the stimulus of interest. +#' +#' @keywords internal +getTouchActorAoisUrl <- function(study, stimulusId) { + file.path(getTouchActorsUrl(study, stimulusId), "aois") +} + + +#' Generic getTouchActorDetailsUrl function that takes as parameter a study object, an imTouchAOI/imTouchActor/ +#' imStimulus object and, optionally, a respondent object. +#' +#' Return the path/url to the contact in/out details for one touch actor, or for every touch actor on a stimulus. +#' Contact detection is desktop-only, so this is only ever used for a local study. +#' +#' @param study An imStudy object as returned from \code{\link{imStudy}}. +#' @param imObject An imStimulus object, an imTouchActor object as returned from \code{\link{getTouchActors}}, or one +#' row of \code{\link{getTouchActorAois}}. +#' @param respondent Optional - An imRespondent object as returned from \code{\link{getRespondents}}. Without one, +#' the url targets every respondent exposed to the stimulus in a single response. +#' +#' @keywords internal +getTouchActorDetailsUrl <- function(study, imObject, respondent = NULL) { + UseMethod("getTouchActorDetailsUrl", object = imObject) +} + + +#' getTouchActorDetailsUrl.imTouchActor method to return the path/url to one touch actor's contact in/out details, +#' across every AOI it marks interactive. +#' +#' Produces the same url as \code{\link{getTouchActorDetailsUrl.imTouchAOI}} for the same actor - the endpoint is +#' scoped per touch actor either way, so which of the two dispatches only depends on whether the caller already +#' narrowed down to one (touch actor, AOI) pair or still has the bare touch actor. +#' +#' @inheritParams getTouchActorDetailsUrl +#' +#' @keywords internal +#' @exportS3Method getTouchActorDetailsUrl imTouchActor +getTouchActorDetailsUrl.imTouchActor <- function(study, imObject, respondent = NULL) { + url <- getTouchActorsUrl(study, imObject$stimulusId) + + if (!is.null(respondent)) { + url <- file.path(url, "respondent", respondent$id) + } + + url <- file.path(url, imObject$id) + return(url) +} + + +#' getTouchActorDetailsUrl.imTouchAOI method to return the path/url to one touch actor's contact in/out details. +#' +#' Unlike the gaze equivalent the wildcard sits on the touch actor rather than the AOI, because the endpoint reports +#' every AOI of the actors it matches in one response. Dispatching on imTouchAOI rather than imAOI matters here: an +#' ordinary gaze imAOI is not guaranteed to carry touchActorId, which this method relies on. +#' +#' @inheritParams getTouchActorDetailsUrl +#' +#' @keywords internal +#' @exportS3Method getTouchActorDetailsUrl imTouchAOI +getTouchActorDetailsUrl.imTouchAOI <- function(study, imObject, respondent = NULL) { + url <- getTouchActorsUrl(study, imObject$stimulusId) + + if (!is.null(respondent)) { + url <- file.path(url, "respondent", respondent$id) + } + + url <- file.path(url, imObject$touchActorId) + return(url) +} + + +#' getTouchActorDetailsUrl.imStimulus method to return the path/url to the contact in/out details of every touch actor +#' defined for a stimulus. +#' +#' @inheritParams getTouchActorDetailsUrl +#' +#' @keywords internal +#' @exportS3Method getTouchActorDetailsUrl imStimulus +getTouchActorDetailsUrl.imStimulus <- function(study, imObject, respondent = NULL) { + url <- getTouchActorsUrl(study, imObject$id) + + if (!is.null(respondent)) { + url <- file.path(url, "respondent", respondent$id) + } + + url <- file.path(url, "*") + return(url) +} + + #' Generic getAoiMetricsUrl function that takes as parameter a study, respondent object and AOI. #' #' Return the path/url to retrieve AOI metrics for the given object. diff --git a/imotionsApi/man/getAoiRespondentTouchData.Rd b/imotionsApi/man/getAoiRespondentTouchData.Rd new file mode 100644 index 0000000..215c419 --- /dev/null +++ b/imotionsApi/man/getAoiRespondentTouchData.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getAoiRespondentTouchData} +\alias{getAoiRespondentTouchData} +\title{Get the contact in/out data for a specific (touch actor, AOI)/respondent combination.} +\usage{ +getAoiRespondentTouchData(study, touchAoi, respondent) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{touchAoi}{One row of \code{\link{getTouchActorAois}}, i.e. an AOI carrying a contact in/out fileId.} + +\item{respondent}{An imRespondent object as returned from \code{\link{getRespondents}}.} +} +\value{ +A list with an inOutContact data.table (change-only rows of Timestamp, IsContactInAOI, HandType, HandId) + and an imIntervalList object with the AOI's active fragments. NULL if no in/out file was found. +} +\description{ +Get the contact in/out data for a specific (touch actor, AOI)/respondent combination. +} +\examples{ +\dontrun{ +connection <- imotionsApi::imConnection("xxxxxxxx") +studies <- imotionsApi::listStudies(connection) +study <- imotionsApi::imStudy(connection, studies$id[1]) +stimulus <- imotionsApi::getStimuli(study)[1, ] +respondent <- imotionsApi::getRespondents(study, stimulus = stimulus)[1, ] +touchAois <- imotionsApi::getTouchActorAois(study, stimulus, respondent) +contactData <- imotionsApi::getAoiRespondentTouchData(study, touchAois[1, ], respondent) + +# Retrieving list items +inOutContact <- contactData$inOutContact +intervals <- contactData$intervals +} +} diff --git a/imotionsApi/man/getAoiRespondentTouchMetrics.Rd b/imotionsApi/man/getAoiRespondentTouchMetrics.Rd new file mode 100644 index 0000000..0803d4d --- /dev/null +++ b/imotionsApi/man/getAoiRespondentTouchMetrics.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getAoiRespondentTouchMetrics} +\alias{getAoiRespondentTouchMetrics} +\title{Get the contact metrics for a specific (touch actor, AOI)/respondent combination.} +\usage{ +getAoiRespondentTouchMetrics(study, touchAoi, respondent) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{touchAoi}{One row of \code{\link{getTouchActorAois}}, i.e. an AOI carrying a contact in/out fileId.} + +\item{respondent}{An imRespondent object as returned from \code{\link{getRespondents}}.} +} +\value{ +A data.table of one row (imMetrics object) with the contact metrics, or NULL if none were computed yet. +} +\description{ +Get the contact metrics for a specific (touch actor, AOI)/respondent combination. +} +\examples{ +\dontrun{ +connection <- imotionsApi::imConnection("xxxxxxxx") +studies <- imotionsApi::listStudies(connection) +study <- imotionsApi::imStudy(connection, studies$id[1]) +stimulus <- imotionsApi::getStimuli(study)[1, ] +respondent <- imotionsApi::getRespondents(study, stimulus = stimulus)[1, ] +touchAois <- imotionsApi::getTouchActorAois(study, stimulus, respondent) +metrics <- imotionsApi::getAoiRespondentTouchMetrics(study, touchAois[1, ], respondent) +} +} diff --git a/imotionsApi/man/getRespondents.Rd b/imotionsApi/man/getRespondents.Rd index 7f8f998..5f3144f 100644 --- a/imotionsApi/man/getRespondents.Rd +++ b/imotionsApi/man/getRespondents.Rd @@ -17,7 +17,9 @@ getRespondents( \item{stimulus}{Optional - An imStimulus object as returned from \code{\link{getStimuli}}.} -\item{AOI}{Optional - An imAOI object as returned from \code{\link{getAois}}.} +\item{AOI}{Optional - An imAOI object as returned from \code{\link{getAois}}, or an imTouchAOI object as returned +from \code{\link{getTouchActorAois}} to get the respondents that have contact data for that specific +touch actor AOI instead of gaze data.} \item{segment}{Optional - An imSegment object as returned from \code{\link{getSegments}}.} @@ -53,6 +55,11 @@ respondents <- imotionsApi::getRespondents(study, segment = segments[1, ]) ## Get all respondents for whom a specific AOI has been defined respondents <- imotionsApi::getRespondents(study, AOI = AOIs[1, ]) +## Get all respondents that have contact data for a specific touch actor AOI +respondent <- imotionsApi::getRespondents(study)[1, ] +touchAoi <- imotionsApi::getTouchActorAois(study, stimuli[1, ], respondent)[1, ] +respondents <- imotionsApi::getRespondents(study, AOI = touchAoi) + ## Get all respondents in a specific segment exposed to a specific stimulus respondents <- imotionsApi::getRespondents(study, stimulus = stimuli[1, ], segment = segments[1, ]) diff --git a/imotionsApi/man/getTouchActor.Rd b/imotionsApi/man/getTouchActor.Rd new file mode 100644 index 0000000..8c4abf6 --- /dev/null +++ b/imotionsApi/man/getTouchActor.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getTouchActor} +\alias{getTouchActor} +\title{Get a specific touch actor from a stimulus.} +\usage{ +getTouchActor(study, stimulus, touchActorId) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{stimulus}{An imStimulus object as returned from \code{\link{getStimuli}}.} + +\item{touchActorId}{The id of the touch actor you would like to retrieve.} +} +\value{ +An imTouchActor object (data.table) containing the touch actor of interest, or NULL if none is defined + for this stimulus or none matches touchActorId. +} +\description{ +Available touch actors can be found with \code{\link{getTouchActors}}. Passing the result on to +\code{\link{getTouchActorAois}} (instead of the whole stimulus) scopes the underlying contact detail fetch to just +this actor - see \code{getTouchActorDetailsUrl.imTouchActor} - rather than triggering signal generation for every +touch actor on the stimulus. +} +\examples{ +\dontrun{ +connection <- imotionsApi::imConnection("xxxxxxxx") +studies <- imotionsApi::listStudies(connection) +study <- imotionsApi::imStudy(connection, studies$id[1]) +stimulus <- imotionsApi::getStimuli(study)[1, ] +touchActors <- imotionsApi::getTouchActors(study, stimulus) +touchActor <- imotionsApi::getTouchActor(study, stimulus, touchActors$id[1]) +} +} diff --git a/imotionsApi/man/getTouchActorAoi.Rd b/imotionsApi/man/getTouchActorAoi.Rd new file mode 100644 index 0000000..b1d0a09 --- /dev/null +++ b/imotionsApi/man/getTouchActorAoi.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getTouchActorAoi} +\alias{getTouchActorAoi} +\title{Get the touch actor AOI(s) matching a specific aoiId.} +\usage{ +getTouchActorAoi(study, imObject, aoiId, respondent = NULL) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{imObject}{An imStimulus object as returned from \code{\link{getStimuli}} to look across every touch actor on +it, or an imTouchActor object as returned from \code{\link{getTouchActor}}/ +\code{\link{getTouchActors}} to only look at that one actor.} + +\item{aoiId}{The id of the AOI you would like to retrieve.} + +\item{respondent}{Optional - An imRespondent object as returned from \code{\link{getRespondents}} to attach that +respondent's contact in/out fileId/resultId to the result.} +} +\value{ +An imTouchAOI object (data.table) if imObject narrows the match to a single (touch actor, AOI) + combination, an imTouchAOIList if more than one touch actor shares aoiId, or NULL if none match. +} +\description{ +Calls \code{\link{getTouchActorAois}} and filters the result down to aoiId. Passing an imTouchActor pins the +search to that one actor, so the result is a single imTouchAOI row. Passing an imStimulus can still return more +than one row (an imTouchAOIList) if several touch actors share that interactive AOI. +} +\examples{ +\dontrun{ +connection <- imotionsApi::imConnection("xxxxxxxx") +studies <- imotionsApi::listStudies(connection) +study <- imotionsApi::imStudy(connection, studies$id[1]) +stimulus <- imotionsApi::getStimuli(study)[1, ] +touchAois <- imotionsApi::getTouchActorAois(study, stimulus) + +touchActor <- imotionsApi::getTouchActor(study, stimulus, touchAois$touchActorId[1]) +touchAoi <- imotionsApi::getTouchActorAoi(study, touchActor, touchAois$id[1]) +} +} diff --git a/imotionsApi/man/getTouchActorAois.Rd b/imotionsApi/man/getTouchActorAois.Rd new file mode 100644 index 0000000..af249ad --- /dev/null +++ b/imotionsApi/man/getTouchActorAois.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getTouchActorAois} +\alias{getTouchActorAois} +\title{Get the interactive AOIs of a stimulus's touch actors, optionally paired with their contact in/out data.} +\usage{ +getTouchActorAois(study, imObject, respondent = NULL) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{imObject}{An imStimulus object as returned from \code{\link{getStimuli}} to return every touch actor's AOIs +on it, or an imTouchActor object as returned from \code{\link{getTouchActors}} to return only that +actor's AOIs.} + +\item{respondent}{Optional - An imRespondent object as returned from \code{\link{getRespondents}} to attach that +respondent's contact in/out fileId/resultId to each row.} +} +\value{ +An imTouchAOIList object (data.table, a subclass of imAOIList so shared AOI functions still accept it) + with one row per (touch actor, AOI) combination, or NULL if none exist. A single-row result is an + imTouchAOI, subclassing imAOI the same way. +} +\description{ +Each touch actor marks one or more AOIs as interactive, and contact is recorded per (touch actor, AOI) pair. This +returns one row per pair, plus the touch actor that produced it, so it can be used anywhere an imAOI is expected. +It also carries the AOI's own definition (name, type, group, area), resolved from whichever camera the AOI is +actually defined on (see \code{\link{privateGetTouchActorAoiDefinitions}}), so a touch actor on a non-Scene camera +(e.g. Environment) is labelled the same as one on Scene. +} +\details{ +Providing a respondent additionally attaches that respondent's contact in/out fileId/resultId to each row, +triggering generation of any signal that is missing or older than the contact detection result it derives from. +Without one, only the AOI/touch actor definitions are returned - use \code{\link{getRespondents}} (e.g. +\code{getRespondents(study, AOI = touchAoi)}) to find which respondents have contact data for a given row. +} +\examples{ +\dontrun{ +connection <- imotionsApi::imConnection("xxxxxxxx") +studies <- imotionsApi::listStudies(connection) +study <- imotionsApi::imStudy(connection, studies$id[1]) +stimulus <- imotionsApi::getStimuli(study)[1, ] + +## List the touch actor AOIs defined for a stimulus, without triggering signal generation +touchAois <- imotionsApi::getTouchActorAois(study, stimulus) + +## Get the respondents that have contact data for one of them +respondents <- imotionsApi::getRespondents(study, AOI = touchAois[1, ]) + +## Attach the contact in/out file for a specific respondent +touchAois <- imotionsApi::getTouchActorAois(study, stimulus, respondents[1, ]) + +touchActor <- imotionsApi::getTouchActors(study, stimulus)[1, ] +touchAois <- imotionsApi::getTouchActorAois(study, touchActor, respondents[1, ]) # only that actor's AOIs + +print(touchAois$fileId) # path to the contact in/out file for each (touch actor, AOI) pair +} +} diff --git a/imotionsApi/man/getTouchActorAoisUrl.Rd b/imotionsApi/man/getTouchActorAoisUrl.Rd new file mode 100644 index 0000000..c99e65a --- /dev/null +++ b/imotionsApi/man/getTouchActorAoisUrl.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getTouchActorAoisUrl} +\alias{getTouchActorAoisUrl} +\title{Return the path/url to the AOI definitions of every camera that supports contact, for a specific stimulus.} +\usage{ +getTouchActorAoisUrl(study, stimulusId) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{stimulusId}{The id of the stimulus of interest.} +} +\description{ +Unlike \code{\link{getAoisUrl}}, which only ever reaches the Stimulus/Scene camera, this reports one row per AOI +across every touch-capable camera (e.g. Environment), tagged with mediaSourceType. +} +\keyword{internal} diff --git a/imotionsApi/man/getTouchActorDetailsUrl.Rd b/imotionsApi/man/getTouchActorDetailsUrl.Rd new file mode 100644 index 0000000..c4d43ec --- /dev/null +++ b/imotionsApi/man/getTouchActorDetailsUrl.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getTouchActorDetailsUrl} +\alias{getTouchActorDetailsUrl} +\title{Generic getTouchActorDetailsUrl function that takes as parameter a study object, an imTouchAOI/imTouchActor/ +imStimulus object and, optionally, a respondent object.} +\usage{ +getTouchActorDetailsUrl(study, imObject, respondent = NULL) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{imObject}{An imStimulus object, an imTouchActor object as returned from \code{\link{getTouchActors}}, or one +row of \code{\link{getTouchActorAois}}.} + +\item{respondent}{Optional - An imRespondent object as returned from \code{\link{getRespondents}}. Without one, +the url targets every respondent exposed to the stimulus in a single response.} +} +\description{ +Return the path/url to the contact in/out details for one touch actor, or for every touch actor on a stimulus. +Contact detection is desktop-only, so this is only ever used for a local study. +} +\keyword{internal} diff --git a/imotionsApi/man/getTouchActorDetailsUrl.imStimulus.Rd b/imotionsApi/man/getTouchActorDetailsUrl.imStimulus.Rd new file mode 100644 index 0000000..4dc19d3 --- /dev/null +++ b/imotionsApi/man/getTouchActorDetailsUrl.imStimulus.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getTouchActorDetailsUrl.imStimulus} +\alias{getTouchActorDetailsUrl.imStimulus} +\title{getTouchActorDetailsUrl.imStimulus method to return the path/url to the contact in/out details of every touch actor +defined for a stimulus.} +\usage{ +\method{getTouchActorDetailsUrl}{imStimulus}(study, imObject, respondent = NULL) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{imObject}{An imStimulus object, an imTouchActor object as returned from \code{\link{getTouchActors}}, or one +row of \code{\link{getTouchActorAois}}.} + +\item{respondent}{Optional - An imRespondent object as returned from \code{\link{getRespondents}}. Without one, +the url targets every respondent exposed to the stimulus in a single response.} +} +\description{ +getTouchActorDetailsUrl.imStimulus method to return the path/url to the contact in/out details of every touch actor +defined for a stimulus. +} +\keyword{internal} diff --git a/imotionsApi/man/getTouchActorDetailsUrl.imTouchAOI.Rd b/imotionsApi/man/getTouchActorDetailsUrl.imTouchAOI.Rd new file mode 100644 index 0000000..2d28f07 --- /dev/null +++ b/imotionsApi/man/getTouchActorDetailsUrl.imTouchAOI.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getTouchActorDetailsUrl.imTouchAOI} +\alias{getTouchActorDetailsUrl.imTouchAOI} +\title{getTouchActorDetailsUrl.imTouchAOI method to return the path/url to one touch actor's contact in/out details.} +\usage{ +\method{getTouchActorDetailsUrl}{imTouchAOI}(study, imObject, respondent = NULL) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{imObject}{An imStimulus object, an imTouchActor object as returned from \code{\link{getTouchActors}}, or one +row of \code{\link{getTouchActorAois}}.} + +\item{respondent}{Optional - An imRespondent object as returned from \code{\link{getRespondents}}. Without one, +the url targets every respondent exposed to the stimulus in a single response.} +} +\description{ +Unlike the gaze equivalent the wildcard sits on the touch actor rather than the AOI, because the endpoint reports +every AOI of the actors it matches in one response. Dispatching on imTouchAOI rather than imAOI matters here: an +ordinary gaze imAOI is not guaranteed to carry touchActorId, which this method relies on. +} +\keyword{internal} diff --git a/imotionsApi/man/getTouchActorDetailsUrl.imTouchActor.Rd b/imotionsApi/man/getTouchActorDetailsUrl.imTouchActor.Rd new file mode 100644 index 0000000..8909980 --- /dev/null +++ b/imotionsApi/man/getTouchActorDetailsUrl.imTouchActor.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getTouchActorDetailsUrl.imTouchActor} +\alias{getTouchActorDetailsUrl.imTouchActor} +\title{getTouchActorDetailsUrl.imTouchActor method to return the path/url to one touch actor's contact in/out details, +across every AOI it marks interactive.} +\usage{ +\method{getTouchActorDetailsUrl}{imTouchActor}(study, imObject, respondent = NULL) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{imObject}{An imStimulus object, an imTouchActor object as returned from \code{\link{getTouchActors}}, or one +row of \code{\link{getTouchActorAois}}.} + +\item{respondent}{Optional - An imRespondent object as returned from \code{\link{getRespondents}}. Without one, +the url targets every respondent exposed to the stimulus in a single response.} +} +\description{ +Produces the same url as \code{\link{getTouchActorDetailsUrl.imTouchAOI}} for the same actor - the endpoint is +scoped per touch actor either way, so which of the two dispatches only depends on whether the caller already +narrowed down to one (touch actor, AOI) pair or still has the bare touch actor. +} +\keyword{internal} diff --git a/imotionsApi/man/getTouchActors.Rd b/imotionsApi/man/getTouchActors.Rd new file mode 100644 index 0000000..38a9051 --- /dev/null +++ b/imotionsApi/man/getTouchActors.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getTouchActors} +\alias{getTouchActors} +\title{Get all touch actors defined for a specific stimulus.} +\usage{ +getTouchActors(study, stimulus) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{stimulus}{An imStimulus object as returned from \code{\link{getStimuli}}.} +} +\value{ +An imTouchActorList object (data.table) with one row per touch actor, or NULL if none are defined. +} +\description{ +A touch actor detects hand-to-object contact on a recorded video and marks a set of AOIs as interactive. Contact +detection runs in the iMotions desktop application only, so this returns NULL for a remote study. +} +\examples{ +\dontrun{ +connection <- imotionsApi::imConnection("xxxxxxxx") +studies <- imotionsApi::listStudies(connection) +study <- imotionsApi::imStudy(connection, studies$id[1]) +stimuli <- imotionsApi::getStimuli(study) +touchActors <- imotionsApi::getTouchActors(study, stimuli[1, ]) +} +} diff --git a/imotionsApi/man/getTouchActorsUrl.Rd b/imotionsApi/man/getTouchActorsUrl.Rd new file mode 100644 index 0000000..52956b7 --- /dev/null +++ b/imotionsApi/man/getTouchActorsUrl.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{getTouchActorsUrl} +\alias{getTouchActorsUrl} +\title{Return the path/url to the touch actors defined for a specific stimulus.} +\usage{ +getTouchActorsUrl(study, stimulusId) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{stimulusId}{The id of the stimulus of interest.} +} +\description{ +Return the path/url to the touch actors defined for a specific stimulus. +} +\keyword{internal} diff --git a/imotionsApi/man/privateDecodeHandType.Rd b/imotionsApi/man/privateDecodeHandType.Rd new file mode 100644 index 0000000..67fa41a --- /dev/null +++ b/imotionsApi/man/privateDecodeHandType.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{privateDecodeHandType} +\alias{privateDecodeHandType} +\title{Private function translating the numeric hand codes stored in a contact in/out file into readable labels.} +\usage{ +privateDecodeHandType(codes) +} +\arguments{ +\item{codes}{A numeric vector of hand codes as stored in the HandType column.} +} +\value{ +A character vector with one label per code. A code with no value at all (no touch on this row, so hand + type does not apply) stays \code{NA} rather than getting a label of its own - only a code that carries + an actual value but isn't a recognised one falls back to \code{"Unknown"}. +} +\description{ +Private function translating the numeric hand codes stored in a contact in/out file into readable labels. +} +\keyword{internal} diff --git a/imotionsApi/man/privateGetTouchActorAoiDefinitions.Rd b/imotionsApi/man/privateGetTouchActorAoiDefinitions.Rd new file mode 100644 index 0000000..9e03f29 --- /dev/null +++ b/imotionsApi/man/privateGetTouchActorAoiDefinitions.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{privateGetTouchActorAoiDefinitions} +\alias{privateGetTouchActorAoiDefinitions} +\title{Get the AOI definitions of every camera that supports contact, for a stimulus.} +\usage{ +privateGetTouchActorAoiDefinitions(study, stimulus) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{stimulus}{An imStimulus object as returned from \code{\link{getStimuli}}.} +} +\value{ +A data.table with one row per AOI (id, name, type, group, area, mediaSourceType) across every touch-capable + camera, or NULL if none are defined. +} +\description{ +Sibling of \code{\link{privateAoiFiltering}} for touch actors: that one only ever reaches the Stimulus/Scene +camera, while a touch actor's interactive AOIs can live on any camera contact detection supports (e.g. +Environment). Used by \code{\link{getTouchActorAois}} to resolve a name/type/group/area for every touch actor AOI, +not just the ones on Scene. +} +\keyword{internal} diff --git a/imotionsApi/man/privateGetTouchActorDetails.Rd b/imotionsApi/man/privateGetTouchActorDetails.Rd new file mode 100644 index 0000000..5039239 --- /dev/null +++ b/imotionsApi/man/privateGetTouchActorDetails.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{privateGetTouchActorDetails} +\alias{privateGetTouchActorDetails} +\title{Private function returning where a stimulus's or a touch actor AOI's contact in/out signals live.} +\usage{ +privateGetTouchActorDetails(study, imObject, respondent = NULL) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{imObject}{An imStimulus object (all touch actors on it), an imTouchActor object as returned from +\code{\link{getTouchActors}} (that actor's AOIs only), or an imTouchAOI object as returned from +\code{\link{getTouchActorAois}} (that specific (touch actor, AOI) pair only).} + +\item{respondent}{Optional - An imRespondent object as returned from \code{\link{getRespondents}}. Without one, +details for every respondent exposed to the stimulus are returned in a single response, +disambiguated by the `respId` column.} +} +\value{ +A data.frame with one row per (touch actor, AOI[, respondent]) combination that has an in/out signal. +} +\description{ +Requesting these generates any signal that is missing or older than the contact detection result it derives from, +so this is also what makes the files exist. +} +\keyword{internal} diff --git a/imotionsApi/man/privateRespondentFiltering.imTouchAOI.Rd b/imotionsApi/man/privateRespondentFiltering.imTouchAOI.Rd new file mode 100644 index 0000000..50fd553 --- /dev/null +++ b/imotionsApi/man/privateRespondentFiltering.imTouchAOI.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/imotionsApi.R +\name{privateRespondentFiltering.imTouchAOI} +\alias{privateRespondentFiltering.imTouchAOI} +\title{Get respondents that have contact data for a specific touch actor AOI.} +\usage{ +\method{privateRespondentFiltering}{imTouchAOI}(study, obj) +} +\arguments{ +\item{study}{An imStudy object as returned from \code{\link{imStudy}}.} + +\item{obj}{An imTouchAOI object as returned from \code{\link{getTouchActorAois}} for which you would like to get +the respondents.} +} +\value{ +A data.table with all respondents that have contact data for this specific touch actor AOI. +} +\description{ +S3 method to get all respondents with contact in/out data for a specific (touch actor, AOI) pair. This exists +because \code{\link{privateRespondentFiltering.imAOI}} resolves respondents through the gaze in/out endpoint, which +returns nothing on a study without eyetracking data - exactly the case contact metrics exist to support. +} +\details{ +Resolved with a single stimulus-wide, respondent-less call to \code{\link{privateGetTouchActorDetails}} (see +\code{\link{getTouchActorDetailsUrl.imStimulus}}), which returns contact details for every respondent exposed to +the stimulus in one response - kept are only the respondents whose own contact details contain a matching +(touchActorId, aoiId) pair. +} +\keyword{internal} diff --git a/imotionsApi/man/privateUploadAoiMetrics.Rd b/imotionsApi/man/privateUploadAoiMetrics.Rd index 8c9a6a1..e547e28 100644 --- a/imotionsApi/man/privateUploadAoiMetrics.Rd +++ b/imotionsApi/man/privateUploadAoiMetrics.Rd @@ -12,7 +12,8 @@ privateUploadAoiMetrics(study, obj, AOI, metrics) \item{obj}{An imRespondent or imSegment object of interest.} -\item{AOI}{An imAOI object as returned from \code{\link{getAois}}.} +\item{AOI}{An imAOI object as returned from \code{\link{getAois}}, or an imTouchAOI object as returned from +\code{\link{getTouchActorAois}}.} \item{metrics}{A data.table containing the metrics to upload.} } diff --git a/imotionsApi/man/privateUploadAoiMetrics.imRespondent.Rd b/imotionsApi/man/privateUploadAoiMetrics.imRespondent.Rd index 5faa006..1c9d20b 100644 --- a/imotionsApi/man/privateUploadAoiMetrics.imRespondent.Rd +++ b/imotionsApi/man/privateUploadAoiMetrics.imRespondent.Rd @@ -11,7 +11,8 @@ \item{obj}{An imRespondent or imSegment object of interest.} -\item{AOI}{An imAOI object as returned from \code{\link{getAois}}.} +\item{AOI}{An imAOI object as returned from \code{\link{getAois}}, or an imTouchAOI object as returned from +\code{\link{getTouchActorAois}}.} \item{metrics}{A data.table containing the metrics to upload.} } diff --git a/imotionsApi/man/privateUploadAoiMetrics.imSegment.Rd b/imotionsApi/man/privateUploadAoiMetrics.imSegment.Rd index 63f7ff2..2f8ca9d 100644 --- a/imotionsApi/man/privateUploadAoiMetrics.imSegment.Rd +++ b/imotionsApi/man/privateUploadAoiMetrics.imSegment.Rd @@ -11,7 +11,8 @@ \item{obj}{An imRespondent or imSegment object of interest.} -\item{AOI}{An imAOI object as returned from \code{\link{getAois}}.} +\item{AOI}{An imAOI object as returned from \code{\link{getAois}}, or an imTouchAOI object as returned from +\code{\link{getTouchActorAois}}.} \item{metrics}{A data.table containing the metrics to upload.} } diff --git a/imotionsApi/man/uploadAOIMetrics.Rd b/imotionsApi/man/uploadAOIMetrics.Rd index ba2ce2d..3140ccd 100644 --- a/imotionsApi/man/uploadAOIMetrics.Rd +++ b/imotionsApi/man/uploadAOIMetrics.Rd @@ -9,7 +9,8 @@ uploadAoiMetrics(study, AOI, target, metrics) \arguments{ \item{study}{An imStudy object as returned from imStudy()} -\item{AOI}{An imAOI object as returned from \code{\link{getAois}}.} +\item{AOI}{An imAOI object as returned from \code{\link{getAois}}, or an imTouchAOI object as returned from +\code{\link{getTouchActorAois}} to upload metrics for that specific touch actor AOI instead.} \item{target}{The target respondent/segment for the sensor (an imRespondent/imSegment object as returned from \code{\link{getRespondents}} or \code{\link{getSegments}}).} diff --git a/imotionsApi/tests/data/noTouchActors.json b/imotionsApi/tests/data/noTouchActors.json new file mode 100644 index 0000000..fe51488 --- /dev/null +++ b/imotionsApi/tests/data/noTouchActors.json @@ -0,0 +1 @@ +[] diff --git a/imotionsApi/tests/data/touchActorDetails.json b/imotionsApi/tests/data/touchActorDetails.json new file mode 100644 index 0000000..03eaf8a --- /dev/null +++ b/imotionsApi/tests/data/touchActorDetails.json @@ -0,0 +1,26 @@ +[ + { + "touchActorId": "5b1f0c42-9d6e-4a3b-8f21-0c7d5e9a1b34", + "aoiId": "09a234fc-00ad-4257-b7e1-da5754986c9d", + "respId": "09bd22e6-29b6-4a8a-8cc1-4780a5163e63", + "fileId": "../data/touchActorRespondentData.pbin", + "resultId": "../data/AOImetrics.csv", + "fileIdIsEmptyPlaceHolder": false + }, + { + "touchActorId": "5b1f0c42-9d6e-4a3b-8f21-0c7d5e9a1b34", + "aoiId": "7d3b81e5-4c92-4f07-b6a1-52e8d90c3af6", + "respId": "09bd22e6-29b6-4a8a-8cc1-4780a5163e63", + "fileId": "../data/touchActorEmptyRespondentData.pbin", + "resultId": null, + "fileIdIsEmptyPlaceHolder": true + }, + { + "touchActorId": "c8e4a17d-2f60-4b95-a3d8-6e1b70f2c945", + "aoiId": "09a234fc-00ad-4257-b7e1-da5754986c9d", + "respId": "09bd22e6-29b6-4a8a-8cc1-4780a5163e63", + "fileId": "../data/touchActorRespondentData.pbin", + "resultId": null, + "fileIdIsEmptyPlaceHolder": false + } +] diff --git a/imotionsApi/tests/data/touchActorDetailsMultiRespondent.json b/imotionsApi/tests/data/touchActorDetailsMultiRespondent.json new file mode 100644 index 0000000..e66291c --- /dev/null +++ b/imotionsApi/tests/data/touchActorDetailsMultiRespondent.json @@ -0,0 +1,26 @@ +[ + { + "touchActorId": "5b1f0c42-9d6e-4a3b-8f21-0c7d5e9a1b34", + "aoiId": "09a234fc-00ad-4257-b7e1-da5754986c9d", + "respId": "09bd22e6-29b6-4a8a-8cc1-4780a5163e63", + "fileId": "../data/touchActorRespondentData.pbin", + "resultId": "../data/AOImetrics.csv", + "fileIdIsEmptyPlaceHolder": false + }, + { + "touchActorId": "5b1f0c42-9d6e-4a3b-8f21-0c7d5e9a1b34", + "aoiId": "09a234fc-00ad-4257-b7e1-da5754986c9d", + "respId": "750ed075-1c8d-4aff-91b1-ed6c9e052808", + "fileId": "../data/touchActorRespondentData.pbin", + "resultId": null, + "fileIdIsEmptyPlaceHolder": false + }, + { + "touchActorId": "c8e4a17d-2f60-4b95-a3d8-6e1b70f2c945", + "aoiId": "7d3b81e5-4c92-4f07-b6a1-52e8d90c3af6", + "respId": "846041b3-1485-4e56-9d73-829601dcfe20", + "fileId": "../data/touchActorRespondentData.pbin", + "resultId": null, + "fileIdIsEmptyPlaceHolder": false + } +] diff --git a/imotionsApi/tests/data/touchActorDetailsMultiSource.json b/imotionsApi/tests/data/touchActorDetailsMultiSource.json new file mode 100644 index 0000000..21deaa7 --- /dev/null +++ b/imotionsApi/tests/data/touchActorDetailsMultiSource.json @@ -0,0 +1,18 @@ +[ + { + "touchActorId": "5b1f0c42-9d6e-4a3b-8f21-0c7d5e9a1b34", + "aoiId": "09a234fc-00ad-4257-b7e1-da5754986c9d", + "respId": "09bd22e6-29b6-4a8a-8cc1-4780a5163e63", + "fileId": "../data/touchActorRespondentData.pbin", + "resultId": "../data/AOImetrics.csv", + "fileIdIsEmptyPlaceHolder": false + }, + { + "touchActorId": "4f2d6b30-7c44-4d1b-9c19-9c6b9e2a5b60", + "aoiId": "1c9c8b18-3e1d-4b53-9c62-2a6b1a0d7e11", + "respId": "09bd22e6-29b6-4a8a-8cc1-4780a5163e63", + "fileId": "../data/touchActorRespondentData.pbin", + "resultId": null, + "fileIdIsEmptyPlaceHolder": false + } +] diff --git a/imotionsApi/tests/data/touchActorDetails_missingfileId.json b/imotionsApi/tests/data/touchActorDetails_missingfileId.json new file mode 100644 index 0000000..c79da75 --- /dev/null +++ b/imotionsApi/tests/data/touchActorDetails_missingfileId.json @@ -0,0 +1,26 @@ +[ + { + "touchActorId": "5b1f0c42-9d6e-4a3b-8f21-0c7d5e9a1b34", + "aoiId": "09a234fc-00ad-4257-b7e1-da5754986c9d", + "respId": "09bd22e6-29b6-4a8a-8cc1-4780a5163e63", + "fileId": "../data/touchActorRespondentData.pbin", + "resultId": "../data/AOImetrics.csv", + "fileIdIsEmptyPlaceHolder": false + }, + { + "touchActorId": "5b1f0c42-9d6e-4a3b-8f21-0c7d5e9a1b34", + "aoiId": "7d3b81e5-4c92-4f07-b6a1-52e8d90c3af6", + "respId": "09bd22e6-29b6-4a8a-8cc1-4780a5163e63", + "fileId": "../data/touchActorEmptyRespondentData.pbin", + "resultId": null, + "fileIdIsEmptyPlaceHolder": true + }, + { + "touchActorId": "c8e4a17d-2f60-4b95-a3d8-6e1b70f2c945", + "aoiId": "09a234fc-00ad-4257-b7e1-da5754986c9d", + "respId": "09bd22e6-29b6-4a8a-8cc1-4780a5163e63", + "fileId": null, + "resultId": null, + "fileIdIsEmptyPlaceHolder": false + } +] diff --git a/imotionsApi/tests/data/touchActorDetails_noMatchingPair.json b/imotionsApi/tests/data/touchActorDetails_noMatchingPair.json new file mode 100644 index 0000000..8bbba3b --- /dev/null +++ b/imotionsApi/tests/data/touchActorDetails_noMatchingPair.json @@ -0,0 +1,10 @@ +[ + { + "touchActorId": "00000000-0000-0000-0000-000000000000", + "aoiId": "00000000-0000-0000-0000-000000000001", + "respId": "09bd22e6-29b6-4a8a-8cc1-4780a5163e63", + "fileId": "../data/touchActorRespondentData.pbin", + "resultId": null, + "fileIdIsEmptyPlaceHolder": false + } +] diff --git a/imotionsApi/tests/data/touchActorEmptyRespondentData.pbin b/imotionsApi/tests/data/touchActorEmptyRespondentData.pbin new file mode 100644 index 0000000..e69de29 diff --git a/imotionsApi/tests/data/touchActorRespondentData.pbin b/imotionsApi/tests/data/touchActorRespondentData.pbin new file mode 100644 index 0000000..c2ca1f1 Binary files /dev/null and b/imotionsApi/tests/data/touchActorRespondentData.pbin differ diff --git a/imotionsApi/tests/data/touchActors.json b/imotionsApi/tests/data/touchActors.json new file mode 100644 index 0000000..994785b --- /dev/null +++ b/imotionsApi/tests/data/touchActors.json @@ -0,0 +1,22 @@ +[ + { + "id": "5b1f0c42-9d6e-4a3b-8f21-0c7d5e9a1b34", + "name": "Right hand", + "stimulusId": 1002, + "stimulusName": "IAAF", + "mediaSourceType": "StimulusCamera", + "detectionMethod": "HoiDetr", + "hand": "Right", + "interactiveAoiIds": ["09a234fc-00ad-4257-b7e1-da5754986c9d", "7d3b81e5-4c92-4f07-b6a1-52e8d90c3af6"] + }, + { + "id": "c8e4a17d-2f60-4b95-a3d8-6e1b70f2c945", + "name": "Left hand", + "stimulusId": 1002, + "stimulusName": "IAAF", + "mediaSourceType": "StimulusCamera", + "detectionMethod": "HoiDetr", + "hand": "Left", + "interactiveAoiIds": "09a234fc-00ad-4257-b7e1-da5754986c9d" + } +] diff --git a/imotionsApi/tests/data/touchActorsMultiSource.json b/imotionsApi/tests/data/touchActorsMultiSource.json new file mode 100644 index 0000000..316a151 --- /dev/null +++ b/imotionsApi/tests/data/touchActorsMultiSource.json @@ -0,0 +1,22 @@ +[ + { + "id": "5b1f0c42-9d6e-4a3b-8f21-0c7d5e9a1b34", + "name": "Right hand", + "stimulusId": 1002, + "stimulusName": "IAAF", + "mediaSourceType": "StimulusCamera", + "detectionMethod": "HoiDetr", + "hand": "Right", + "interactiveAoiIds": ["09a234fc-00ad-4257-b7e1-da5754986c9d"] + }, + { + "id": "4f2d6b30-7c44-4d1b-9c19-9c6b9e2a5b60", + "name": "Environment hand", + "stimulusId": 1002, + "stimulusName": "IAAF", + "mediaSourceType": "Environment", + "detectionMethod": "HoiDetr", + "hand": "Right", + "interactiveAoiIds": ["1c9c8b18-3e1d-4b53-9c62-2a6b1a0d7e11"] + } +] diff --git a/imotionsApi/tests/testthat/test-getTouchActors.R b/imotionsApi/tests/testthat/test-getTouchActors.R new file mode 100644 index 0000000..5534d27 --- /dev/null +++ b/imotionsApi/tests/testthat/test-getTouchActors.R @@ -0,0 +1,749 @@ +# getTouchActors ====================================================================================================== +context("getTouchActors()") + +library(mockery) + +# Load study +study <- jsonlite::unserializeJSON(readLines("../data/imStudy.json")) +study_cloud <- jsonlite::unserializeJSON(readLines("../data/imStudy_cloud.json")) + +# Load respondent and stimulus +respondent <- getRespondents(study)[1, ] +stimulus <- getStimuli(study)[4, ] + +TA1 <- "5b1f0c42-9d6e-4a3b-8f21-0c7d5e9a1b34" +TA2 <- "c8e4a17d-2f60-4b95-a3d8-6e1b70f2c945" +AOI1 <- "09a234fc-00ad-4257-b7e1-da5754986c9d" +AOI2 <- "7d3b81e5-4c92-4f07-b6a1-52e8d90c3af6" + +touchActorsPath <- "../data/touchActors.json" +noTouchActorsPath <- "../data/noTouchActors.json" +touchActorDetailsPath <- "../data/touchActorDetails.json" +touchActorDetailsMissingPath <- "../data/touchActorDetails_missingfileId.json" +touchActorDetailsNoMatchPath <- "../data/touchActorDetails_noMatchingPair.json" +touchActorDetailsMultiRespondentPath <- "../data/touchActorDetailsMultiRespondent.json" + +# The AOI definitions getTouchActorAois() joins against - what privateGetTouchActorAoiDefinitions() would return for +# this stimulus. +aoiDefinitions <- function() { + aois <- data.table(stimulusId = "1002", stimulusName = "IAAF", id = c(AOI1, AOI2), + name = c("New Aoi", "Second Aoi"), type = "Static", group = NA_character_, + area = c(5000, 2500)) + + return(imotionsApi:::createImObject(aois, "AOI")) +} + +mockedGetTouchActors <- function(study, stimulus, jsonPath = touchActorsPath, expectedCall = 1) { + getJSON_Stub <- mock(jsonlite::fromJSON(jsonPath)) + + touchActors <- mockr::with_mock(getJSON = getJSON_Stub, { + getTouchActors(study, stimulus) + }) + + expect_called(getJSON_Stub, expectedCall) + return(touchActors) +} + +test_that("error - arguments are missing or not from the good class", { + expect_error(getTouchActors(), "Please specify a study loaded with `imStudy()`", fixed = TRUE, + info = "missing `study` param not handled properly") + + expect_error(getTouchActors(study), "Please specify a stimulus loaded with `getStimuli()`", fixed = TRUE, + info = "missing `stimulus` param not handled properly") + + expect_error(getTouchActors(study = "whatever", stimulus), "`study` argument is not an imStudy object", + info = "study not being an imStudy object should throw an error") + + expect_error(getTouchActors(study, stimulus = "whatever"), "`stimulus` argument is not an imStimulus object", + info = "stimulus not being an imStimulus object should throw an error") +}) + +test_that("local return - touch actors defined for a stimulus", { + touchActors <- mockedGetTouchActors(study, stimulus) + + expect_equal(nrow(touchActors), 2, info = "2 touch actors should be defined for this stimulus") + expect_identical(touchActors$id, c(TA1, TA2), "wrong touch actor ids") + expect_identical(touchActors$name, c("Right hand", "Left hand"), "wrong touch actor names") + expect_identical(touchActors$hand, c("Right", "Left"), "wrong hand") + expect_identical(unique(touchActors$detectionMethod), "HoiDetr", "wrong detection method") + expect_identical(unique(touchActors$mediaSourceType), "StimulusCamera", "wrong media source type") + expect_s3_class(touchActors, "imTouchActorList") +}) + +test_that("local return - stimulusId is coerced to a string to match every other imObject", { + touchActors <- mockedGetTouchActors(study, stimulus) + + expect_identical(unique(touchActors$stimulusId), "1002", "stimulusId should be a character") + expect_identical(unique(touchActors$stimulusName), "IAAF", "wrong stimulus name") +}) + +test_that("local return - interactiveAoiIds is kept as a list column", { + touchActors <- mockedGetTouchActors(study, stimulus) + + expect_identical(touchActors$interactiveAoiIds[[1]], c(AOI1, AOI2), "first actor should reference 2 AOIs") + expect_identical(touchActors$interactiveAoiIds[[2]], AOI1, "second actor should reference 1 AOI") +}) + +test_that("warning - no touch actor defined for this stimulus", { + expect_warning(touchActors <- mockedGetTouchActors(study, stimulus, noTouchActorsPath), + "No touch actor defined for Stimulus: IAAF", + info = "no touch actor defined should throw a warning") + + expect_null(touchActors, info = "result should be null") +}) + +test_that("warning - touch actors are not available for a remote study", { + stimulus_cloud <- getStimuli(study)[4, ] + + expect_warning(touchActors <- mockedGetTouchActors(study_cloud, stimulus_cloud, expectedCall = 0), + "Touch actors are only available for local studies", + info = "remote study should throw a warning") + + expect_null(touchActors, info = "result should be null") +}) + + +# getTouchActor ======================================================================================================== +context("getTouchActor()") + +mockedGetTouchActor <- function(study, stimulus, touchActorId, jsonPath = touchActorsPath, expectedCall = 1) { + getJSON_Stub <- mock(jsonlite::fromJSON(jsonPath)) + + touchActor <- mockr::with_mock(getJSON = getJSON_Stub, { + getTouchActor(study, stimulus, touchActorId) + }) + + expect_called(getJSON_Stub, expectedCall) + return(touchActor) +} + +test_that("error - touchActorId is missing", { + expect_error(getTouchActor(study, stimulus), + "Please specify a touchActorId. Available touch actors can be found with `getTouchActors()`", + fixed = TRUE, info = "missing `touchActorId` param not handled properly") +}) + +test_that("warning - no touch actor defined for this stimulus", { + expect_warning(touchActor <- mockedGetTouchActor(study, stimulus, TA1, noTouchActorsPath), + "No touch actor defined for Stimulus: IAAF", + info = "no touch actor defined should throw a warning") + + expect_null(touchActor, info = "result should be null") +}) + +test_that("warning - wrong touchActorId is provided", { + expect_warning(touchActor <- mockedGetTouchActor(study, stimulus, "wrong-id"), + "No touch actor found matching id: wrong-id", + info = "wrong touchActorId not handled properly") + + expect_null(touchActor, info = "result should be null") +}) + +test_that("local return - specific touch actor from a stimulus", { + touchActor <- mockedGetTouchActor(study, stimulus, TA2) + + expect_s3_class(touchActor, "imTouchActor") + expect_equal(nrow(touchActor), 1, info = "should only contain a single touch actor") + expect_identical(touchActor$id, TA2, "wrong touch actor id") + expect_identical(touchActor$hand, "Left", "wrong hand") +}) + + +# privateGetTouchActorDetails ========================================================================================= +context("privateGetTouchActorDetails()") + +mockedGetTouchActorDetails <- function(study, imObject, respondent, jsonPath = touchActorDetailsPath, + expectedCall = 1) { + getJSON_Stub <- mock(jsonlite::fromJSON(jsonPath)) + + details <- mockr::with_mock(getJSON = getJSON_Stub, { + # Called bare rather than via `imotionsApi:::` - mockr::with_mock() patches the getJSON binding it's given in + # the imotionsApi namespace, but a `:::`-qualified call here bypasses that patched binding and hits the real + # network, as `privateGetAoiDetails()`'s equivalent test does it (see test-getAOIRespondentData.R). + privateGetTouchActorDetails(study, imObject, respondent) + }) + + expect_called(getJSON_Stub, expectedCall) + return(details) +} + +expectedDetailNames <- c("touchActorId", "aoiId", "respId", "fileId", "resultId", "fileIdIsEmptyPlaceHolder") + +test_that("local return - details for every touch actor on a stimulus", { + details <- mockedGetTouchActorDetails(study, stimulus, respondent) + + expect_equal(nrow(details), 3, info = "3 (touch actor, AOI) combinations should be returned") + expect_named(details, expectedDetailNames, info = "touch actor details infos not matching") + expect_identical(unique(details$respId), respondent$id, "details should all be for the requested respondent") +}) + +test_that("local return - respondent is optional, details for every respondent are returned in one call", { + details <- mockedGetTouchActorDetails(study, stimulus, respondent = NULL, + jsonPath = touchActorDetailsMultiRespondentPath) + + expect_equal(nrow(details), 3, info = "3 (touch actor, AOI, respondent) combinations should be returned") + expect_named(details, expectedDetailNames, info = "touch actor details infos not matching") + expect_setequal(details$respId, c("09bd22e6-29b6-4a8a-8cc1-4780a5163e63", "750ed075-1c8d-4aff-91b1-ed6c9e052808", + "846041b3-1485-4e56-9d73-829601dcfe20")) +}) + +test_that("local return - combinations without a fileId are filtered out", { + details <- mockedGetTouchActorDetails(study, stimulus, respondent, touchActorDetailsMissingPath) + + expect_equal(nrow(details), 2, info = "the combination without a fileId should be removed") + expect_false(TA2 %in% details$touchActorId, "the touch actor without contact detection should be gone") +}) + +test_that("local return - passing an imTouchAOI scopes details down to that (touch actor, AOI) pair", { + # TA1 has 2 interactive AOIs (AOI1, AOI2) - the endpoint reports both since the wildcard sits on the touch + # actor, not the AOI (see getTouchActorDetailsUrl.imTouchAOI). Only the (TA1, AOI1) pair should survive. + touchAoi <- aoiDefinitions()[1, ] + touchAoi$touchActorId <- TA1 + class(touchAoi) <- c("imTouchAOI", class(touchAoi)) + + details <- mockedGetTouchActorDetails(study, touchAoi, respondent) + + expect_equal(nrow(details), 1, info = "only the requested (touch actor, AOI) pair should be kept") + expect_identical(details$touchActorId, TA1) + expect_identical(details$aoiId, AOI1) +}) + +test_that("local return - a fileId already present short-circuits the request", { + touchAoi <- aoiDefinitions()[1, ] + touchAoi$fileId <- "../data/touchActorRespondentData.pbin" + touchAoi$touchActorId <- TA1 + class(touchAoi) <- c("imTouchAOI", class(touchAoi)) + + details <- mockedGetTouchActorDetails(study, touchAoi, respondent, expectedCall = 0) + + expect_identical(details$fileId, touchAoi$fileId, "fileId stored in the AOI should be retrieved directly") +}) + +test_that("warning - no contact in/out signal for this respondent", { + expect_warning(details <- mockedGetTouchActorDetails(study, stimulus, respondent, noTouchActorsPath), + "has no contact in/out signals, has contact detection been run?", + info = "absent contact signals should throw a warning") + + expect_null(details, info = "result should be null") +}) + +test_that("warning - contact data is not available for a remote study", { + expect_warning(details <- mockedGetTouchActorDetails(study_cloud, stimulus, respondent, expectedCall = 0), + "Contact data is only available for local studies", + info = "remote study should throw a warning") + + expect_null(details, info = "result should be null") +}) + + +# getTouchActorAois =================================================================================================== +context("getTouchActorAois()") + +mockedGetTouchActorAois <- function(study, imObject, respondent, detailsPath = touchActorDetailsPath) { + touchActors <- suppressWarnings(mockedGetTouchActors(study, stimulus)) + + touchAois <- mockr::with_mock( + getTouchActors = function(...) touchActors, + privateGetTouchActorAoiDefinitions = function(...) aoiDefinitions(), + privateGetTouchActorDetails = function(...) jsonlite::fromJSON(detailsPath), { + getTouchActorAois(study, imObject, respondent) + } + ) + + return(touchAois) +} + +test_that("error - arguments are missing or not from the good class", { + expect_error(getTouchActorAois(imObject = stimulus, respondent = respondent), + "Please specify a study loaded with `imStudy()`", fixed = TRUE, + info = "missing `study` param not handled properly") + + expect_error(getTouchActorAois(study, respondent = respondent), + "Please specify a stimulus loaded with `getStimuli()` or a touch actor loaded with `getTouchActors()`", + fixed = TRUE, info = "missing `imObject` param not handled properly") + + expect_error(getTouchActorAois(study = "whatever", stimulus, respondent), + "`study` argument is not an imStudy object", + info = "study not being an imStudy object should throw an error") + + expect_error(getTouchActorAois(study, stimulus, respondent = "whatever"), + "`respondent` argument is not an imRespondent object", + info = "respondent not being an imRespondent object should throw an error") + + expect_error(getTouchActorAois(study, "whatever", respondent), + "`imObject` argument is not an imStimulus or imTouchActor object", + info = "imObject not being an imStimulus or an imTouchActor object should throw an error") +}) + +test_that("local return - one row per (touch actor, AOI) combination", { + touchAois <- mockedGetTouchActorAois(study, stimulus, respondent) + + expect_equal(nrow(touchAois), 3, info = "3 (touch actor, AOI) combinations should be returned") + expect_equal(sum(touchAois$id == AOI1), 2, info = "AOI1 is referenced by both touch actors") + expect_equal(sum(touchAois$id == AOI2), 1, info = "AOI2 is referenced by one touch actor") +}) + +test_that("local return - without a respondent, only the AOI/touch actor definitions are returned", { + touchAois <- mockedGetTouchActorAois(study, stimulus, respondent = NULL) + + expect_equal(nrow(touchAois), 3, info = "3 (touch actor, AOI) combinations should still be returned") + expect_false("fileId" %in% names(touchAois), info = "no contact in/out details should be attached") + expect_false("resultId" %in% names(touchAois), info = "no contact in/out details should be attached") + expect_s3_class(touchAois, "imTouchAOIList") +}) + +test_that("local return - the AOI definition wins the id/name columns so it can stand in for an imAOI", { + touchAois <- mockedGetTouchActorAois(study, stimulus, respondent) + + expect_s3_class(touchAois, "imAOIList") + expect_identical(unique(touchAois[touchAois$id == AOI1, ]$name), "New Aoi", "AOI name should win over the actor's") + expect_identical(unique(touchAois$type), "Static", "AOI type should be carried over") + expect_equal(unique(touchAois[touchAois$id == AOI1, ]$area), 5000, info = "AOI area should be carried over") + expect_identical(unique(touchAois$stimulusName), "IAAF", "stimulus name should be carried over") +}) + +test_that("local return - result is an imTouchAOI(List), a subclass of imAOI(List) rather than a plain one", { + touchAois <- mockedGetTouchActorAois(study, stimulus, respondent) + + expect_identical(class(touchAois), c("imTouchAOIList", "imAOIList", "imObjectList", "data.table", "data.frame"), + "wrong class for a multi-row result") + + singleTouchAoi <- touchAois[1, ] + expect_identical(class(singleTouchAoi), c("imTouchAOI", "imAOI", "imObject", "data.table", "data.frame"), + "wrong class for a single-row result") +}) + +test_that("local return - the touch actor is kept alongside under its own columns", { + touchAois <- mockedGetTouchActorAois(study, stimulus, respondent) + + expect_true(all(c("touchActorId", "touchActorName", "hand") %in% names(touchAois)), + info = "touch actor columns should be present") + + expect_setequal(touchAois$touchActorId, c(TA1, TA1, TA2)) + expect_identical(unique(touchAois[touchAois$touchActorId == TA2, ]$hand), "Left", "wrong hand for second actor") +}) + +test_that("local return - the fileId of each combination is carried over", { + touchAois <- mockedGetTouchActorAois(study, stimulus, respondent) + + expect_true(all(!is.na(touchAois$fileId)), info = "every combination should have an in/out file") + expect_identical(touchAois[touchAois$id == AOI2, ]$fileId, "../data/touchActorEmptyRespondentData.pbin", + "the never-active AOI should point at the empty placeholder") +}) + +test_that("local return - filtering on a single touch actor", { + touchActor <- suppressWarnings(mockedGetTouchActors(study, stimulus))[2, ] + touchAois <- mockedGetTouchActorAois(study, touchActor, respondent) + + expect_equal(nrow(touchAois), 1, info = "only the second actor's single AOI should be returned") + expect_identical(touchAois$touchActorId, TA2, "wrong touch actor kept") +}) + +test_that("local return - contact details are fetched scoped to the requested actor, not the whole stimulus", { + touchActor <- suppressWarnings(mockedGetTouchActors(study, stimulus))[2, ] + + touchAois <- mockr::with_mock( + getTouchActors = function(...) { + stop("getTouchActors() should not be called - imObject is already a touch actor") + }, + privateGetTouchActorAoiDefinitions = function(...) aoiDefinitions(), + privateGetTouchActorDetails = function(study, imObject, respondent) { + expect_s3_class(imObject, "imTouchActor") + expect_identical(imObject$id, TA2, + "privateGetTouchActorDetails should be scoped to the requested touch actor") + jsonlite::fromJSON(touchActorDetailsPath) + }, { + getTouchActorAois(study, touchActor, respondent) + } + ) + + expect_equal(nrow(touchAois), 1, info = "only the second actor's single AOI should be returned") +}) + +test_that("local return - a touch actor on a non-Scene media source resolves its AOI name too", { + TA_ENV <- "4f2d6b30-7c44-4d1b-9c19-9c6b9e2a5b60" + AOI_ENV <- "1c9c8b18-3e1d-4b53-9c62-2a6b1a0d7e11" + + touchActorsMulti <- mockedGetTouchActors(study, stimulus, "../data/touchActorsMultiSource.json") + + # privateGetTouchActorAoiDefinitions() reaches every touch-capable camera (unlike privateAoiFiltering(), which is + # Scene-only), so the mock here carries the Environment AOI's own definition alongside the Scene ones. + aoiDefinitionsMultiSource <- function() { + return(rbind(aoiDefinitions(), data.table(stimulusId = "1002", stimulusName = "IAAF", id = AOI_ENV, + name = "Env Aoi", type = "Static", group = NA_character_, + area = 4000))) + } + + touchAois <- mockr::with_mock( + getTouchActors = function(...) touchActorsMulti, + privateGetTouchActorAoiDefinitions = function(...) aoiDefinitionsMultiSource(), + privateGetTouchActorDetails = function(...) jsonlite::fromJSON("../data/touchActorDetailsMultiSource.json"), { + getTouchActorAois(study, stimulus, respondent) + } + ) + + expect_equal(nrow(touchAois), 2, info = "both touch actors' AOIs should be returned regardless of media source") + expect_setequal(touchAois$mediaSourceType, c("StimulusCamera", "Environment")) + + sceneRow <- touchAois[touchAois$touchActorId == TA1, ] + envRow <- touchAois[touchAois$touchActorId == TA_ENV, ] + + expect_identical(sceneRow$id, AOI1, "wrong AOI kept for the Scene touch actor") + expect_identical(sceneRow$name, "New Aoi", info = "the Scene AOI is still resolved as before") + + expect_identical(envRow$id, AOI_ENV, info = "the AOI id itself comes from the touch actor side") + expect_identical(envRow$name, "Env Aoi", info = "an AOI on a non-Scene camera now resolves its real name too") + expect_identical(envRow$type, "Static", info = "type should resolve the same way") + expect_equal(envRow$area, 4000, info = "area should resolve the same way") + expect_false(is.na(envRow$fileId), info = "the contact in/out file should still be resolved for this row") + expect_identical(envRow$stimulusId, "1002", + info = "stimulusId should come from the touch actor, not the AOI join") + expect_identical(envRow$mediaSourceType, "Environment", "wrong media source kept for the environment actor") +}) + +test_that("local return - an AOI genuinely absent from every camera's definitions keeps its row, columns NA", { + touchActors <- suppressWarnings(mockedGetTouchActors(study, stimulus)) + + touchAois <- mockr::with_mock( + getTouchActors = function(...) touchActors, + privateGetTouchActorAoiDefinitions = function(...) NULL, + privateGetTouchActorDetails = function(...) jsonlite::fromJSON(touchActorDetailsPath), { + getTouchActorAois(study, stimulus, respondent) + } + ) + + expect_true(all(is.na(touchAois$name)), info = "no AOI definitions available should leave every name NA") + expect_true(all(is.na(touchAois$type)), info = "no AOI definitions available should leave every type NA") + expect_true(all(is.na(touchAois$area)), info = "no AOI definitions available should leave every area NA") + expect_false(any(is.na(touchAois$fileId)), info = "contact in/out resolution is unaffected") +}) + +test_that("warning - contact in/out signals found do not match any touch actor pair", { + expect_warning( + touchAois <- mockedGetTouchActorAois(study, stimulus, respondent, + detailsPath = "../data/touchActorDetails_noMatchingPair.json"), + "The contact in/out signals found do not match any touch actor AOI", + info = "the guard should still fire when pairs and details genuinely have nothing in common" + ) + + expect_null(touchAois, info = "result should be null") +}) + + +# getTouchActorAoi ===================================================================================================== +context("getTouchActorAoi()") + +mockedGetTouchActorAoi <- function(study, imObject, aoiId, respondent = NULL, + detailsPath = touchActorDetailsPath) { + touchActors <- suppressWarnings(mockedGetTouchActors(study, stimulus)) + + touchAoi <- mockr::with_mock( + getTouchActors = function(...) touchActors, + privateGetTouchActorAoiDefinitions = function(...) aoiDefinitions(), + privateGetTouchActorDetails = function(...) jsonlite::fromJSON(detailsPath), { + getTouchActorAoi(study, imObject, aoiId, respondent) + } + ) + + return(touchAoi) +} + +test_that("error - imObject or aoiId are missing", { + expect_error(getTouchActorAoi(study), + "Please specify a stimulus loaded with `getStimuli()` or a touch actor loaded with `getTouchActors()`", + fixed = TRUE, info = "missing `imObject` param not handled properly") + + expect_error(getTouchActorAoi(study, stimulus), + "Please specify an aoiId. Available touch actor AOIs can be found with `getTouchActorAois()`", + fixed = TRUE, info = "missing `aoiId` param not handled properly") +}) + +test_that("warning - imObject is a stimulus with no touch actor matching aoiId", { + expect_warning(touchAoi <- mockedGetTouchActorAoi(study, stimulus, "wrong-id"), + "No touch actor AOI found matching aoiId: wrong-id", + info = "wrong aoiId not handled properly") + + expect_null(touchAoi, info = "result should be null") +}) + +test_that("warning - touch actor matches but has no AOI matching aoiId", { + touchActor <- suppressWarnings(mockedGetTouchActors(study, stimulus))[2, ] # TA2 + + # AOI2 is only ever referenced by TA1 (see "interactiveAoiIds is kept as a list column" above) - TA2's own AOI + # list never includes it, regardless of respondent/contact data, so this should fail before any detail is fetched. + expect_warning(touchAoi <- mockedGetTouchActorAoi(study, touchActor, AOI2), + paste("No touch actor AOI found matching aoiId:", AOI2), + info = "wrong aoiId not handled properly") + + expect_null(touchAoi, info = "result should be null") +}) + +test_that("local return - imObject is a stimulus and aoiId matches more than one touch actor", { + # AOI1 is referenced by both TA1 and TA2, so a bare stimulus intentionally returns both as an imTouchAOIList. + touchAois <- mockedGetTouchActorAoi(study, stimulus, AOI1, respondent) + + expect_s3_class(touchAois, "imTouchAOIList") + expect_equal(nrow(touchAois), 2, info = "both touch actors sharing AOI1 should be returned") + expect_setequal(touchAois$touchActorId, c(TA1, TA2)) +}) + +test_that("local return - specific (touch actor, AOI) combination, scoped to the requested actor", { + touchAoi <- mockr::with_mock( + getTouchActors = function(...) suppressWarnings(mockedGetTouchActors(study, stimulus)), + privateGetTouchActorAoiDefinitions = function(...) aoiDefinitions(), + privateGetTouchActorDetails = function(study, imObject, respondent) { + expect_s3_class(imObject, "imTouchActor") + expect_identical(imObject$id, TA2, + "privateGetTouchActorDetails should be scoped to the requested touch actor") + jsonlite::fromJSON(touchActorDetailsPath) + }, { + touchActor <- suppressWarnings(mockedGetTouchActors(study, stimulus))[2, ] # TA2 + getTouchActorAoi(study, touchActor, AOI1, respondent) + } + ) + + expect_s3_class(touchAoi, "imTouchAOI") + expect_equal(nrow(touchAoi), 1, info = "should only contain a single (touch actor, AOI) combination") + expect_identical(touchAoi$touchActorId, TA2, "wrong touch actor id") + expect_identical(touchAoi$id, AOI1, "wrong AOI id") +}) + +test_that("local return - a stimulus resolves fine as long as aoiId is unambiguous", { + # AOI2 is only ever referenced by TA1, so passing the whole stimulus is not ambiguous here. + touchAoi <- mockedGetTouchActorAoi(study, stimulus, AOI2, respondent) + + expect_equal(nrow(touchAoi), 1, info = "should only contain a single (touch actor, AOI) combination") + expect_identical(touchAoi$touchActorId, TA1, "wrong touch actor id") + expect_identical(touchAoi$id, AOI2, "wrong AOI id") +}) + +test_that("local return - without a respondent, only the AOI/touch actor definition is returned", { + touchActor <- suppressWarnings(mockedGetTouchActors(study, stimulus))[2, ] # TA2 + touchAoi <- mockedGetTouchActorAoi(study, touchActor, AOI1, respondent = NULL) + + expect_equal(nrow(touchAoi), 1, info = "should only contain a single (touch actor, AOI) combination") + expect_false("fileId" %in% names(touchAoi), info = "no contact in/out details should be attached") +}) + + +# getAoiRespondentTouchData =========================================================================================== +context("getAoiRespondentTouchData()") + +touchAoiInOut <- function(fileId = "../data/touchActorRespondentData.pbin", resultId = NA_character_) { + touchAoi <- aoiDefinitions()[1, ] + touchAoi$touchActorId <- TA1 + touchAoi$fileId <- fileId + touchAoi$resultId <- resultId + class(touchAoi) <- c("imTouchAOI", class(touchAoi)) + return(touchAoi) +} + +test_that("error - arguments are missing or not from the good class", { + expect_error(getAoiRespondentTouchData(), "Please specify a study loaded with `imStudy()`", fixed = TRUE, + info = "missing `study` param not handled properly") + + expect_error(getAoiRespondentTouchData(study), + "Please specify a touch actor AOI loaded with `getTouchActorAois()`", fixed = TRUE, + info = "missing `touchAoi` param not handled properly") + + expect_error(getAoiRespondentTouchData(study, touchAoiInOut()), + "Please specify a respondent loaded with `getRespondents()`", fixed = TRUE, + info = "missing `respondent` param not handled properly") + + expect_error(getAoiRespondentTouchData(study, touchAoi = "whatever", respondent), + "`touchAoi` argument is not an imTouchAOI object", + info = "touchAoi not being an imTouchAOI object should throw an error") +}) + +test_that("local return - intervals for a specific (touch actor, AOI)/respondent pair", { + intervals <- getAoiRespondentTouchData(study, touchAoiInOut(), respondent)$intervals + + expect_equal(nrow(intervals), 2, info = "should have 2 active fragments") + expect_equal(intervals$fragments.start, c(9181.255, 16015.560), 1e-2, info = "wrong fragments start") + expect_equal(intervals$fragments.end, c(11400.944, 18352.070), 1e-2, info = "wrong fragments end") + expect_equal(intervals$fragments.duration, c(2219.689, 2336.510), 1e-2, info = "wrong fragments duration") + expect_identical(unique(intervals$type), "AOI", "intervals should all be of AOI type") + expect_identical(unique(intervals$parentId), "1002", "intervals should carry the stimulus as parent") + expect_identical(unique(intervals$parentName), "IAAF", "intervals should carry the stimulus name as parent") + expect_identical(unique(intervals$name), "New Aoi", "intervals should be named after the AOI") + expect_s3_class(intervals, "imIntervalList") +}) + +test_that("local return - inOutContact is compressed on contact and hand", { + inOutContact <- getAoiRespondentTouchData(study, touchAoiInOut(), respondent)$inOutContact + + expect_named(inOutContact, c("Timestamp", "IsContactInAOI", "HandType", "HandId"), info = "wrong column names") + expect_equal(nrow(inOutContact), 6, info = "should have 6 change rows") + expect_identical(inOutContact$IsContactInAOI, c(FALSE, TRUE, TRUE, FALSE, TRUE, FALSE), "wrong contact values") +}) + +test_that("local return - a hand handover mid-contact stays visible", { + inOutContact <- getAoiRespondentTouchData(study, touchAoiInOut(), respondent)$inOutContact + + expect_identical(inOutContact$HandType, c("Unknown", "Left", "Right", "Unknown", "Right", "Unknown"), + "hand codes should be decoded and the handover kept as its own row") + + expect_equal(inOutContact[inOutContact$HandType == "Left", ]$Timestamp, 9500, 1e-2, + info = "wrong timestamp for the left hand contact") +}) + +test_that("local check - AOI never active returns the empty shape rather than an error", { + result <- getAoiRespondentTouchData(study, touchAoiInOut("../data/touchActorEmptyRespondentData.pbin"), + respondent) + + expect_named(result, c("inOutContact", "intervals"), info = "wrong names") + expect_equal(nrow(result$inOutContact), 0, info = "should have no contact events") + expect_named(result$inOutContact, c("Timestamp", "IsContactInAOI", "HandType", "HandId"), + info = "empty inOutContact should still be well formed") + + expect_equal(nrow(result$intervals), 1, info = "should have a single placeholder interval") + expect_true(is.na(result$intervals$fragments.start), info = "placeholder interval should have no start") + expect_equal(result$intervals$fragments.duration, 0, info = "placeholder interval should have a 0 duration") +}) + + +# getAoiRespondentTouchMetrics ======================================================================================== +context("getAoiRespondentTouchMetrics()") + +test_that("error - arguments are missing or not from the good class", { + expect_error(getAoiRespondentTouchMetrics(study, touchAoi = "whatever", respondent), + "`touchAoi` argument is not an imTouchAOI object", + info = "touchAoi not being an imTouchAOI object should throw an error") +}) + +test_that("local return - metrics are read from the resultId", { + touchAoi <- touchAoiInOut(resultId = "../data/AOImetrics.csv") + metrics <- getAoiRespondentTouchMetrics(study, touchAoi, respondent) + + expect_equal(nrow(metrics), 1, info = "metrics should be a single row") + expect_s3_class(metrics, "imAOIMetrics") +}) + +test_that("warning - no metrics computed yet for this combination", { + expect_warning(metrics <- getAoiRespondentTouchMetrics(study, touchAoiInOut(), respondent), + "No contact metrics found for AOI: New Aoi, Respondent: Wendy", + info = "a missing resultId should throw a warning") + + expect_null(metrics, info = "result should be null") +}) + + +# privateRespondentFiltering.imTouchAOI =============================================================================== +context("privateRespondentFiltering.imTouchAOI()") + +touchAoiForRespondents <- function() { + touchAoi <- aoiDefinitions()[1, ] + touchAoi$touchActorId <- TA1 + class(touchAoi) <- c("imTouchAOI", class(touchAoi)) + return(touchAoi) +} + +test_that("local return - getRespondents() dispatches on imTouchAOI to use contact data, not gaze data", { + # A single, respondent-less call returns contact details across every respondent exposed to the stimulus - + # only Wendy and Quilana have a matching (touchActorId, aoiId) pair here, Olana's is for a different pair. + respondents <- mockr::with_mock( + privateGetTouchActorDetails = function(...) jsonlite::fromJSON(touchActorDetailsMultiRespondentPath), { + getRespondents(study, AOI = touchAoiForRespondents()) + } + ) + + expect_equal(nrow(respondents), 2, info = "both respondents with a matching contact pair should be kept") + expect_setequal(respondents$id, c("09bd22e6-29b6-4a8a-8cc1-4780a5163e63", "750ed075-1c8d-4aff-91b1-ed6c9e052808")) +}) + +test_that("local return - a respondent with contact data for another (touch actor, AOI) pair is not kept", { + respondents <- mockr::with_mock( + # This respondent has contact data, but not for the TA1/AOI1 pair being asked about. + privateGetTouchActorDetails = function(...) jsonlite::fromJSON(touchActorDetailsNoMatchPath), { + getRespondents(study, AOI = touchAoiForRespondents()) + } + ) + + expect_equal(nrow(respondents), 0, info = "no respondent should be kept") +}) + +test_that("local return - no respondent has contact data", { + respondents <- mockr::with_mock( + privateGetTouchActorDetails = function(...) NULL, { + getRespondents(study, AOI = touchAoiForRespondents()) + } + ) + + expect_equal(nrow(respondents), 0, info = "no respondent should be kept") +}) + + +# privateDecodeHandType =============================================================================================== +context("privateDecodeHandType()") + +test_that("hand codes are decoded to their labels", { + expect_identical(imotionsApi:::privateDecodeHandType(c(1, 2, 3)), c("Left", "Right", "Unknown"), + "wrong labels for the documented hand codes") +}) + +test_that("an unrecognised but present code is reported as unknown rather than dropped", { + expect_identical(imotionsApi:::privateDecodeHandType(c(9, -1, 0)), rep("Unknown", 3), + "unrecognised codes should not become missing values") +}) + +test_that("a genuinely missing code stays missing rather than becoming unknown", { + expect_identical(imotionsApi:::privateDecodeHandType(NA), NA_character_, + "a missing hand type means no touch occurred at all, not an unrecognised code") +}) + + +# Touch actor urls ==================================================================================================== +context("getTouchActorDetailsUrl()") + +test_that("url for every touch actor on a stimulus uses the wildcard form", { + url <- imotionsApi:::getTouchActorDetailsUrl(study, stimulus, respondent) + + expect_identical(url, file.path("http://localhost:8086/touchactors", study$id, "stimuli", stimulus$id, + "respondent", respondent$id, "*"), + "wrong url for all touch actors") +}) + +test_that("url for every touch actor on a stimulus, without a respondent, omits the respondent segment", { + url <- imotionsApi:::getTouchActorDetailsUrl(study, stimulus) + + expect_identical(url, file.path("http://localhost:8086/touchactors", study$id, "stimuli", stimulus$id, "*"), + "wrong url for all touch actors, all respondents") +}) + +test_that("url for a single touch actor uses its id - the wildcard sits on the actor, not the AOI", { + touchAoi <- aoiDefinitions()[1, ] + touchAoi$touchActorId <- TA1 + class(touchAoi) <- c("imTouchAOI", class(touchAoi)) + + url <- imotionsApi:::getTouchActorDetailsUrl(study, touchAoi, respondent) + + expect_identical(url, file.path("http://localhost:8086/touchactors", study$id, "stimuli", "1002", + "respondent", respondent$id, TA1), + "wrong url for a single touch actor") +}) + +test_that("url for a single touch actor, without a respondent, omits the respondent segment", { + touchAoi <- aoiDefinitions()[1, ] + touchAoi$touchActorId <- TA1 + class(touchAoi) <- c("imTouchAOI", class(touchAoi)) + + url <- imotionsApi:::getTouchActorDetailsUrl(study, touchAoi) + + expect_identical(url, file.path("http://localhost:8086/touchactors", study$id, "stimuli", "1002", TA1), + "wrong url for a single touch actor, all respondents") +}) + +test_that("url for a bare imTouchActor matches its imTouchAOI equivalent for the same actor", { + touchActor <- suppressWarnings(mockedGetTouchActors(study, stimulus))[2, ] + + urlWithRespondent <- imotionsApi:::getTouchActorDetailsUrl(study, touchActor, respondent) + urlAllRespondents <- imotionsApi:::getTouchActorDetailsUrl(study, touchActor) + + expect_identical(urlWithRespondent, file.path("http://localhost:8086/touchactors", study$id, "stimuli", "1002", + "respondent", respondent$id, TA2), + "wrong url for a bare touch actor, one respondent") + + expect_identical(urlAllRespondents, file.path("http://localhost:8086/touchactors", study$id, "stimuli", "1002", + TA2), + "wrong url for a bare touch actor, all respondents") +}) diff --git a/imotionsApi/tests/testthat/test-uploadAOIMetrics.R b/imotionsApi/tests/testthat/test-uploadAOIMetrics.R index cba57eb..01a8df5 100644 --- a/imotionsApi/tests/testthat/test-uploadAOIMetrics.R +++ b/imotionsApi/tests/testthat/test-uploadAOIMetrics.R @@ -116,6 +116,30 @@ test_that("local check - should call privateGetAoiDetails and fwrite for a speci expectCallsfwrite = 1) }) +test_that("local check - a touch AOI dispatches to privateGetTouchActorDetails rather than privateGetAoiDetails", { + touchAoi <- AOI + class(touchAoi) <- c("imTouchAOI", class(touchAoi)) + + expectedFilepath <- paste0(tools::file_path_sans_ext(AOIDetailsFile$fileId), "metrics.csv") + + privateGetAoiDetails_Stub <- mock() + privateGetTouchActorDetails_Stub <- mock(AOIDetailsFile) + fwrite_Stub <- mock() + + mockr::with_mock(privateGetAoiDetails = privateGetAoiDetails_Stub, + privateGetTouchActorDetails = privateGetTouchActorDetails_Stub, + fwrite = fwrite_Stub, { + privateUploadAoiMetrics(study, respondent, touchAoi, metrics) + }) + + expect_called(privateGetAoiDetails_Stub, 0) + expect_called(privateGetTouchActorDetails_Stub, 1) + expect_args(privateGetTouchActorDetails_Stub, 1, study = study, imObject = touchAoi, respondent = respondent) + + expect_called(fwrite_Stub, 1) + expect_args(fwrite_Stub, 1, x = metrics, file = expectedFilepath, col.names = TRUE, row.names = FALSE) +}) + test_that("remote check - should call privateUploadToPresignedUrl and putHttr for a specific respondent", { mockPrivateUploadAoiMetrics(study_cloud, respondent_cloud, AOI_cloud, metrics, AOIDetailsFile = AOI_cloud, expectCallsPut = 1, expectCallsPresigned = 1, expectFileRemoved = TRUE)