R/computeTimeLag.R

In mmiche/esmprep: Data Preparation During and After the Use of the Experience Sampling Methodology (ESM)

#' computeTimeLag
#
#' @description computeTimeLag computes the duration between the scheduled prompt and the actual start of an ESM questionnaire as well as whether it was started before or after the prompt.
#
#' @param esDf a data.frame. A single ESM dataset. It must contain the 2 columns that hold the date-time object for when an ESM questionnaire was started and finished, respectively.
#
#' @param RELEVANTVN_ES a list. This list is generated by function \code{\link{setES}} and it is extended once either by function \code{\link{genDateTime}} or by function \code{\link{splitDateTime}}.
#
#' @return \code{esDf} with 3 additional columns
#' \enumerate{
#' \item ST_DATETIME. Date-time object of scheduled start time of the single ESM questionnaire.
#' \item TIME_LAG. The duration between the scheduled start of a single ESM questionnaire and its' actual start time.
#' \item LAG_PA. Dichotomous variable, specifying whether the actual start was prior (P) to the scheduled time (LAG_PA = 0) or afterwards (A) (LAG_PA = 1).
#' }
#
#' @importFrom lubridate as.interval ymd_hms as.period parse_date_time
#
#' @examples
#' # o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o
#' # Prerequisites in order to execute computeTimeLag. Start -----------
#' # RELEVANTINFO_ES is delivered with the package
#' # Use example list delivered with the package
#' RELEVANTVN_ES <- RELEVANTVN_ESext
#' intoleranceDf <- data.frame(prompt = c(2, 3, 4, 1, 1),
#' expect = c(1, 1, 1, 2, 3))
#' # expectedDf is a raw ESM dataset, delivered with the package.
#' intolLs <- intolerable(expectedDf, intoleranceDf, RELEVANTINFO_ES)
#' randSelLs <- randomMultSelection(intolLs[["cleanedDf"]])
#' # Prerequisites in order to execute computeTimeLag. End -------------
#' # -------------------------------------------------------
#' # Run function 26 of 29; see esmprep functions' hierarchy.
#' # -------------------------------------------------------
#' # randSelLs[["esRandSelIn"]] is the result of function 'randomMultSelection'.
#' lagDf <- computeTimeLag(randSelLs[["esRandSelIn"]], RELEVANTVN_ES)
#' # o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o=o
#
#' @seealso Exemplary code (fully executable) in the documentation of \code{\link{esmprep}} (function 26 of 29).
#
#' @export
#
computeTimeLag <- function(esDf, RELEVANTVN_ES) {
	
	
	# Possible errors when passing arguments to the function -----------------------------
    if(!is.data.frame(esDf)) {
        stop("Argument 'esDf' must be of type data.frame.")
    }
	
	
	# Error handling function for all set-up lists generated by setES and setREF.
    # Both lists RELEVANTVN_ES and RELEVANTVN_REF get extended either by function
    # genDateTime or by function splitDateTime!
    SETUPLISTCheck(RELEVANTINFO_ES=NULL,
    			   RELEVANTVN_ES=RELEVANTVN_ES,
    			   RELEVANTVN_REF=NULL)
	
	
    if(any(is.na(match(c(RELEVANTVN_ES[["ES_START_DATETIME"]], "ST"),
                       names(esDf))))) {
        stop(paste0("In order to compute the time lag the variables ",
                    RELEVANTVN_ES[["ES_START_DATETIME"]],
                    " and ST must be part of the data.frame that is passed to this function."))
    }
	
	# If in function esAssign the argument midnightPrompt is set to TRUE, then the
	# column name 'STDATE' in argument esDf of function computeTimeLag must exist:
	if(any(names(esDf) == "STDATE")) {
		useDate <- as.Date(esDf[,RELEVANTVN_ES[["ES_START_DATETIME"]]]) + lubridate::days(esDf[,"STDATE"])
	} else {
		useDate <- as.Date(esDf[,RELEVANTVN_ES[["ES_START_DATETIME"]]])
	}
	
    st_dateTime <- paste(useDate, esDf[,"ST"])
    spanLag <- lubridate::as.interval(lubridate::ymd_hms(st_dateTime), lubridate::ymd_hms(esDf[,RELEVANTVN_ES[["ES_START_DATETIME"]]]))
    periodLag <- lubridate::as.period(spanLag)
    lag_ba <- ifelse(periodLag @ minute < 0, 0, 1)

    lagFormat <- lubridate::parse_date_time(paste0(periodLag@hour, ":", periodLag@minute, ":", periodLag@.Data), "%H%M%S")
    timeLag <- format(lagFormat, "%H:%M:%S")
	
	esDf[,"ST_DATETIME"] <- st_dateTime
    esDf[,"TIME_LAG"] <- timeLag
    esDf[,"LAG_PA"] <- lag_ba

    return(esDf)
}