Commit 5a9f9ad5 authored by pbac's avatar pbac
Browse files

With fixes to review of v0.9.0, submitted v0.9.1

parent f7cc1db6
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
......
......@@ -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))
......
......@@ -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")
......
......@@ -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
......@@ -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)
#'
......
......@@ -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")}
......
......@@ -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)
}
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
#' @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"))
}
......@@ -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)
}
}
......@@ -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", ...){
......
......@@ -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)
}
}
......
#----------------------------------------------------------------
# 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
#----
#----------------------------------------------------------------
......@@ -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:
......
......@@ -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")
......
......@@ -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
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment