R/makeShift.R

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

#' makeShift
#
#' @description makeShift can modify prompts which were assigned by the function \code{link{esAssign}}.
#
#' @param refDf a data.frame. The reference dataset.
#
#' @param keyPromptDf a data.frame. The data.frame must have exactly 2 columns. The one column's name must be SHIFTKEY (a numeric value), specifying the exact ESM questionnaire (via the use of the variable KEY). The ohter column's name must be NEW_PROMPT, specifying the new prompt index, i.e. the index after the shifting process will be over. See \strong{Details} for more information.
#
#' @param esDfShift a list. Each element of the list must be a data.frame. This argument is generated by \code{\link{suggestShift}} if at least one ESM questionnaire is eligible for shifting to a neighboring prompt. See \strong{Details} for more information.
#
#' @param RELEVANTINFO_ES a list. This list is generated by function \code{\link{setES}}.
#
#' @param RELEVANTVN_REF a list. This list is generated by function \code{\link{setREF}} and it is extended once either by function \code{\link{genDateTime}} or by function \code{\link{splitDateTime}}.
#
#' @details After applying \code{makeShift} the result can be checked by using the function \code{\link{printSuggestedShift}} once again.
#' If at least one shifting of the prompt index is suggested, use the additional data.frame, which is then is supplied by \code{\link{suggestShift}}, called 'suggestShiftDf'.' Use its 2 columns SHIFTKEY and NEW_PROMPT to generate the argument 'keyPromptDf' in function \code{makeShift}.
#
#' @return a list with 3 data.frames, if at least one prompt was shifted, i.e.:
#' \enumerate{
#' \item the first data.frame (called 'esDf') is the raw ESM dataset in its current state (with new colum SHIFTED),
#' \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} 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{\link{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}}.
#' }
#' \strong{Note}. Each questionnaire that got shifted to a neighboring prompt (which prior to the shift has not been assigned), will have its status changed, i.e. values get adapted in variables CV_ES, ES_MULT, PROMPT, and PROMPTEND.
#
#' @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 makeShift. Start ----------------
#' # RELEVANTINFO_ES is delivered with the package
#' # Use example list delivered with the package
#' RELEVANTVN_ES <- RELEVANTVN_ESext
#' # Use example list delivered with the package
#' RELEVANTVN_REF <- RELEVANTVN_REFext
#' # 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)
#' sugShift <- suggestShift(identDf, 100, RELEVANTINFO_ES, RELEVANTVN_ES)
#' # Prerequisites in order to execute makeShift. End -------------------
#' # -------------------------------------------------------
#' # Run function 22 of 29; see esmprep functions' hierarchy.
#' # -------------------------------------------------------
#' # sugShift is the result of function 'suggestShift'. referenceDfNew is the result
#' # of function 'genDateTime' or of function 'splitDateTime'.
#' # keyPromptDf is generated by using part of the output of function suggestShift,
#' # i.e. by selecting the columns NEW_PROMPT and SHIFTKEY from suggestShiftDf.
#' keyPromptDf <- sugShift$suggestShiftDf[,c("NEW_PROMPT", "SHIFTKEY")]
#' madeShift <- makeShift(sugShift, referenceDfNew, keyPromptDf, RELEVANTINFO_ES, RELEVANTVN_REF)
#' # Tip! Display the result of function 'makeShift' in the console
#' # in order to check whether the shifting was successful.
#' printSuggestedShift(madeShift, 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 22 of 29).
#
#' @export
#
makeShift <- function(esDfShift, refDf, keyPromptDf, RELEVANTINFO_ES = NULL, RELEVANTVN_REF = NULL) {
	
	if(!is.list(esDfShift) & length(esDfShift)!=3) {
    		stop("Relevant input is missing. Use this function only after executing function 'suggestShift'. BEWARE: If function 'suggestShift' doesn't suggest at least one shift, the function 'makeShift' makes no sense, i.e. if there is no ESM questionnaire eligible for shifting, both functions 'printSuggestedShift' and 'makeShift' can be ingored! Continue with function 'expectedPromptIndex'.")
    } else if(is.character(esDfShift[["suggestShiftDf"]]) && esDfShift[["suggestShiftDf"]] == "No SHIFT suggested.") {
    		stop("All lines were checked by function 'suggestShift'. No SHIFT suggested. Continue with function 'expectedPromptIndex'.")
    }
	
	esDfShiftInternList <- list(esDfIntern=esDfShift[[1]], suggestShiftDfIntern=esDfShift[[2]], printShiftDfIntern=esDfShift[[3]], refDfIntern=refDf, keyPromptDfIntern=keyPromptDf)
	
	checkKeyPromptDf <- names(keyPromptDf) %in% c("NEW_PROMPT", "SHIFTKEY")
	keyPromptDfNames <- paste0(names(keyPromptDf), collapse=", ")
	
	if( any( checkKeyPromptDf == FALSE | is.na(checkKeyPromptDf)) ) {
		stop(paste0("The argument 'keyPromptDf' must have exactly 2 columns. Their names must be: PROMPT and SHIFTKEY. Your column names are ", keyPromptDfNames, "."))
	}
	
	# 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=NULL,
    			   RELEVANTVN_REF=RELEVANTVN_REF)
	
    # stTimes: Names of the variables in 'referenceDf' that denote the scheduled times.
    
    # Extract word stem from variables in reference dataset, that denote the single
    # prompts, e.g. st or st_hms
    promptVarName <- unique(gsub("[0-9]", "", RELEVANTVN_REF[["REF_ST"]]))
    
    if(length(promptVarName) > 1) {
    		stop("Variable names in reference dataset, which denote the single prompts must ALL have the same root, e.g. 'st'. Please adjust this requirement in your reference dataset.")
    }
    
    stTimes <- paste0(promptVarName, 1:RELEVANTINFO_ES[["MAXPROMPT"]])
    SHIFTED <- rep(0, times = nrow(esDfShift[["esDf"]]))
    
    for(i in 1:nrow(keyPromptDf)) {

        # Translate the selected key value to a row index. The index
        # denotes the row within the dataset where the shifting shall
        # take place.
        idxShiftRow <- match(keyPromptDf[i,"SHIFTKEY"], esDfShift[["esDf"]][,"KEY"])

        if(esDfShift[["esDf"]][idxShiftRow,"PROMPT"] == keyPromptDf[i,"NEW_PROMPT"]){
            stop("New index for scheduled start time is equal to previous index. Processing stopped, SHIFT not executed.")
        }

        if(! (keyPromptDf[i,"NEW_PROMPT"] %in% c(1:RELEVANTINFO_ES[["MAXPROMPT"]])) ) {
            stop(paste0("New index for scheduled start time must be an integer number between 1 and ", RELEVANTINFO_ES[["MAXPROMPT"]], ". Processing stopped, SHIFT not executed."))
        }
		
		# Set variable 'CV_ES' to the correct value.
		cv_esDiff <- keyPromptDf[i,"NEW_PROMPT"] - esDfShift[["esDf"]][idxShiftRow,"PROMPT"]
		esDfShift[["esDf"]][idxShiftRow,"CV_ES"] <- esDfShift[["esDf"]][idxShiftRow,"CV_ES"] + cv_esDiff

        # Set variable 'PROMPT' to new start index (as specified by the user)
        esDfShift[["esDf"]][idxShiftRow,"PROMPT"] <- keyPromptDf[i,"NEW_PROMPT"]

        # Set variable 'SHIFTED' from 0 to 1
        SHIFTED[idxShiftRow] <- 1

        # Re-set the respective 1 in idxMult to 0 (no multiple questionnaire any more)
        esDfShift[["esDf"]][idxShiftRow+1,"ES_MULT"] <- 0
        
        # ES_MULT2 won't be re-set, because it will be re-computed and replaced in the
        # mandatory subsequent function randomMultSelect.
        
        # Re-set the scheduled time
        particIdx <- which(refDf[,RELEVANTVN_REF[["REF_ID"]]]==esDfShift[["esDf"]][idxShiftRow,"ID"])
        esDfShift[["esDf"]][idxShiftRow,"ST"] <- refDf[particIdx,stTimes[ keyPromptDf[i,"NEW_PROMPT"] ] ]

        # If the respective PROMPTEND index exists change it, too.
        if(!is.na(esDfShift[["esDf"]][idxShiftRow,"PROMPTEND"])) {

            esDfShift[["esDf"]][idxShiftRow,"PROMPTEND"] <- esDfShift[["esDf"]][idxShiftRow,"PROMPTEND"] + cv_esDiff

            # Else: PROMPTEND is NA. This must not be changed. Therefore no else case.
        }
    }
    esDfShift[["esDf"]][,"SHIFTED"] <- SHIFTED
    
    esDfShift <- list(esDf=esDfShift[["esDf"]], suggestedShiftDf=esDfShift[["suggestShiftDf"]], printShiftDf=esDfShift[["printShiftDf"]])
}