R/apollo_modifyUserDefFunc.R

In apollo: Tools for Choice Model Estimation and Application

#' Checks and modifies Apollo user-defined functions
#'
#' Checks and enhances user defined functions apollo_probabilities, apollo_randCoeff and apollo_lcPars.
#'
#' Internal use only. Called by \code{apollo_estimate} before estimation.
#' Checks include: no re-definition of variables, no (direct) calls to database, 
#' calling of apollo_weighting if weights are defined.
#' 
#' @param apollo_beta Named numeric vector. Names and values for parameters.
#' @param apollo_probabilities Function. Returns probabilities of the model to 
#'                             be estimated. Must receive three arguments:
#'                             \itemize{
#'                              \item \strong{\code{apollo_beta}}: Named numeric vector. 
#'                                                                 Names and values of 
#'                                                                 model parameters.
#'                              \item \strong{\code{apollo_inputs}}: List containing 
#'                                                                   options of the model. 
#'                                                                   See \link{apollo_validateInputs}.
#'                              \item \strong{\code{functionality}}: Character. Can be 
#'                                                                   either \code{"components"}, 
#'                                                                   \code{"conditionals"}, 
#'                                                                   \code{"estimate"} (default), 
#'                                                                   \code{"gradient"}, 
#'                                                                   \code{"output"}, 
#'                                                                   \code{"prediction"}, 
#'                                                                   \code{"preprocess"}, 
#'                                                                   \code{"raw"}, \code{"report"}, 
#'                                                                   \code{"shares_LL"}, 
#'                                                                   \code{"validate"} or 
#'                                                                   \code{"zero_LL"}.
#'                             }
#' @param apollo_fixed Character vector. Names of parameters inside apollo_beta
#'                     whose values should be kept constant throughout estimation.
#' @param apollo_inputs List grouping most common inputs. Created by function 
#'                      \link{apollo_validateInputs}.
#' @param validate Logical. If TRUE, the original and modified 
#'                 \code{apollo_probabilities} functions are estimated. If their 
#'                 results do not match, then the original functions are 
#'                 returned, and \code{success} is set to \code{FALSE} inside 
#'                 the returned list.
#' @param noModification Logical. If TRUE, loop expansion etc are skipped.
#' @return List with four elements: apollo_probabilities, apollo_randCoeff, 
#'         apollo_lcPars and a dummy called success (TRUE if modification was
#'         successful, FALSE if not. FALSE will be only be returnes if
#'         the modifications are validated).
#' @export
apollo_modifyUserDefFunc <- function(apollo_beta, apollo_fixed, 
                                     apollo_probabilities, apollo_inputs, 
                                     validate=TRUE, noModification=FALSE){
  silent <- apollo_inputs$silent
  debug  <- apollo_inputs$apollo_control$debug
  
  # # # #  # # # # 
  #### Checks ####
  # # # #  # # # # 
  
  ### Check for apollo_attach in apollo_probabilities
  tmp  <- deparse(apollo_probabilities)
  usesAttach <- FALSE
  if(any(grepl("apollo_attach", tmp))) usesAttach <- TRUE
  if(!usesAttach && !silent) apollo_print("You are not using apollo_attach, this may affect performance and capabilities", type="w", pause=0)
  
  ### Check for apollo_prepareProb() and return() in apollo_probabilities
  if(!any(grepl("apollo_prepareProb", tmp))) stop("SYNTAX ISSUE - The 'apollo_probabilities' function should include a call to 'apollo_prepareProb'!")
  if(!any(grepl("return", tmp))) stop("SYNTAX ISSUE - The 'apollo_probabilities' function should include a 'return' statement at the end, usually 'return(P)'!")
  
  ### Check that apollo_beta is not called, unless not using attach
  tmp <- as.character(body(apollo_probabilities))
  if(usesAttach && any(grepl("apollo_beta[", tmp, fixed=TRUE))){
    stop("SYNTAX ISSUE - The apollo_beta object is 'attached' and elements should thus be called",
         " directly in apollo_probabilities without the 'apollo_beta[...]' syntax.")
  }
  
  ### Check that names of params in apollo_beta, database, apollo_randCoeff & apollo_lcPars are not re-defined
  tmp <- gsub("(", "", tmp, fixed=TRUE)
  tmp <- gsub(")", "", tmp, fixed=TRUE)
  tmp <- gsub(" ", "", tmp, fixed=TRUE)
  # check for apollo_beta
  for(i in names(apollo_beta)){
    test <- grep(paste0("^",i,"="), tmp)
    test <- c(test, grep(paste0("^",i,"<-"), tmp))
    if(length(test)>0) stop("SYNTAX ISSUE - Parameter ", i, " from apollo_beta was re-defined ",
                            "inside apollo_probabilities. This is not allowed.")
  }
  for(i in names(apollo_inputs$database)){
    test <- grep(paste0("^",i,"(=|<-)"), tmp)
    if(length(test)>0) stop("SYNTAX ISSUE - Variable ", i, " from database is re-defined ", 
                            "inside apollo_probabilities. This is not allowed")
  }; rm(i, test)
  #check for apollo_randCoeff
  if(apollo_inputs$apollo_control$mixing && is.function(apollo_inputs$apollo_randCoeff)){
    env <- c(apollo_inputs$database, apollo_inputs$draws, as.list(apollo_beta))
    env <- list2env(env, hash=TRUE, parent=parent.frame())
    rnd <- apollo_inputs$apollo_randCoeff; environment(rnd) <- env
    rnd <- rnd(apollo_beta, apollo_inputs)
    for(i in names(rnd)){
      test <- grep(paste0('^', i, '=|^', i, '<-'), tmp)
      if(length(test)>0) stop("SYNTAX ISSUE - Parameter ", i, " from apollo_randCoeff was re-defined ",
                              "inside apollo_probabilities. This is not allowed.")
    }; rm(env, i, test)
  }
  #check for apollo_lcPars
  if(is.function(apollo_inputs$apollo_lcPars)){
    env <- c(apollo_inputs$database, as.list(apollo_beta))
    if(exists('rnd', inherits=FALSE)) env <- c(env, apollo_inputs$draws, rnd)
    env <- list2env(env, hash=TRUE, parent=parent.frame())
    lcp <- apollo_inputs$apollo_lcPars; environment(lcp) <- env
    lcp <- names(lcp(apollo_beta, apollo_inputs))
    for(i in lcp){
      test <- grep(paste0('^', i, '=|^', i, '<-'), tmp)
      if(length(test)>0) stop("SYNTAX ISSUE - Parameter ", i, " from apollo_lcPars was re-defined ",
                              "inside apollo_probabilities. This is not allowed.")
    }; rm(env, lcp, i, test)
  }; if(exists('rnd')) rm(rnd)
  rm(tmp)
  
  ### Check there are no references to database inside apollo_probabilities
  if(is.function(apollo_probabilities)){
    tmp <- as.character(body(apollo_probabilities))
    tmp <- gsub("apollo_inputs$database", " ", tmp, fixed=TRUE)
    tmp <- grep("database", tmp, fixed=TRUE)
    if(length(tmp)>0) stop("SYNTAX ISSUE - The database object is 'attached' and elements should thus be called",
                           " directly in apollo_probabilities without the 'database$' prefix. If there is a specific",
                           " reason for doing so, the  'apollo_inputs$database$' prefix has to be used.")
    rm(tmp)
  }
  
  ### Check apollo_weighting is called if apollo_control$weights are defined (unless apollo_inputs$EM is TRUE)
  w <- apollo_inputs$apollo_control[['weights']]
  test <- is.null(apollo_inputs$EM) || (is.logical(apollo_inputs$EM) && !apollo_inputs$EM)
  test <- test && !is.null(w) && !is.null(apollo_inputs$database) && (w %in% names(apollo_inputs$database))
  if(test){
    tmp <- as.character(body(apollo_probabilities))
    tmp <- grep('apollo_weighting', tmp, fixed=TRUE)
    if(length(tmp)==0) stop('SYNTAX ISSUE - When using weights, apollo_weighting should be called inside apollo_probabilities.')
    rm(tmp)
  }; rm(w)
  
  ### Check that for loops do not use the same index
  getIndices <- function(e){
    # Check if it is a function
    if(is.function(e)) e <- body(e)
    # Case 1: value
    isVal <- is.symbol(e) || is.numeric(e) || is.character(e) || 
      is.logical(e) || is.complex(e)
    if(isVal) return(NULL)
    # Case 2: "for" call
    ans <- c()
    test1 <- is.call(e) || is.expression(e)
    test2 <- test1 && length(e)==4 && is.symbol(e[[1]]) && as.character(e[[1]])=='for'
    if(test2) ans <- as.character(e[[2]])
    # Case 3: another type of call or expression
    if(test1) for(i in 1:length(e)) if(!is.null(e[[i]])){
      ans <- c(ans, getIndices(e[[i]]))
    }
    return(ans)
  }
  checkIndices <- function(f){
    argName <- as.character(match.call()[[2]])
    i <- getIndices(f)
    if(length(i)>length(unique(i))){
      tmp <- setNames(as.vector(table(i)), unique(i))
      stop("SYNTAX ISSUE - ",
           "Index/indices \"", paste0(names(tmp[tmp>1]), collapse="\", \""),
           "\" is/are used inside more than one \"for\" loop(s) inside ", 
           argName, ". Each index should be used inside only one \"for\" loop.")
    }; return(NULL)
  }
  if(is.function(apollo_probabilities)) checkIndices(apollo_probabilities)
  if(apollo_inputs$apollo_control$mixing && 
     is.function(apollo_inputs$apollo_randCoeff)){
    checkIndices(apollo_inputs$apollo_randCoeff)
  }
  if(is.function(apollo_inputs$apollo_lcPars)) checkIndices(apollo_inputs$apollo_lcPars)
  
  ### Check that variables in the global environemnt are not used inside 
    # apollo_probabilities, apollo_randCoeff, or apollo_lcPars
  checkVars <- function(e, vge=NULL, funName=NULL){
    if(is.null(vge)){
      vge <- ls(envir=globalenv())
      vge <- vge[!(vge %in% c("apollo_inputs", "apollo_beta"))]
    }
    # If it is a value, ignore
    test <- is.numeric(e) || is.character(e) || is.logical(e) || is.complex(e)
    if(test) return(NULL)
    # If it is a symbol, it shouldn't be in the global environment
    if(is.symbol(e)){
      if(as.character(e) %in% vge){
        tmp <- paste0("Object ", as.character(e), " from ",
                      "the global environment should not ",
                      "be used inside ", 
                      ifelse(is.null(funName), 
                             "apollo functions", funName), 
                      ". If needed, save it inside ",
                      "apollo_inputs and call it as ",
                      "apollo_inputs$", as.character(e), ".") 
        apollo_print(tmp, type="w", pause=0)
      }
      return(NULL)
    }
    # If it is apollo_inputs$something, ignore
    test <- is.call(e) && length(e)>=2 && is.symbol(e[[1]]) && 
      (as.character(e[[1]]) %in% c("$","[[")) && 
      is.symbol(e[[2]]) && as.character(e[[2]])=="apollo_inputs"
    if(test) return(NULL)
    # If it is call or expression, go through it element by element
    if(is.call(e) || is.expression(e)) if(length(e)>=1){
      for(i in 1:length(e)) checkVars(e[[i]], vge=vge, funName=funName)
    }
    return(NULL)
  }
  checkVars(body(apollo_probabilities), funName="apollo_probabilities")
  if(is.function(apollo_inputs$apollo_randCoeff)){
    checkVars(body(apollo_inputs$apollo_randCoeff), funName="apollo_randCoeff")
  }
  if(is.function(apollo_inputs$apollo_lcPars)){
    checkVars(body(apollo_inputs$apollo_lcPars), funName="apollo_lcPars")
  }
  
  
  # # # # # # # # # # # # # # # # # # #
  #### Validate and prepare scaling ####
  # # # # # # # # # # # # # # # # # # #
  scaling <- setNames(rep(1, length(apollo_beta)-length(apollo_fixed)), 
                      names(apollo_beta)[!(names(apollo_beta) %in% apollo_fixed)])
  test <- is.vector(apollo_inputs$apollo_scaling) && is.numeric(apollo_inputs$apollo_scaling)
  test <- test && !is.null(names(apollo_inputs$apollo_scaling)) && !anyNA(apollo_inputs$apollo_scaling)
  if(!test){
    # If the user did not provide any scaling
    # (apollo_inputs$apollo_scaling is NULL, NA, or doesn't have names)
    apollo_inputs$apollo_scaling <- scaling
    apollo_inputs$manualScaling  <- FALSE
  } else {
    # If the user did provide scaling
    # Check that all scaling correspond to existing parameters
    if(!all(names(apollo_inputs$apollo_scaling) %in% names(apollo_beta))){
      txt <- names(apollo_inputs$apollo_scaling)[!(names(apollo_inputs$apollo_scaling) %in% names(apollo_beta))]
      stop(paste0("SYNTAX ISSUE - Some parameters included in 'scaling' (", paste0(txt, collapse=", "), 
                  ") are not included in 'apollo_beta'."))
    }
    # Check for duplicates
    if(anyDuplicated(names(apollo_inputs$apollo_scaling))){
      txt <- names(apollo_inputs$apollo_scaling)[duplicated(names(apollo_inputs$apollo_scaling))]
      stop(paste0("SYNTAX ISSUE - The \"scaling\" setting contains duplicate elements (", paste0(txt, collapse=", "), ")."))
    }
    # Copy user provided scales into "scaling"
    scaling[names(apollo_inputs$apollo_scaling)] <- apollo_inputs$apollo_scaling
    # Check no fixed params are scaled
    if(any(names(scaling) %in% apollo_fixed)) stop("SYNTAX ISSUE - Parameters in 'apollo_fixed' should not be included in 'scaling'")
    # Check there are no negative scaling values. If there are, take their abs value.
    if(any(scaling<0)){
      scaling <- abs(scaling)
      txt <- 'Some negative values in "scaling" were replaced by their absolute value'
      if(!silent) apollo_print(paste0(txt, '.'), type="w") else warning(txt)
    }; if(any(scaling<=0)) stop('SYNTAX ISSUE - All terms in "scaling" should be strictly positive!')
    txt <- "During estimation, parameters will be scaled using the values in estimate_settings$scaling"
    if(!all(scaling==1)){ if(!silent) apollo_print(paste0(txt, '.'), type="i") else warning(txt)}
    rm(txt)
    apollo_inputs$apollo_scaling <- scaling
    apollo_inputs$manualScaling  <- TRUE
  }
  rm(scaling)
  
  # # # # # # # # # # # # # # # # # # # # #
  #### Create testing values for beta ####
  # # # # # # # # # # # # # # # # # # # # #
  
  if(!apollo_inputs$apollo_control$HB){
    apollo_beta_shifted <- apollo_beta + 0.0001  
  }else{
    apollo_HB=apollo_inputs$apollo_HB
    apollo_test_beta=apollo_beta
    if(!is.null(apollo_HB$gVarNamesFixed)){
      r <- ( names(apollo_beta) %in% apollo_HB$gVarNamesFixed )
      r <- names(apollo_beta)[r]
      apollo_test_beta[r] <- apollo_HB$FC[r]
    }
    if(!is.null(apollo_HB$gVarNamesNormal)){
      r <- ( names(apollo_beta) %in% apollo_HB$gVarNamesNormal )
      r <- names(apollo_beta)[r]
      dists_normal=names(apollo_HB$gDIST[r][apollo_HB$gDIST[r]==1])
      dists_lnp=names(apollo_HB$gDIST[r][apollo_HB$gDIST[r]==2])
      dists_lnn=names(apollo_HB$gDIST[r][apollo_HB$gDIST[r]==3])
      dists_cnp=names(apollo_HB$gDIST[r][apollo_HB$gDIST[r]==4])
      dists_cnn=names(apollo_HB$gDIST[r][apollo_HB$gDIST[r]==5])
      dists_sb=names(apollo_HB$gDIST[r][apollo_HB$gDIST[r]==6])
      if(length(dists_normal)>0) apollo_test_beta[dists_normal] <- apollo_HB$svN[dists_normal]
      if(length(dists_lnp)>0) apollo_test_beta[dists_lnp] <- exp(apollo_HB$svN[dists_lnp])
      if(length(dists_lnn)>0) apollo_test_beta[dists_lnn] <- -exp(apollo_HB$svN[dists_lnn])
      if(length(dists_cnp)>0) apollo_test_beta[dists_cnp] <- apollo_HB$svN[dists_cnp]*(apollo_HB$svN[dists_cnp]>0)
      if(length(dists_cnn)>0) apollo_test_beta[dists_cnn] <- apollo_HB$svN[dists_cnn]*(apollo_HB$svN[dists_cnn]<0)
      if(length(dists_sb)>0){
        names(apollo_HB$gMINCOEF)=names(apollo_HB$svN)
        names(apollo_HB$gMAXCOEF)=names(apollo_HB$svN)
        apollo_test_beta[dists_sb] <- apollo_HB$gMINCOEF[dists_sb]+(apollo_HB$gMAXCOEF[dists_sb]-apollo_HB$gMINCOEF[dists_sb])/(1+exp(-apollo_HB$svN[dists_sb]))
      }
      rm(dists_normal, dists_lnp, dists_lnn, dists_cnp, dists_cnn, dists_sb)
    }
    apollo_beta_shifted <- apollo_test_beta + 0.0001  
    rm(apollo_test_beta)
  }

  # # # # # # # # # # # #
  #### Modifications ####
  # # # # # # # # # # # #
  
  if(!silent) apollo_print("Preparing user-defined functions.")
  
  ### Store unaltered version of functions in case modification fails
  apollo_probabilities_ORIG <- apollo_probabilities
  apollo_randCoeff_ORIG     <- apollo_inputs$apollo_randCoeff
  apollo_lcPars_ORIG        <- apollo_inputs$apollo_lcPars
  
  ### Insert componentName if missing
  if(debug) apollo_print("- Inserting component name in apollo_probabilities")
  apollo_probabilities <- apollo_insertComponentName(apollo_probabilities)
  
  ### Evaluate apollo_probabilities before changes, return immediately if it doesn't work
  # NOTE: We should simplify this by calling apollo_validate BEFORE modifying the functions.
  #       But to do that, we would need to either not check for component names
  #       or insert the component names beforehand. Or call apollo_probabilities(..., "validate")
  #       right here.
  if(validate || noModification){
    #apollo_beta_shifted <- apollo_beta + 0.0001
    test1 <- tryCatch(apollo_probabilities(apollo_beta_shifted, apollo_inputs), 
                      error=function(e) if(grepl("not found|ISSUE|INCORRECT",e,fixed=FALSE)){
                        stop(e)
                      }else{
                        NULL
                      } )
    if(anyNA(test1)) test1 <- NULL
    if(sum(test1)==0) test1 <- NULL
    test <- is.null(test1) || noModification
    if(test){
      apollo_print(paste0("The pre-processing of 'apollo_probabilities' failed in initial testing.",
                          " Your model may still run, but this indicates a potential problem. Please contact the", 
                          " developers for assistance!"),  pause=0, type="w")
      return(list(apollo_probabilities = apollo_probabilities, # returns version with names inserted
                  apollo_randCoeff     = apollo_randCoeff_ORIG, 
                  apollo_lcPars        = apollo_lcPars_ORIG,
                  #apollo_scaling       = setNames(rep(1, length(apollo_inputs$apollo_scaling)),
                  #                               names(apollo_inputs$apollo_scaling)), 
                  apollo_scaling       = apollo_inputs$apollo_scaling,
                  success              = FALSE))
    } 
  }
  ### Update ORIG version to keep changes so far
  apollo_probabilities_ORIG <- apollo_probabilities
  
  ### Change c to list if using OL
  if(debug) apollo_print("- Replacing tau=c(...) by tau=list(...) in calls to apollo_ol.")
  test <- any(grepl("apollo_ol", as.character(body(apollo_probabilities))))
  if(test) apollo_probabilities <- apollo_insertOLList(apollo_probabilities)
  test <- is.function(apollo_inputs$apollo_randCoeff) && 
    apollo_inputs$apollo_control$mixing && 
    any(grepl("apollo_ol", as.character(body(apollo_inputs$apollo_randCoeff))))
  if(test) apollo_inputs$apollo_lcPars <- apollo_insertOLList(apollo_inputs$apollo_lcPars)
  test <- is.function(apollo_inputs$apollo_lcPars) &&
    any(grepl("apollo_ol", as.character(body(apollo_inputs$apollo_lcPars))))
  if(test) apollo_inputs$apollo_lcPars <- apollo_insertOLList(apollo_inputs$apollo_lcPars)
  ### Evaluate apollo_probabilities after current changes, return immediately if it doesn't work
  if(validate){
    test2 <- tryCatch(apollo_probabilities(apollo_beta_shifted, apollo_inputs), error=function(e) NULL)
    test <- !is.null(test1) && !is.null(test2) && is.numeric(test1) && is.numeric(test2)
    test <- test && !any(is.nan(test1)) && !any(is.nan(test2)) && abs(sum(test2)/sum(test1) - 1) < 0.001
    if(!test){
      # If they are different or evaluation of test2 failed, then undo changes
      apollo_print(paste0("The pre-processing of 'apollo_probabilities' failed during syntax checking.", 
                          " Your model may still run, but this indicates a potential problem. Please contact the", 
                          " developers for assistance!"),  pause=0, type="w")
      return(list(apollo_probabilities = apollo_probabilities_ORIG, 
                  apollo_randCoeff     = apollo_randCoeff_ORIG, 
                  apollo_lcPars        = apollo_lcPars_ORIG,
                  #apollo_scaling       = setNames(rep(1, length(apollo_inputs$apollo_scaling)),
                  #                                names(apollo_inputs$apollo_scaling)), 
                  apollo_scaling       = apollo_inputs$apollo_scaling,
                  success              = FALSE))
    }
  }
  ### Update ORIG version to keep changes so far
  apollo_probabilities_ORIG <- apollo_probabilities
  apollo_randCoeff_ORIG     <- apollo_inputs$apollo_randCoeff
  apollo_lcPars_ORIG        <- apollo_inputs$apollo_lcPars
  
  
  ### Expand loop
  if(is.function(apollo_inputs$apollo_randCoeff) && apollo_inputs$apollo_control$mixing){
    if(debug) apollo_print("- Expanding loops in apollo_randCoeff.")
    tmp <- tryCatch( apollo_expandLoop(apollo_inputs$apollo_randCoeff, apollo_inputs), error=function(e) NULL)
    if(is.function(tmp)) apollo_inputs$apollo_randCoeff <- tmp
    rm(tmp)
  }
  if(is.function(apollo_inputs$apollo_lcPars)){
    if(debug) apollo_print("- Expanding loops in apollo_lcPars.")
    tmp <- tryCatch( apollo_expandLoop(apollo_inputs$apollo_lcPars, apollo_inputs), error=function(e) NULL)
    if(is.function(tmp)) apollo_inputs$apollo_lcPars <- tmp
    rm(tmp)
  }
  if(debug) apollo_print("- Expanding loops in apollo_probabilities.")
  tmp <- tryCatch( apollo_expandLoop(apollo_probabilities, apollo_inputs), error=function(e) NULL)
  if(is.function(tmp)) apollo_probabilities <- tmp
  rm(tmp)
  
  ### Evaluate apollo_probabilities after current changes, return immediately if it doesn't work
  if(validate){
    test2 <- tryCatch(apollo_probabilities(apollo_beta_shifted, apollo_inputs), error=function(e) NULL)
    test <- !is.null(test1) && !is.null(test2) && is.numeric(test1) && is.numeric(test2)
    test <- test && !any(is.nan(test1)) && !any(is.nan(test2)) && abs(sum(test2)/sum(test1) - 1) < 0.001
    if(!test){
      # If they are different or evaluation of test2 failed, then undo changes
      apollo_print(paste0("The pre-processing of 'apollo_probabilities' failed during loop expansion.", 
                          " Your model may still run, but this indicates a potential problem. Please contact the", 
                          " developers for assistance!"),  pause=0, type="w")
      return(list(apollo_probabilities = apollo_probabilities_ORIG, 
                  apollo_randCoeff     = apollo_randCoeff_ORIG, 
                  apollo_lcPars        = apollo_lcPars_ORIG,
                  #apollo_scaling       = setNames(rep(1, length(apollo_inputs$apollo_scaling)),
                  #                                names(apollo_inputs$apollo_scaling)), 
                  apollo_scaling       = apollo_inputs$apollo_scaling,
                  success              = FALSE))
    }
  }
  ### Update ORIG version to keep changes so far
  apollo_probabilities_ORIG <- apollo_probabilities
  apollo_randCoeff_ORIG     <- apollo_inputs$apollo_randCoeff
  apollo_lcPars_ORIG        <- apollo_inputs$apollo_lcPars
  
  ### Insert scaling (only if no apollo_inputs$apollo_scaling is found inside)
  test <- as.character(body(apollo_probabilities))
  test <- grepl('apollo_inputs$apollo_scaling', test, fixed=TRUE)
  if(any(test)){
    if(debug) apollo_print("- Scaling not inserted because it is already present in apollo_probabilities.")
  } else {
    if(debug) apollo_print("- Inserting scaling in apollo_probabilities")
    apollo_probabilities <- apollo_insertScaling(apollo_probabilities, apollo_inputs$apollo_scaling)
    if(apollo_inputs$apollo_control$mixing && is.function(apollo_inputs$apollo_randCoeff)){
      if(debug) apollo_print("- Inserting scaling in apollo_randCoeff")
      apollo_inputs$apollo_randCoeff <- apollo_insertScaling(apollo_inputs$apollo_randCoeff, 
                                                             apollo_inputs$apollo_scaling)
    }
    if(is.function(apollo_inputs$apollo_lcPars)){
      if(debug) apollo_print("- Inserting scaling in apollo_lcPars")
      apollo_inputs$apollo_lcPars <- apollo_insertScaling(apollo_inputs$apollo_lcPars, apollo_inputs$apollo_scaling)
    }
  }
  
  ### Evaluate apollo_probabilities after current changes, return immediately if it doesn't work
  if(validate){
    apollo_beta_shifted[names(apollo_inputs$apollo_scaling)] <- apollo_beta_shifted[names(apollo_inputs$apollo_scaling)]/apollo_inputs$apollo_scaling
    test2 <- tryCatch(apollo_probabilities(apollo_beta_shifted, apollo_inputs), error=function(e) NULL)
    test <- !is.null(test1) && !is.null(test2) && is.numeric(test1) && is.numeric(test2)
    test <- test && !any(is.nan(test1)) && !any(is.nan(test2)) && abs(sum(test2)/sum(test1) - 1) < 0.001
    if(!test){
      # If they are different or evaluation of test2 failed, then undo changes
      apollo_print(paste0("The pre-processing of 'apollo_probabilities' failed after inserting parameter scaling.", 
                          " Your model may still run, but this indicates a potential problem. Please contact the", 
                          " developers for assistance!"),  pause=0, type="w")
      return(list(apollo_probabilities = apollo_probabilities_ORIG, 
                  apollo_randCoeff     = apollo_randCoeff_ORIG, 
                  apollo_lcPars        = apollo_lcPars_ORIG,
                  #apollo_scaling       = setNames(rep(1, length(apollo_inputs$apollo_scaling)),
                  #                                names(apollo_inputs$apollo_scaling)), 
                  apollo_scaling       = apollo_inputs$apollo_scaling,
                  success              = FALSE))
    }
  }
  ### Update ORIG version to keep changes so far
  apollo_probabilities_ORIG <- apollo_probabilities
  apollo_randCoeff_ORIG     <- apollo_inputs$apollo_randCoeff
  apollo_lcPars_ORIG        <- apollo_inputs$apollo_lcPars
  
  ### Introduce quotes into apollo_rrm
  if(debug) apollo_print("- Inserting quotes in settings for apollo_rrm (if present)")
  apollo_probabilities <- apollo_insertRRMQuotes(apollo_probabilities)
  
  ### Evaluate apollo_probabilities after current changes, return immediately if it doesn't work
  if(validate){
    test2 <- tryCatch(apollo_probabilities(apollo_beta_shifted, apollo_inputs), error=function(e) NULL)
    test <- !is.null(test1) && !is.null(test2) && is.numeric(test1) && is.numeric(test2)
    test <- test && !any(is.nan(test1)) && !any(is.nan(test2)) && abs(sum(test2)/sum(test1) - 1) < 0.001
    if(!test){
      # If they are different or evaluation of test2 failed, then undo changes
      apollo_print(paste0("The pre-processing of 'apollo_probabilities' failed after additional syntax processing.", 
                          " Your model may still run, but this indicates a potential problem. Please contact the", 
                          " developers for assistance!"),  pause=0, type="w")
      return(list(apollo_probabilities = apollo_probabilities_ORIG, 
                  apollo_randCoeff     = apollo_randCoeff_ORIG, 
                  apollo_lcPars        = apollo_lcPars_ORIG,
                  #apollo_scaling       = setNames(rep(1, length(apollo_inputs$apollo_scaling)),
                  #                                names(apollo_inputs$apollo_scaling)), 
                  apollo_scaling       = apollo_inputs$apollo_scaling,
                  success              = FALSE))
    }
  }
  ### Update ORIG version to keep changes so far
  apollo_probabilities_ORIG <- apollo_probabilities
  apollo_randCoeff_ORIG     <- apollo_inputs$apollo_randCoeff
  apollo_lcPars_ORIG        <- apollo_inputs$apollo_lcPars
  
  ### Introduce 'function()' at the beginning of definitions (only if using analytic gradients)
  if(debug) apollo_print('- Inserting function() in user-defined functions')
  if(apollo_inputs$apollo_control$analyticGrad){
    tmp <- apollo_insertFunc(apollo_probabilities, like=TRUE)
    if(is.function(tmp)) apollo_probabilities <- tmp
    if(is.function(apollo_inputs$apollo_randCoeff)){
      tmp <- apollo_insertFunc(apollo_inputs$apollo_randCoeff, randCoeff=TRUE)
      if(is.function(tmp))apollo_inputs$apollo_randCoeff <- tmp
    } 
    if(is.function(apollo_inputs$apollo_lcPars)){
      tmp <- apollo_insertFunc(apollo_inputs$apollo_lcPars, lcPars=TRUE)
      if(is.function(tmp)) apollo_inputs$apollo_lcPars <- tmp
    }
  }
  
  ### Evaluate apollo_probabilities after changes and compare to result before them
  if(validate){
    test2 <- tryCatch(apollo_probabilities(apollo_beta_shifted, apollo_inputs), error=function(e) NULL)
    test <- !is.null(test1) && !is.null(test2) && is.numeric(test1) && is.numeric(test2)
    test <- test && !any(is.nan(test1)) && !any(is.nan(test2)) && abs(sum(test2)/sum(test1) - 1) < 0.001
    if(!test){
      # If they are different or evaluation of test2 failed, then undo changes
      apollo_print(paste0("The pre-processing of 'apollo_probabilities' failed after inserting functions.", 
                          " Your model may still run, but this indicates a potential problem. Please contact the", 
                          " developers for assistance!"),  pause=0, type="w")
      return(list(apollo_probabilities = apollo_probabilities_ORIG, 
                  apollo_randCoeff     = apollo_randCoeff_ORIG, 
                  apollo_lcPars        = apollo_lcPars_ORIG,
                  #apollo_scaling       = setNames(rep(1, length(apollo_inputs$apollo_scaling)),
                  #                                names(apollo_inputs$apollo_scaling)), 
                  apollo_scaling       = apollo_inputs$apollo_scaling,
                  success              = FALSE))
    }
  }
  
  # If functions were modified and in debug mode, then write them to file
  if(debug){
    test <- !is.null(apollo_inputs) && is.list(apollo_inputs) && !is.null(apollo_inputs$apollo_control)
    test <- test && is.list(apollo_inputs$apollo_control) && !is.null(apollo_inputs$apollo_control$outputDirectory)
    test <- test && is.character(apollo_inputs$apollo_control$outputDirectory)
    test <- test && length(apollo_inputs$apollo_control$outputDirectory)==1
    if(test) outputDirectory <- apollo_inputs$apollo_control$outputDirectory else outputDirectory=getwd()
    if(substr(outputDirectory, nchar(outputDirectory), nchar(outputDirectory))!="/") outputDirectory <- paste0(outputDirectory, "/")
    txt <- utils::capture.output(print(apollo_probabilities))
    fileConn <- file(paste0(outputDirectory, apollo_inputs$apollo_control$modelName, "_apollo_probabilities_modified.txt"))
    writeLines(txt, fileConn)
    close(fileConn)
    if(is.function(apollo_inputs$apollo_randCoeff)){
      txt <- utils::capture.output(print(apollo_inputs$apollo_randCoeff))
      fileConn <- file(paste0(outputDirectory, apollo_inputs$apollo_control$modelName, "_apollo_randCoeff_modified.txt"))
      writeLines(txt, fileConn)
      close(fileConn)
    }
    if(is.function(apollo_inputs$apollo_lcPars)){
      txt <- utils::capture.output(print(apollo_inputs$apollo_lcPars))
      fileConn <- file(paste0(outputDirectory, apollo_inputs$apollo_control$modelName, "_apollo_lcPars_modified.txt"))
      writeLines(txt, fileConn)
      close(fileConn)
    }
    rm(test, txt)
  }
  
  ### Return
  return(list(apollo_probabilities = apollo_probabilities, 
              apollo_randCoeff     = apollo_inputs$apollo_randCoeff, 
              apollo_lcPars        = apollo_inputs$apollo_lcPars, 
              apollo_scaling       = apollo_inputs$apollo_scaling,
              manualScaling        = apollo_inputs$manualScaling, 
              success              = TRUE))
}