From 5a9f9ad508ddd25cd36db9e3eb95f8083ae3f6bf Mon Sep 17 00:00:00 2001
From: Peder <pbac@dtu.dk>
Date: Wed, 19 Aug 2020 09:06:10 +0200
Subject: [PATCH] With fixes to review of v0.9.0, submitted v0.9.1
---
DESCRIPTION | 4 +-
R/data.list.R | 8 +--
R/forecastmodel.R | 4 +-
R/forecastmodel.R-documentation.R | 8 ++-
R/getse.R | 11 ++--
R/lagdf.R | 4 +-
R/lm_fit.R | 8 +--
R/lm_optim.R | 13 +---
R/plot_ts.R | 8 +--
R/plotly_ts.R | 8 +--
R/print_to_message.R | 6 ++
R/rls_fit.R | 10 +--
R/rls_optim.R | 19 +++---
R/rls_reduce.R | 17 ++---
cran-comments.md | 100 ++++++++++++++++++++++++++++--
make.R | 6 +-
vignettes/make.R | 2 +-
vignettes/setup-and-use-model.Rmd | 20 +-----
18 files changed, 164 insertions(+), 92 deletions(-)
create mode 100644 R/print_to_message.R
diff --git a/DESCRIPTION b/DESCRIPTION
index fd07315..bb9dc67 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 46030c9..d09d42e 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 b2e85f8..c1bfdca 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 82d0f29..e52adb7 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 8ea6a60..9cfdaa3 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 4896fdb..925533d 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 33adff3..d23d40f 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 ad6a796..e5dc48d 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 332c0f9..c2cb953 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 e133781..97c0445 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 0000000..54ac423
--- /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 ed9d62d..f872fe2 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 f8ba8af..a5458d3 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 ea753d5..ff98138 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 7b94982..48fc1a6 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 f5deceb..c53cacf 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 9066022..6180d21 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 3e44a1c..bae49a7 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
--
GitLab