R/suggestShift.R

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

#' suggestShift
#
#' @description suggestShift registers all ESM prompts that are eligible to be modified.
#
#' @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 timeLagMinutes a numeric value. Specify the time difference in \strong{minutes} for questionnaires that might be shifted to a neighboring prompt. See \strong{Details} for more information.
#
#' @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}}.
#
#' @param RELEVANTINFO_ES a list. This list is generated by function \code{\link{setES}}.
#
#' @details If at least one questionnaire is registered as having been filled out repeatedly at a specific prompt it might be 'reasonable' to shift such questionnaires to a neighboring prompt index. The word 'reasonable' refers to the rule of how questionnaires get assigned to a specific prompt: For each participant the minimum time difference between the actual start time of a questionnaire and all of the participant's scheduled times (prompts) determines which prompt gets assigned to the actual start time. Say between 2 neighboring prompts 4 hours pass, then a questionnaire that was started 3 minutes after the prompt gets assigned to the same prompt as a questionnaire that was started 1 hour and 59 minutes after the prompt. Had it been started say exactly 2 hours after the prompt it would have been assigned to the subsequent prompt. It might be reasonable to assign such a questionnaire to this subsequent (neighboring) prompt.
#
#' @return a list. If at least one prompt is suggested for shifting,  a list containing the following 3 data.frames is returned:
#' \enumerate{
#' \item the first data.frame (called 'esDf') is the raw ESM dataset in its current state (with new colums SHIFT, SHIFTKEY, and LAG_MINUTES),
#' \item the second data.frame (called 'suggestShiftDf') includes all relevant information to act according to the decision as to which questionnaires shall be shifted. See \strong{Examples} in function \code{\link{makeShift}} to get a clear idea of how to use 'suggestShiftDf',
#' \item the third data.frame (called 'printShiftDf') contains the relevant information to print all questionnaires registered by \code{suggestShift} to the console, before as well as after having made the shifting. This printing to the console is done by applying the function \code{\link{printSuggestedShift}}.
#' }
#' If no prompt is suggested for shifting, the list elements 'suggestShiftDf' and 'printShiftDf' both are character strings which confirm that no shift is suggested.
#
#' @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 suggestShift. Start -------------
#' # Use example list delivered with the package
#' RELEVANTINFO_ES <- RELEVANTINFO_ES
#' # Use example list delivered with the package
#' RELEVANTVN_ES <- RELEVANTVN_ESext
#' # esAssigned is a list of datasets, delivered with the package. It is
#' # the result of the assignment of the ESM questionnaires to ALL 8
#' # participants in the reference dataset.
#' noEndDf <- missingEndDateTime(esAssigned[["ES"]], RELEVANTVN_ES)
#' identDf <- esIdentical(noEndDf, RELEVANTVN_ES)
#' # Prerequisites in order to execute suggestShift. End ---------------
#' # -------------------------------------------------------
#' # Run function 20 of 29; see esmprep functions' hierarchy.
#' # -------------------------------------------------------
#' # identDf is the result of function 'esIdentical'.
#' # 100 represents the number of minutes that at least must have passed
#' # between the scheduled start of an ESM questionnaire at its actual start
#' # in order for the questionnaire to be eligible for shifting (see function
#' # makeShift).
#' sugShift <- suggestShift(identDf, 100, RELEVANTINFO_ES, RELEVANTVN_ES)
#' # Display output element 'suggestShiftDf':
#' sugShift$suggestShiftDf
#' # Display output element 'printShiftDf':
#' sugShift$printShiftDf
#' # 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 20 of 29).
#
#' @export
#
suggestShift <- function(esDf, timeLagMinutes=NULL, RELEVANTINFO_ES=NULL, RELEVANTVN_ES=NULL) {

    if(!is.data.frame(esDf)) {
        stop("Function 'suggestShift' only accepts a single data frame as first argument.")
    }
    
    if(is.null(timeLagMinutes)) {
    		stop("The second argument 'timeLagMinutes' must not be NULL, but a numeric value.")
    }
	
	# 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=RELEVANTINFO_ES,
    			   RELEVANTVN_ES=RELEVANTVN_ES,
    			   RELEVANTVN_REF=NULL)
    
    if(sum(esDf[,"ES_MULT"]) == 0) {
    	
    		stop("Function 'suggestShift' checked all lines. No SHIFT suggested, which is why the function stopped. Continue with function 'expectedPromptIndex'.")
    
    } else {
    		
    		# idxShift: Dichotomous variable suggesting a SHIFT with the value 1.
	    esDf[,"SHIFT"] <- rep(0, times = nrow(esDf))
	    # idxKey: If a SHIFT is suggested the respective row number is noted.
	    esDf[,"SHIFTKEY"] <- rep(NA, times = nrow(esDf))
	    # LAGMINUTES: Time lag in minutes
	    esDf[,"LAG_MINUTES"] <- rep(NA, times=nrow(esDf))
	    
	    # Register all lines with time lag in minutes by what the user specifies:
	    idx0 <- which(abs(esDf[,"LAG_MINS"]) >= timeLagMinutes & !is.na(esDf[,"LAG_MINS"]))
	    
	    count <- 1
	    idx1 <- countIdx <- NEWPROMPT <- c()
	    for(esmUnit in idx0) {
	    		
	    		# Temporarily select the ESM unit which might be eligible for shifting, as specified by the user.
	    		idxTemp <- which(esDf[,"ID"]==esDf[esmUnit,"ID"] & esDf[,"CV_ESDAY"]==esDf[esmUnit,"CV_ESDAY"])
	    		
	    		if(esDf[esmUnit,"LAG_MINS"] < 0) {
	    			# Simulate backward shift of prompt and check whether this new prompt already exists in the ESM unit.
	    			newPrompt <- esDf[esmUnit,"PROMPT"] - 1
	    			eligible <- !(newPrompt %in% esDf[idxTemp,"PROMPT"]) & newPrompt >= 1
	    			if(eligible) {
	    				
	    				esDf[esmUnit,"SHIFT"] <- 1
	    			esDf[esmUnit,"SHIFTKEY"] <- esDf[esmUnit,"KEY"]
	    			esDf[esmUnit,"LAG_MINUTES"] <- esDf[esmUnit,"LAG_MINS"]
	    				
	    				NEWPROMPT <- c(NEWPROMPT, newPrompt)
	    				idx1 <- c(idx1, idxTemp)
	    				countIdx <- c(countIdx, rep(count, times=length(idxTemp)))
	    				count <- count + 1
	    			}
	    		# else: esDf[esmUnit,"LAG_MINUTES"] > 0
	    		} else {
	    			# Simulate forward shift of prompt and check whether this new prompt already exists in the ESM unit.
	    		newPrompt <- esDf[esmUnit,"PROMPT"] + 1
	    		eligible <- !(newPrompt %in% esDf[idxTemp,"PROMPT"]) & newPrompt <= RELEVANTINFO_ES[["MAXPROMPT"]]
		    		if(eligible) {
		    			
		    			esDf[esmUnit,"SHIFT"] <- 1
		    			esDf[esmUnit,"SHIFTKEY"] <- esDf[esmUnit,"KEY"]
		    			esDf[esmUnit,"LAG_MINUTES"] <- esDf[esmUnit,"LAG_MINS"]
		    			
		    			NEWPROMPT <- c(NEWPROMPT, newPrompt)
		    			idx1 <- c(idx1, idxTemp)
		    			countIdx <- c(countIdx, rep(count, times=length(idxTemp)))
		    			count <- count + 1
		    		}
	    		}
	    }
	   
	    # If at least one line has been found that might be SHIFTED:
	    if(sum(esDf[,"SHIFT"])>0) {
	        
	        for(k in 1:max(countIdx)) {
	            idxShiftUnit <- idx1[countIdx==k]
	            print(esDf[idxShiftUnit,c("ID", "KEY", RELEVANTVN_ES[["ES_SVY_NAME"]], "CV_ES", "CV_ESDAY", RELEVANTVN_ES[["ES_START_DATETIME"]], "ST", "PROMPT", "PROMPTEND", "ES_MULT", "SHIFT", "SHIFTKEY", "LAG_MINUTES")])
	            cat("--------------------------------------------------------------------------\n\n")
	        }
	
	    } else {
	        print("All lines were checked. No SHIFT suggested. Continue with function 'expectedPromptIndex'.")
	    }
	    
	    suggestShiftDf = data.frame(
	    ID=esDf$ID[esDf[,"SHIFT"]==1],
	    svyVersion= esDf[esDf[,"SHIFT"]==1,RELEVANTVN_ES[["ES_SVY_NAME"]]],
	    START_DATETIME=esDf[esDf[,"SHIFT"]==1,RELEVANTVN_ES[["ES_START_DATETIME"]]],
	    PROMPT=esDf$PROMPT[esDf[,"SHIFT"]==1],
	    NEW_PROMPT = NEWPROMPT,
	    SHIFTKEY=esDf$SHIFTKEY[esDf[,"SHIFT"]==1],
	    LAG_MINUTES=esDf$LAG_MINUTES[esDf[,"SHIFT"]==1])
	    
	    if(sum(esDf[,"SHIFT"])>0) {
	    		# Return the dataset (either with or without 2 new columns)
	    		list(esDf = esDf, suggestShiftDf = suggestShiftDf, printShiftDf = data.frame(indices=idx1, countIdx))
	    } else {
	    		list(esDf = esDf, suggestShiftDf = "No SHIFT suggested.", printShiftDf = "No SHIFT suggested.")
	    }
    }
}