diff --git a/R/step_optim.R b/R/step_optim.R index 971e2654f9cbbf5ddd3a9dfd1010708b3e4bf265..44b628c98238c4a10a31332f470d58d9673f21ee 100644 --- a/R/step_optim.R +++ b/R/step_optim.R @@ -82,7 +82,7 @@ #' @param scorefun The score function used. #' @param printout Logical. Passed on to fitting functions. #' @param mc.cores The mc.cores argument of mclapply. If debugging it can be -#' nessecary to set it to 1 to stop execution. +#' necessary to set it to 1 to stop execution. #' @param ... Additional arguments which will be passed on to optimfun. For #' example control how many steps #' @@ -129,9 +129,12 @@ #' # Iterations in the prm optimization (MUST be increased in real applications) #' control <- list(maxit=1) #' +#' # On Windows multi cores are not supported, so for the examples use only one +#' mc.cores <- 1 +#' #' # Run the default selection scheme, which is "both" #' # (same as "backwardboth" if no start model is given) -#' L <- step_optim(model, D, prm, control=control) +#' L <- step_optim(model, D, prm, control=control, mc.cores=mc.cores) #' #' # The optim value from each step is returned #' getse(L, "optimresult") @@ -141,26 +144,26 @@ #' L$final$model #' #' # Other selection schemes -#' Lforward <- step_optim(model, D, prm, "forward", control=control) -#' Lbackward <- step_optim(model, D, prm, "backward", control=control) -#' Lbackwardboth <- step_optim(model, D, prm, "backwardboth", control=control) -#' Lforwardboth <- step_optim(model, D, prm, "forwardboth", control=control, mc.cores=1) +#' Lforward <- step_optim(model, D, prm, "forward", control=control, mc.cores=mc.cores) +#' Lbackward <- step_optim(model, D, prm, "backward", control=control, mc.cores=mc.cores) +#' Lbackwardboth <- step_optim(model, D, prm, "backwardboth", control=control, mc.cores=mc.cores) +#' Lforwardboth <- step_optim(model, D, prm, "forwardboth", control=control, mc.cores=mc.cores) #' #' # It's possible avoid removing specified inputs -#' L <- step_optim(model, D, prm, keepinputs=c("mu","mu_tday"), control=control) +#' L <- step_optim(model, D, prm, keepinputs=c("mu","mu_tday"), control=control, mc.cores=mc.cores) #' #' # Give a starting model #' modelstart <- model$clone_deep() #' modelstart$inputs[2:3] <- NULL -#' L <- step_optim(model, D, prm, modelstart=modelstart, control=control) +#' L <- step_optim(model, D, prm, modelstart=modelstart, control=control, mc.cores=mc.cores) #' #' # If a fitting function is given, then it will be used for calculating the forecasts #' # ONLY on the complete cases in each step -#' L1 <- step_optim(model, D, prm, fitfun=rls_fit, control=control) +#' L1 <- step_optim(model, D, prm, fitfun=rls_fit, control=control, mc.cores=mc.cores) #' #' # The easiest way to conclude if missing values have an influence is to #' # compare the selection result running with and without -#' L2 <- step_optim(model, D, prm, control=control) +#' L2 <- step_optim(model, D, prm, control=control, mc.cores=mc.cores) #' #' # Compare the selected models #' tmp1 <- capture.output(getse(L1, "model")) @@ -171,7 +174,7 @@ #' # Note that caching can be really smart (the cache files are located in the #' # cachedir folder (folder in current working directory, can be removed with #' # unlink(foldername)) See e.g. `?rls_optim` for how the caching works -#' # L <- step_optim(model, D, prm, "forward", cachedir="cache", cachererun=FALSE) +#' # L <- step_optim(model, D, prm, "forward", cachedir="cache", cachererun=FALSE, mc.cores=mc.cores) #' #' @importFrom parallel mclapply #' @@ -232,10 +235,6 @@ step_optim <- function(modelfull, data, prm=list(NA), direction = c("both","back scoreCurrent <- Inf } } - # If kseqopt is set, then make sure that it is used in all runs (also when only running fitfun) - if(!is.na(m$kseqopt)){ - m$kseq <- m$kseqopt - } # Find the inputs to keep, if any if(class(keepinputs) == "logical"){ if(keepinputs){ @@ -264,6 +263,10 @@ step_optim <- function(modelfull, data, prm=list(NA), direction = c("both","back if(class(fitfun) == "function"){ # Forecast to get the complete cases mtmp <- m$clone_deep() + # If kseqopt is set, then make sure that it is used when fitting here + if(!is.na(m$kseqopt)){ + mtmp$kseq <- m$kseqopt + } Yhat <- fitfun(res$par, mtmp, data, printout=printout)$Yhat scoreCurrent <- sum(score(residuals(Yhat,data[[m$output]]),data$scoreperiod)) casesCurrent <- complete_cases(Yhat) @@ -376,6 +379,10 @@ step_optim <- function(modelfull, data, prm=list(NA), direction = c("both","back if(class(fitfun) == "function"){ LYhat <- mclapply(1:length(mStep), function(i){ mtmp <- mStep[[i]]$clone_deep() + # If kseqopt is set, then make sure that it is used when fitting here + if(!is.na(m$kseqopt)){ + mtmp$kseq <- m$kseqopt + } fitfun(Lstep[[i]]$par, mtmp, data, printout=printout)$Yhat }, mc.cores=mc.cores) # Use complete cases across models and horizons per default diff --git a/make.R b/make.R index 28a07b7e4bc77291ce683ab7317def2def49b5e1..857c1a06851ee2d62b75f70a8f90335ac3566998 100644 --- a/make.R +++ b/make.R @@ -50,8 +50,8 @@ library(roxygen2) #test() # # Run the examples -load_all(as.package("../onlineforecast")) -run_examples() +#load_all(as.package("../onlineforecast")) +#run_examples() # # Run tests in a single file # test_file("tests/testthat/test-rls-heat-load.R") diff --git a/man/step_optim.Rd b/man/step_optim.Rd index 58e258c0f2977ba7edfe0b6b115e1ca28e536fc6..e42a7434f3342dc2ea754ce630e502f96a681ecd 100644 --- a/man/step_optim.Rd +++ b/man/step_optim.Rd @@ -53,7 +53,7 @@ and returned.} \item{printout}{Logical. Passed on to fitting functions.} \item{mc.cores}{The mc.cores argument of mclapply. If debugging it can be -nessecary to set it to 1 to stop execution.} +necessary to set it to 1 to stop execution.} \item{...}{Additional arguments which will be passed on to optimfun. For example control how many steps} @@ -158,9 +158,12 @@ prm <- list(mu_tday__nharmonics = c(min=3, max=7)) # Iterations in the prm optimization (MUST be increased in real applications) control <- list(maxit=1) +# On Windows multi cores are not supported, so for the examples use only one +mc.cores <- 1 + # Run the default selection scheme, which is "both" # (same as "backwardboth" if no start model is given) -L <- step_optim(model, D, prm, control=control) +L <- step_optim(model, D, prm, control=control, mc.cores=mc.cores) # The optim value from each step is returned getse(L, "optimresult") @@ -170,26 +173,26 @@ getse(L,"score") L$final$model # Other selection schemes -Lforward <- step_optim(model, D, prm, "forward", control=control) -Lbackward <- step_optim(model, D, prm, "backward", control=control) -Lbackwardboth <- step_optim(model, D, prm, "backwardboth", control=control) -Lforwardboth <- step_optim(model, D, prm, "forwardboth", control=control, mc.cores=1) +Lforward <- step_optim(model, D, prm, "forward", control=control, mc.cores=mc.cores) +Lbackward <- step_optim(model, D, prm, "backward", control=control, mc.cores=mc.cores) +Lbackwardboth <- step_optim(model, D, prm, "backwardboth", control=control, mc.cores=mc.cores) +Lforwardboth <- step_optim(model, D, prm, "forwardboth", control=control, mc.cores=mc.cores) # It's possible avoid removing specified inputs -L <- step_optim(model, D, prm, keepinputs=c("mu","mu_tday"), control=control) +L <- step_optim(model, D, prm, keepinputs=c("mu","mu_tday"), control=control, mc.cores=mc.cores) # Give a starting model modelstart <- model$clone_deep() modelstart$inputs[2:3] <- NULL -L <- step_optim(model, D, prm, modelstart=modelstart, control=control) +L <- step_optim(model, D, prm, modelstart=modelstart, control=control, mc.cores=mc.cores) # If a fitting function is given, then it will be used for calculating the forecasts # ONLY on the complete cases in each step -L1 <- step_optim(model, D, prm, fitfun=rls_fit, control=control) +L1 <- step_optim(model, D, prm, fitfun=rls_fit, control=control, mc.cores=mc.cores) # The easiest way to conclude if missing values have an influence is to # compare the selection result running with and without -L2 <- step_optim(model, D, prm, control=control) +L2 <- step_optim(model, D, prm, control=control, mc.cores=mc.cores) # Compare the selected models tmp1 <- capture.output(getse(L1, "model")) @@ -200,6 +203,6 @@ identical(tmp1, tmp2) # Note that caching can be really smart (the cache files are located in the # cachedir folder (folder in current working directory, can be removed with # unlink(foldername)) See e.g. `?rls_optim` for how the caching works -# L <- step_optim(model, D, prm, "forward", cachedir="cache", cachererun=FALSE) +# L <- step_optim(model, D, prm, "forward", cachedir="cache", cachererun=FALSE, mc.cores=mc.cores) } diff --git a/vignettes/model-selection.Rmd b/vignettes/model-selection.Rmd index 2fc3e8e0ffef498b39e64fa1b9f11335575fc822..860d2fc8cefb822ccc4cbf4cd412e22acc03d034 100644 --- a/vignettes/model-selection.Rmd +++ b/vignettes/model-selection.Rmd @@ -179,12 +179,15 @@ stepping is: - In the first step all inputs are removed and from there inputs are only added. -The default procedure is backward selection with stepping in both directions: +The default procedure is backward selection with stepping in both +directions. To make compilation of the vignette feasible some arguments were +set, for real applications change the argument "control=list(maxit=1)" and +"mc.cores=1": ```{r, message=FALSE, results="hide"} # Run the default selection, which is "both" and equivalent to "backwadboth" # Note the control argument, which is passed to optim, it's now set to few # iterations in the prm optimization -Lboth <- step_optim(model, D, prm, direction="both", control=list(maxit=1)) +Lboth <- step_optim(model, D, prm, direction="both", control=list(maxit=1), mc.cores=1) ``` We now have the models selected in each step in and we see that the final model is decreased: @@ -194,14 +197,14 @@ getse(Lboth, "model") Forward selection: ```{r, message=FALSE, results="hide"} -Lforward <- step_optim(model, D, prm, "forward", control=list(maxit=1)) +Lforward <- step_optim(model, D, prm, "forward", control=list(maxit=1), mc.cores=1) ``` ```{r} getse(Lforward, "model") ``` Same model is selected, which is also the case in backwards selection: ```{r, message=FALSE, results="hide"} -Lbackward <- step_optim(model, D, prm, "backward", control=list(maxit=1)) +Lbackward <- step_optim(model, D, prm, "backward", control=list(maxit=1), mc.cores=1) ``` ```{r} getse(Lbackward, "model") @@ -215,7 +218,7 @@ modelstart <- model$clone_deep() # Remove two inputs modelstart$inputs[2:3] <- NULL # Run the selection -L <- step_optim(model, D, prm, modelstart=modelstart, control=list(maxit=1)) +L <- step_optim(model, D, prm, modelstart=modelstart, control=list(maxit=1), mc.cores=1) ``` ```{r} getse(L, "model")