diff --git a/DESCRIPTION b/DESCRIPTION index fd07315aa79605484c0272a5e0cf9e328c1703ee..bb9dc670022f18a2782294d69fb89dca6f9ce543 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: onlineforecast Type: Package Title: Forecast Modelling for Online Applications -Version: 0.9.0 -Description: A framework for fitting adaptive forecasting models. Provides a way to use forecasts as input to models, e.g. weather forecasts for energy related forecasting. The models can be fitted recursively and can easily be setup for updating parameters when new data arrives. See the included vignettes, the website <https://onlineforecasting.org> and Bacher et. al. (2013, <10.1016/j.enbuild.2013.04.022>). +Version: 0.9.1 +Description: A framework for fitting adaptive forecasting models. Provides a way to use forecasts as input to models, e.g. weather forecasts for energy related forecasting. The models can be fitted recursively and can easily be setup for updating parameters when new data arrives. See the included vignettes, the website <https://onlineforecasting.org> and Bacher et. al. (2013, <doi:10.1016/j.enbuild.2013.04.022>). License: GPL-3 Encoding: UTF-8 LazyData: true diff --git a/R/data.list.R b/R/data.list.R index 46030c9bf158bd57ce0ddbe6243e9e76e993bb46..d09d42e1e9797d2c8ceb67a98df0da353383d3e4 100644 --- a/R/data.list.R +++ b/R/data.list.R @@ -67,7 +67,7 @@ data.list <- function(...) { #' subset(D, c("2010-12-15 02:00","2010-12-15 04:00")) #' #' # Cannot request a variable not there -#' \donttest{#subset(D, nms=c("x","Ta"))} +#' \donttest{try(subset(D, nms=c("x","Ta")))} #' #' # Take specific horizons #' subset(D, nms=c("I","Ta"), kseq = 1:2) @@ -325,7 +325,7 @@ check.data.list <- function(object){ if(!"t" %in% names(D)){ stop("'t' is missing in the data.list: It must be a vector of equidistant time points (can be an integer, but preferably POSIXct class with tz 'GMT' or 'UTC'.)") } if(length(unique(diff(D$t))) != 1){ stop("'t' is not equidistant and have no NA values")} - cat("\nTime t is fine: Length ",length(D$t),"\n\n") + message("\nTime t is fine: Length ",length(D$t),"\n") # Which is data.frame or matrix? dfOrMat <- sapply(D, function(x){ (class(x) %in% c("matrix","data.frame"))[1] }) @@ -388,9 +388,9 @@ check.data.list <- function(object){ } } # - cat("Observation vectors:\n") + message("Observation vectors:") print(Observations) - cat("\nForecast data.frames or matrices:\n") + message("\nForecast data.frames or matrices:") print(Forecasts) invisible(list(Observations=Observations, Forecasts=Forecasts)) diff --git a/R/forecastmodel.R b/R/forecastmodel.R index b2e85f885ca8807a87a6d1756787d6451ca17ec6..c1bfdca4e61a9a29c38544fc81cb5eed21d44d2e 100644 --- a/R/forecastmodel.R +++ b/R/forecastmodel.R @@ -303,7 +303,7 @@ forecastmodel <- R6::R6Class("forecastmodel", public = list( # Insert the prm value and return expr <- pst(substr(expr,1,pos-1), "=", value, substr(expr,pos+pos2-1,nchar(expr))) # Print? Not used now - #if(printout){ cat(names(value),"=",value,", ",sep="")} + #if(printout){ message(names(value),"=",value,", ",sep="")} } return(expr) }, @@ -343,7 +343,7 @@ forecastmodel <- R6::R6Class("forecastmodel", public = list( print.forecastmodel <- function(x, ...){ model <- x # cat("\nObject of class forecastmodel (R6::class)\n\n") - cat("\nOutput:",model$output,"\n") + cat("\nOutput:",model$output) cat("Inputs: ") if(length(model$inputs) == 0 ){ cat("No inputs\n") diff --git a/R/forecastmodel.R-documentation.R b/R/forecastmodel.R-documentation.R index 82d0f29073d0033a30ff1d771cd7693329928510..e52adb77e8757c0e7ee3abd0a3c50962e1e9727c 100644 --- a/R/forecastmodel.R-documentation.R +++ b/R/forecastmodel.R-documentation.R @@ -168,13 +168,15 @@ #' @examples #' #' # Check if the model is setup and can be used with a given data.list -#' \donttest{#model$check(Dbuilding)} +#' # An error is thrown +#' \donttest{try(model$check(Dbuilding))} #' # Add the model output #' model$output <- "heatload" -#' \donttest{#model$check(Dbuilding)} +#' # Still not error free +#' \donttest{try(model$check(Dbuilding))} #' # Add the horizons to fit for #' model$kseq <- 1:4 -#' # No errors, it's fine :) +#' # Finally, no errors :) #' model$check(Dbuilding) NULL # Don't delete the NULL above diff --git a/R/getse.R b/R/getse.R index 8ea6a600bf44306f0f96f9490524a464214896d3..9cfdaa32e9875fa7dc476318820556fa51bd78cd 100644 --- a/R/getse.R +++ b/R/getse.R @@ -50,11 +50,12 @@ #' # Get after #' getse(x, 2) #' -#' # Will give an error when indexed (with integer) if the element is not there -#' \donttest{x <- strsplit(c("x.k1","y.k2","x2"), "\\.") -#' #getse(x, 1) -#' #getse(x, 2) -#' } +#' # Get an element with an integer index +#' x <- strsplit(c("x.k1","y.k2","x2"), "\\.") +#' getse(x, 1) +#' # if the element is not there, then an error is thrown +#' try(getse(x, 2)) +#' #' # Use regex pattern for returning elements matching in the specified layer #' getse(L, "^te", depth=2, useregex=TRUE) #' diff --git a/R/lagdf.R b/R/lagdf.R index 4896fdb9d78c8301c5cca28432e1a62c5620888f..925533d9702b1b163827af5ece4649a755ef7305 100644 --- a/R/lagdf.R +++ b/R/lagdf.R @@ -99,8 +99,8 @@ lagdf.logical <- function(x, lagseq) { #' names(X) <- gsub("k", "h", names(X)) #' lagdf(X, "-h") #' -#' # If not same length as columns in X, then it doesn't know how to lag -#' \donttest{#lagdf(X, 1:2)} +#' # If not same length as columns in X, then it doesn't know how to lag, so an error is thrown +#' \donttest{try(lagdf(X, 1:2))} #' #' \dontshow{ #' if(!class(lagdf(data.frame(k1=1:10), 2)) == "data.frame"){stop("Trying to lag data.frame with 1 column, but return is not class data.frame")} diff --git a/R/lm_fit.R b/R/lm_fit.R index 33adff35295c9963455630a27739ab7329ba0879..d23d40f2af4372cbd3edc0cf0099b4a6e18397fa 100644 --- a/R/lm_fit.R +++ b/R/lm_fit.R @@ -80,11 +80,11 @@ lm_fit <- function(prm=NA, model, data, scorefun = NA, returnanalysis = TRUE, pr if(printout){ # Should here actually only print the one that were found and changed? - cat("----------------\n") + message("----------------") if(is.na(prm[1])){ - cat("prm=NA, so current parameters are used.\n") + message("prm=NA, so current parameters are used.") }else{ - print(prm) + print_to_message(prm) } } # First insert the prm into the model input expressions @@ -149,7 +149,7 @@ lm_fit <- function(prm=NA, model, data, scorefun = NA, returnanalysis = TRUE, pr # Only the summed score returned val <- sum(scoreval, na.rm = TRUE) if(is.na(val)){ stop("Cannot calculate the scorefunction for any horizon") } - if(printout){ print(c(scoreval,sum=val))} + if(printout){ print_to_message(c(scoreval,sum=val))} return(val) } diff --git a/R/lm_optim.R b/R/lm_optim.R index ad6a796ff1c626d84030bd56471d40f8402ae353..e5dc48d53f7b710b21bf9c2d2f2036594d3e0967 100644 --- a/R/lm_optim.R +++ b/R/lm_optim.R @@ -13,7 +13,7 @@ #' @param model The onlineforecast model, including inputs, output, kseq, p #' @param data The data.list including the variables used in the model. #' @param scorefun The function to be score used for calculating the score to be optimized. -#' @param cachedir A character specifying the path (and prefix) of the cache file name. If set to \code{""}, then no cache will be loaded or written. +#' @param cachedir A character specifying the path (and prefix) of the cache file name. If set to \code{""}, then no cache will be loaded or written. See \url{https://onlineforecasting.org/vignettes/nice-tricks.html} for examples. #' @param printout A logical determining if the score function is printed out in each iteration of the optimization. #' @param method The method argument for \code{\link{optim}}. #' @param ... Additional parameters to \code{\link{optim}} @@ -52,17 +52,6 @@ #' val <- lm_optim(model, D) #' val #' -#' # Caching can be done by providing a path (try rerunning and see the file in "cache" folder) -#' val <- lm_optim(model, D, cachedir="cache") -#' val -#' -#' # If anything affecting the results are changed, then the cache is not loaded -#' model$add_prmbounds(Ta__a1 = c(0.7, 0.98, 0.999)) -#' val <- lm_optim(model, D, cachedir="cache") -#' -#' # To delete the cache -#' file.remove(dir("cache", full.names=TRUE)) -#' file.remove("cache") #' #' @importFrom stats optim #' @export diff --git a/R/plot_ts.R b/R/plot_ts.R index 332c0f9a1385385d7abc9e66500e6015f564f0fd..c2cb95392d298883882ac1f6440ae35477bfabbb 100644 --- a/R/plot_ts.R +++ b/R/plot_ts.R @@ -62,13 +62,13 @@ #' #' # Use plotly #' \donttest{library(plotly) -#' #L <- plot_ts(D, c("heatload","Ta"), kseq=c(1,24), usely=TRUE, xlab="Time", -#' # ylabs=c("Heat (kW)","Temperature (C)")) +#' L <- plot_ts(D, c("heatload","Ta"), kseq=c(1,24), usely=TRUE, xlab="Time", +#' ylabs=c("Heat (kW)","Temperature (C)")) #' #' # From plotly the figures are returned and can be further manipulated #' # e.g. put the legend in the top by -#' #L[[length(L)]] <- L[[length(L)]] %>% layout(legend = list(x = 100, y = 0.98)) -#' #print(subplot(L, shareX=TRUE, nrows=length(L), titleY = TRUE)) +#' L[[length(L)]] <- L[[length(L)]] %>% layout(legend = list(x = 100, y = 0.98)) +#' print(subplot(L, shareX=TRUE, nrows=length(L), titleY = TRUE)) #' } #' #' @rdname plot_ts diff --git a/R/plotly_ts.R b/R/plotly_ts.R index e133781d9bebfb90dfcb09caeae7773003e17e6c..97c04458cca0c4ac5eee70b4ecafb813b12f4558 100644 --- a/R/plotly_ts.R +++ b/R/plotly_ts.R @@ -17,10 +17,10 @@ #' @examples #' #' \donttest{ -#' #D <- Dbuilding -#' #plotly_ts(D, c("heatload","Ta"), kseq=c(1,24)) -#' #plotly_ts(D, c("heatload","Ta"), kseq=c(1,24)) -#' #plotly_ts(D, c("heatload","Ta$|Ta.obs$"), kseq=c(1,24)) +#' D <- Dbuilding +#' plotly_ts(D, c("heatload","Ta"), kseq=c(1,24)) +#' plotly_ts(D, c("heatload","Ta"), kseq=c(1,24)) +#' plotly_ts(D, c("heatload","Ta$|Ta.obs$"), kseq=c(1,24)) #' } #' #' @export diff --git a/R/print_to_message.R b/R/print_to_message.R new file mode 100644 index 0000000000000000000000000000000000000000..54ac423820ab7f0643e9af9523ab9702a3fe3a1a --- /dev/null +++ b/R/print_to_message.R @@ -0,0 +1,6 @@ +#' @title Simple function for capturing from the print function and send it in a message(). +#' @param ... Passed to print which passed to message. + +print_to_message <- function(...) { + message(paste(utils::capture.output(print(...)), collapse="\n")) +} diff --git a/R/rls_fit.R b/R/rls_fit.R index ed9d62d039ff2d121d9b56865ecaf7a01204e683..f872fe2a44eba7405866e4cc819830b73582ab62 100644 --- a/R/rls_fit.R +++ b/R/rls_fit.R @@ -128,11 +128,11 @@ rls_fit <- function(prm=NA, model, data, scorefun = NA, returnanalysis = TRUE, if(printout){ # Should here actually only print the ones that were found and changed? - cat("----------------\n") + message("----------------") if(is.na(prm[1])){ - cat("prm=NA, so current parameters are used.\n") + message("prm=NA, so current parameters are used.") }else{ - print(prm) + print_to_message(prm) } } @@ -207,7 +207,9 @@ rls_fit <- function(prm=NA, model, data, scorefun = NA, returnanalysis = TRUE, # Only the summed score returned val <- sum(scoreval, na.rm = TRUE) if(is.na(val)){ stop("Cannot calculate the scorefunction for any horizon") } - if(printout){ print(c(scoreval,sum=val))} + if(printout){ + print_to_message(c(scoreval,sum=val)) + } return(val) } } diff --git a/R/rls_optim.R b/R/rls_optim.R index f8ba8af6851a972594bdc154ad28d609698a3d9e..a5458d335be10ffe63ed858e5b87b527d0a3d55b 100644 --- a/R/rls_optim.R +++ b/R/rls_optim.R @@ -8,12 +8,18 @@ #' Optimize parameters (transformation stage) of RLS model #' #' This is a wrapper for \code{\link{optim}} to enable easy use of bounds and caching in the optimization. +#' +#' One smart trick, is to cache the optimization results. Caching can be done by providing a path to the +#' \code{cachedir} argument (relative to the current working directory). +#' E.g. \code{rls_optim(model, D, cachedir="cache")} will write a file in the folder 'cache', such that +#' next time the same call is carried out, then the file is read instead of running the optimization again. +#' See the example in url{https://onlineforecasting.org/vignettes/nice-tricks.html}. #' #' @title Optimize parameters for onlineforecast model fitted with RLS #' @param model The onlineforecast model, including inputs, output, kseq, p #' @param data The data.list including the variables used in the model. #' @param scorefun The function to be score used for calculating the score to be optimized. -#' @param cachedir A character specifying the path (and prefix) of the cache file name. If set to \code{""}, then no cache will be loaded or written. +#' @param cachedir A character specifying the path (and prefix) of the cache file name. If set to \code{""}, then no cache will be loaded or written. See \url{https://onlineforecasting.org/vignettes/nice-tricks.html} for examples. #' @param printout A logical determining if the score function is printed out in each iteration of the optimization. #' @param method The method argument for \code{\link{optim}}. #' @param ... Additional parameters to \code{\link{optim}} @@ -51,17 +57,6 @@ #' val <- rls_optim(model, D) #' val #' -#' # Caching can be done by providing a path (try rerunning and see the file in "cache" folder) -#' val <- rls_optim(model, D, cachedir="cache") -#' val -#' -#' # If anything affecting the results are changed, then the cache is not loaded -#' model$add_prmbounds(lambda = c(0.89, 0.98, 0.999)) -#' val <- rls_optim(model, D, cachedir="cache") -#' -#' # To delete the cache -#' file.remove(dir("cache", full.names=TRUE)) -#' file.remove("cache") #' #' @export rls_optim <- function(model, data, scorefun = rmse, cachedir="", printout=TRUE, method="L-BFGS-B", ...){ diff --git a/R/rls_reduce.R b/R/rls_reduce.R index ea753d5d7dba227d5044e93ec30f0909bb5ea7f0..ff981382a20d775d90a0fe0eb87e0e8197f9d944 100644 --- a/R/rls_reduce.R +++ b/R/rls_reduce.R @@ -15,10 +15,11 @@ rls_reduce <- function(model, data, preduce=list(NA), scorefun = rmse){ ## while(TRUE){ ## - cat("------------------------------------\nReference score value",valref,"\n") + message("------------------------------------") + message("Reference score value",valref) ## -------- ## Remove inputs one by one - cat("\nRemoving inputs one by one\n") + message("\nRemoving inputs one by one") valsrm <- mclapply(1:length(model$inputs), function(i){ mr <- m$clone_deep() mr$inputs[[i]] <- NULL @@ -26,12 +27,12 @@ rls_reduce <- function(model, data, preduce=list(NA), scorefun = rmse){ }) valsrm <- unlist(valsrm) names(valsrm) <- names(m$inputs) - cat("Scores\n") + message("Scores") print(valsrm) ## -------- ## Reduce parameter values if specified if(!is.na(pr[1])){ - cat("\nReducing prm with -1 one by one\n") + message("\nReducing prm with -1 one by one") valspr <- mclapply(1:length(pr), function(i){ mr <- m$clone_deep() p <- pr @@ -46,7 +47,7 @@ rls_reduce <- function(model, data, preduce=list(NA), scorefun = rmse){ }) valspr <- unlist(valspr) names(valspr) <- names(pr) - cat("Scores\n") + message("Scores") print(valspr) } ## Is one the reduced smaller than the current ref? @@ -54,19 +55,19 @@ rls_reduce <- function(model, data, preduce=list(NA), scorefun = rmse){ if(which.min(c(min(valsrm),min(valspr))) == 1){ ## One of the models with one of the inputs removed is best imin <- which.min(valsrm) - cat("Removing input",names(m$inputs)[imin],"\n") + message("Removing input",names(m$inputs)[imin]) m$inputs[[imin]] <- NULL }else{ ## One of the models with reduced parameter values is best imin <- which.min(valspr) pr[imin] <- pr[imin] - 1 m$insert_prm(pr) - cat("Reduced parameter",names(pr)[imin],"to:",pr[imin],"\n") + message("Reduced parameter",names(pr)[imin],"to:",pr[imin]) } valref <- min(c(valsrm,valspr)) }else{ ## No improvement obtained from reduction, so return the current model - cat("------------------------------------\n\nDone\n") + message("------------------------------------\n\nDone") return(m) } } diff --git a/cran-comments.md b/cran-comments.md index 7b94982e6007a205211b60c0b246d753fd76be53..48fc1a67da1a24bbc1aa25fb374a0c9a1ac3310b 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,10 +1,99 @@ +#---------------------------------------------------------------- +# v0.9.1 +Response to review of v0.9.0 by Swetlana Herbrandt: + +#-------- +REQUEST: +"Thanks, please write the DOI in your Description field as +<doi:10.1016/j.enbuild.2013.04.022>" + +RESPONSE: +Fixed. +#-------- + +#-------- +REQUEST: +"Please do not comment out your examples and use \donttest{} instead: + +\examples{ + examples for users and checks: + executable in < 5 sec + + donttest{ + further examples for users (not used for checks) + } +} +If you really want to show examplew resulting in error, please use +try(), i.e. + +try(getse(x, 1))" + +RESPONSE: +We have put the few error generating examples in \donttest{try(...)} +#-------- + +#-------- +REQUEST: +"Please replace cat() by message() or warning() in your functions (except +for print() and summary() functions). Messages and warnings can be +suppressed if needed. + +RESPONSE: +Fixed. +#-------- + +#-------- +REQUEST: +You are changing the user's par() settings in your functions. Please +ensure with an immediate call of on.exit() that the settings are reset. E.g. + opar <- par(no.readonly =TRUE) # code line i + on.exit(par(opar)) # code line i+1 + +Same issue for options()." + +RESPONSE: +We do see the point about setting back par() and options(). Actually it's only one function which sets par (options are not set in any functions): +setpar() is just a wrapper for changing the par values to certain values, it's +only used in plot_ts(), where the par is reset on exit. So in setpar() it can't +really reset the par, since then it would make sense to have it. setpar() +returns the current parameters, so they can be reset after plotting. So we want +to keep it. +#-------- + +#-------- +REQUEST: +Please ensure that your functions do not modify (save or delete) the +user's home filespace in your examples/vignettes/tests. That is not +allow by CRAN policies. Please only write/save files if the user has +specified a directory. In your examples/vignettes/tests you can write to +tempdir(). I.e. + +val <- lm_optim(model, D, cachedir=tempdir()) + +RESPONSE: +Fixed, we moved the examples into a vignette not included in the package, only +available on the accompanying website. +#-------- + +#-------- +REQUEST: +Please fix and resubmit. + +RESPONSE: +Done :) +#-------- +#---------------------------------------------------------------- + + +#---------------------------------------------------------------- +# v0.9.0 We have tested on Linux 3.6.3 and 4.0.2, and on Windows 4.0.2, results are below. Since the warnings are not the same, we think that they are related to the particular installations, thus think it pass the CRAN server checks. Let's see :) -#---------------------------------------------------------------- +#---- Fedora install, R 3.6.3: ## R CMD check results @@ -39,10 +128,10 @@ include <Rcpp.h> and don't do anything but matrix calculations and returning the results. So we it must be some setting in the compiler creating this warning. Hopefully it's not there when compiled on cran. -#---------------------------------------------------------------- +#---- -#---------------------------------------------------------------- +#---- Linux in container "rocker/rstudio" (in podman, had some permission issues, and latex compilation problems), R 4.0.2: @@ -58,10 +147,10 @@ Two NOTEs: Compilation used the following non-portable flag(s): ‘-Wdate-time’ ‘-Werror=format-security’ ‘-Wformat’ -#---------------------------------------------------------------- +#---- -#---------------------------------------------------------------- +#---- Windows install, R 4.0.2: One Warning and two NOTEs: @@ -81,4 +170,5 @@ One Warning and two NOTEs: 'cache' 0 errors √ | 1 warning x | 2 notes x +#---- #---------------------------------------------------------------- diff --git a/make.R b/make.R index f5deceb15c6193dd6de919483ba85015df08c1bc..c53cacfda18b432306ae2f6490d55ca91a9c4eb1 100644 --- a/make.R +++ b/make.R @@ -64,7 +64,7 @@ document() build(".", vignettes=TRUE) # Install it -install.packages("../onlineforecast_0.9.0.tar.gz") +install.packages("../onlineforecast_0.9.1.tar.gz") library(onlineforecast) @@ -73,10 +73,10 @@ library(onlineforecast) # Test before release devtools::check() -devtools::check_built("../onlineforecast_0.9.0.tar.gz") +devtools::check_built("../onlineforecast_0.9.1.tar.gz") # Does give different results than check() above -system("R CMD check ../onlineforecast_0.9.0.tar.gz") +system("R CMD check ../onlineforecast_0.9.1.tar.gz") unlink("onlineforecast.Rcheck/", recursive=TRUE) # Use for more checking: diff --git a/vignettes/make.R b/vignettes/make.R index 90660229565de7e4796cdc6278db235cc2805c09..6180d210cc85bab537087e0f5c13d44883e0d7c2 100644 --- a/vignettes/make.R +++ b/vignettes/make.R @@ -7,7 +7,7 @@ library(rmarkdown) dirnam <- "../tmp/vignettes/" dir.create("../tmp") dir.create(dirnam) -unlink("cache", recursive=TRUE) + makeit <- function(nam, openit=FALSE, clean=TRUE){ namrmd <- paste0(nam,".Rmd") diff --git a/vignettes/setup-and-use-model.Rmd b/vignettes/setup-and-use-model.Rmd index 3e44a1c6efea5f067ba54ed74a18af699ca7cac1..bae49a76878adc620ded08c14954274380e31f69 100644 --- a/vignettes/setup-and-use-model.Rmd +++ b/vignettes/setup-and-use-model.Rmd @@ -450,23 +450,9 @@ model$add_inputs(Tao = "lp(Tao, a1=0.99)") Working with time consuming calculations caching can be very valuable. The optimization results can be cached by providing a path to a -directory: -```{r, output.lines=15} -rls_optim(model, D, cachedir="cache")$par -``` -where cache files are saved: -```{r} -dir("cache") -``` -so running it again will read the cache instead of calculating the optimization: -```{r} -rls_optim(model, D, cachedir="cache")$par -``` - -Remove the cache directory by: -```{r} -unlink("cache", recursive=TRUE) -``` +directory, by setting the argument 'cachedir' to e.g. "cache". See the vignette +[nice-tricks](https://onlineforecast.org/vignettes/nice-tricks.html) for an +example with code. ## Deep clone model