#' Segment within a JSONLabel with protocol information
#'
#' Takes a segmented "FemFit" object and constructs new baseline and event labels within the specified JSONLabel.
#'
#' @param x An "FemFit" object.
#' @param whichSession A character string which identifies which session to edit.
#' @param whichJSONLabel A character string which identifies which \code{JSONLabel} to edit.
#' @param numOfEvents How many events to identify.
#' @param baselineDuration Define the duration of a baseline region before an event region (in seconds). Recyles to length \code{numOfEvents}.
#' @param eventDuration Define the duration of an event region (in seconds). Recyles to length \code{numOfEvents}.
#' @param timeScale Time scale to work on. Defaults to working in seconds.
#'
#' @details
#' If a vector is inputted for either \code{whichSession} or \code{whichJSONLabel}, only the first element is used.
#'
#' @examples
#' # Read in the FemFit data
#' AS005 = read_FemFit(c(
#' "Datasets_AukRepeat/61aa0782289af385_283_csv.zip",
#' "Datasets_AukRepeat/61aa0782289af385_284_csv.zip"
#' ),
#' remove.NAs = TRUE
#' ) %>%
#' # Segment the FemFit data
#' segment(
#' cp. = 0.001,
#' numOfNodesToLabel = list(c(3, 1, 3, 4), c(4, 1, 5, 3))
#' )
#'
#' # Within a session refine the segmentation with protocol information
#' AS005r = segmentRefine_protocol(
#' x = AS005,
#' whichSession = "283 09:28",
#' whichJSONLabel = "valsalva3x6s_rest30s",
#' numOfEvents = 3,
#' baselineDuration = c(16, 12, 12),
#' eventDuration = c(5.5, 5, 5)
#' )
#'
#' @export
segmentRefine_protocol = function(x, whichSession, whichJSONLabel, numOfEvents, baselineDuration, eventDuration, timeScale = 1000) {
# Throw an error if the x argument is not an FemFit object or missing
if (!inherits(x, "FemFit") || is.na(x)) {
stop("The x argument is not an FemFit object.", call. = FALSE)
}
# Throw an error if trLabel does not exists in x$df
if (x$df %>% colnames %>% {any(grepl("^trLabel$", .))} %>% !.) {
stop("trLabel does not exist in the FemFit object.", call. = FALSE)
}
# Throw an error if the whichSession argument is not a character or missing
if (!is.character(whichSession[1]) || is.na(whichSession[1])) {
stop("The provided whichSession argument is not a character.", call. = FALSE)
}
# Throw an error if the whichJSONLabel argument is not a character or missing
if (!is.character(whichJSONLabel[1]) || is.na(whichJSONLabel[1])) {
stop("The provided whichJSONLabel argument is not a character.", call. = FALSE)
}
# Throw an error if the numOfEvents argument is not a numeric or missing
if (!is.numeric(numOfEvents[1]) || is.na(numOfEvents[1])) {
stop("The provided numOfEvents argument is not a numeric.", call. = FALSE)
}
# Throw an error if numOfEvents is not a positive integer
if (numOfEvents[1] %% 1 != 0 || numOfEvents <= 0) {
stop("The provided numOfEvents argument is not a positive integer.", call. = FALSE)
}
# Throw an error if the baselineDuration argument is not a numeric or missing
if (!is.numeric(baselineDuration) || anyNA(baselineDuration)) {
stop("The provided baselineDuration argument is not a numeric.", call. = FALSE)
}
# Throw an error if the eventDuration argument is not a numeric or missing
if (!is.numeric(eventDuration) || anyNA(eventDuration)) {
stop("The provided eventDuration argument is not a numeric.", call. = FALSE)
}
# Throw an error if the timeScale argument is not a numeric or missing
if (!is.numeric(timeScale[1]) || is.na(timeScale[1])) {
stop("The provided timeScale argument is not a numeric.", call. = FALSE)
}
# Recycle elements of baselineDuration and eventDuration if necessary
baselineDuration = rep(baselineDuration, length.out = numOfEvents)
eventDuration = rep(eventDuration, length.out = numOfEvents)
# Extract out the region to apply the protocol event identification
x_Child = x$df %>%
dplyr::filter(sessionID == whichSession[1], JSONLabel == whichJSONLabel[1])
if (nrow(x_Child) < 1) {
stop("The provided whichSession and whichJSONLabel arguments selected no observations.", call. = FALSE)
}
# Rescale baselineDuration and eventDuration to timeScale
baselineDuration = baselineDuration * timeScale[1]
eventDuration = eventDuration * timeScale[1]
x_Table = dplyr::tibble(
# Note that the c(rbind(<vector>, <vector>)) trick was done to interleave baselineDuration and eventDuration
timestamp = cumsum(c(rbind(baselineDuration, eventDuration))) + min(x_Child$time),
label = rep(c("baseline", "event"), times = numOfEvents)) %>%
dplyr::arrange(desc(timestamp))
# Construct the call to enforce a protocol informed segmentation
evalString = "x_Child = x_Child %>% mutate(trLabel = \"baseline\")"
for (i in 1:nrow(x_Table)) {
evalString = paste(evalString, sep = "%>%",
paste0("mutate(trLabel = if_else(time < ", x_Table$timestamp[i], ", \"", x_Table$label[i],"\", trLabel))")
)
}
eval(parse(text = evalString))
# Send back the results to the inputted object
x$df$trLabel[which(x$df$sessionID == whichSession[1] & x$df$JSONLabel == whichJSONLabel[1])] = x_Child$trLabel
return (x)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.