Skip to content
Snippets Groups Projects
Commit d51c07a0 authored by pbac's avatar pbac
Browse files

Misc fixes

parent 8fa98012
No related branches found
No related tags found
No related merge requests found
...@@ -83,13 +83,16 @@ cache_name <- function(..., cachedir = "cache"){ ...@@ -83,13 +83,16 @@ cache_name <- function(..., cachedir = "cache"){
# Get the name, definition and arguments of the function from which cache_name was called # Get the name, definition and arguments of the function from which cache_name was called
funname <- strsplit(deparse(sys.calls()[[sys.nframe()-1]]), "\\(")[[1]][1] funname <- strsplit(deparse(sys.calls()[[sys.nframe()-1]]), "\\(")[[1]][1]
# Find the function in the nearest environment in the stack (i.e. parent calls) # Find the function in the nearest environment in the stack (i.e. parent calls)
for(i in rev(sys.parents())){ ## for(i in rev(sys.parents())){
if(funname %in% ls(parent.frame(i+1))){ ## browser()
val <- mget(funname, parent.frame(i+1)) ## if(funname %in% ls(parent.frame(i+1))){
break ## val <- mget(funname, parent.frame(i+1))
} ## break
} ## }
fundef <- digest::digest(attr(eval(val[[funname]]), "srcref")) ## }
## fundef <- digest::digest(attr(eval(val[[funname]]), "srcref"))
# Somehow the above stopped working, don't know why! just take it, this should do the same I guess
fundef <- digest::digest(get(funname))
# if no arguments were given, then use the arguments function from which cache_name was called # if no arguments were given, then use the arguments function from which cache_name was called
if(length(list(...)) == 0){ if(length(list(...)) == 0){
funargs <- digest::digest(as.list( match.call(definition = sys.function( -1 ), call = sys.call(-1)))[-1]) funargs <- digest::digest(as.list( match.call(definition = sys.function( -1 ), call = sys.call(-1)))[-1])
......
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
#' @param kseq The horizons to fit for (if not set, then model$kseq is used) #' @param kseq The horizons to fit for (if not set, then model$kseq is used)
#' @param scorefun The function to be score used for calculating the score to be optimized. #' @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. See \url{https://onlineforecasting.org/vignettes/nice-tricks.html} for examples. #' @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 cacheload A logical controlling whether to load the cache if it exists. #' @param cachererun A logical controlling whether to run the optimization even if the cache exists.
#' @param printout A logical determining if the score function is printed out in each iteration of the optimization. #' @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 method The method argument for \code{\link{optim}}.
#' @param ... Additional parameters to \code{\link{optim}} #' @param ... Additional parameters to \code{\link{optim}}
...@@ -57,7 +57,7 @@ ...@@ -57,7 +57,7 @@
#' #'
#' @importFrom stats optim #' @importFrom stats optim
#' @export #' @export
lm_optim <- function(model, data, kseq = NA, scorefun = rmse, cachedir="", cacheload=FALSE, printout=TRUE, method="L-BFGS-B", ...){ lm_optim <- function(model, data, kseq = NA, scorefun = rmse, cachedir="", cachererun=FALSE, printout=TRUE, method="L-BFGS-B", ...){
## Take the parameters bounds from the parameter bounds set in the model ## Take the parameters bounds from the parameter bounds set in the model
init <- model$get_prmbounds("init") init <- model$get_prmbounds("init")
lower <- model$get_prmbounds("lower") lower <- model$get_prmbounds("lower")
...@@ -81,7 +81,7 @@ lm_optim <- function(model, data, kseq = NA, scorefun = rmse, cachedir="", cache ...@@ -81,7 +81,7 @@ lm_optim <- function(model, data, kseq = NA, scorefun = rmse, cachedir="", cache
cnm <- cache_name(lm_fit, lm_optim, m$outputrange, m$regprm, m$transform_data(data), cnm <- cache_name(lm_fit, lm_optim, m$outputrange, m$regprm, m$transform_data(data),
data[[m$output]], scorefun, init, lower, upper, cachedir = cachedir) data[[m$output]], scorefun, init, lower, upper, cachedir = cachedir)
# Load the cached result if it exists # Load the cached result if it exists
if(file.exists(cnm) & !cacheload){ if(file.exists(cnm) & !cachererun){
res <- readRDS(cnm) res <- readRDS(cnm)
# Set the optimized parameters into the model # Set the optimized parameters into the model
model$insert_prm(res$par) model$insert_prm(res$par)
......
...@@ -13,7 +13,7 @@ ...@@ -13,7 +13,7 @@
#' \code{cachedir} argument (relative to the current working directory). #' \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 #' 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. #' 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}. #' See the example in \url{https://onlineforecasting.org/vignettes/nice-tricks.html}.
#' #'
#' @title Optimize parameters for onlineforecast model fitted with RLS #' @title Optimize parameters for onlineforecast model fitted with RLS
#' @param model The onlineforecast model, including inputs, output, kseq, p #' @param model The onlineforecast model, including inputs, output, kseq, p
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
#' @param kseq The horizons to fit for (if not set, then model$kseq is used) #' @param kseq The horizons to fit for (if not set, then model$kseq is used)
#' @param scorefun The function to be score used for calculating the score to be optimized. #' @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. See \url{https://onlineforecasting.org/vignettes/nice-tricks.html} for examples. #' @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 cacheload A logical controlling whether to load the cache if it exists. #' @param cachererun A logical controlling whether to run the optimization even if the cache exists.
#' @param printout A logical determining if the score function is printed out in each iteration of the optimization. #' @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 method The method argument for \code{\link{optim}}.
#' @param ... Additional parameters to \code{\link{optim}} #' @param ... Additional parameters to \code{\link{optim}}
...@@ -61,7 +61,7 @@ ...@@ -61,7 +61,7 @@
#' #'
#' #'
#' @export #' @export
rls_optim <- function(model, data, kseq = NA, scorefun = rmse, cachedir="", cacheload=FALSE, printout=TRUE, method="L-BFGS-B", ...){ rls_optim <- function(model, data, kseq = NA, scorefun = rmse, cachedir="", cachererun=FALSE, printout=TRUE, method="L-BFGS-B", ...){
# Take the parameters bounds from the parameter bounds set in the model # Take the parameters bounds from the parameter bounds set in the model
init <- model$get_prmbounds("init") init <- model$get_prmbounds("init")
lower <- model$get_prmbounds("lower") lower <- model$get_prmbounds("lower")
...@@ -86,7 +86,7 @@ rls_optim <- function(model, data, kseq = NA, scorefun = rmse, cachedir="", cach ...@@ -86,7 +86,7 @@ rls_optim <- function(model, data, kseq = NA, scorefun = rmse, cachedir="", cach
# This is maybe smarter, don't have to calculate the transformation of the data: cnm <- cache_name(m$regprm, getse(m$inputs, nms="expr"), m$output, m$prmbounds, m$kseq, data, objfun, init, lower, upper, cachedir = cachedir) # This is maybe smarter, don't have to calculate the transformation of the data: cnm <- cache_name(m$regprm, getse(m$inputs, nms="expr"), m$output, m$prmbounds, m$kseq, data, objfun, init, lower, upper, cachedir = cachedir)
cnm <- cache_name(rls_fit, rls_optim, m$outputrange, m$regprm, m$transform_data(data), data[[m$output]], scorefun, init, lower, upper, kseq, cachedir = cachedir) cnm <- cache_name(rls_fit, rls_optim, m$outputrange, m$regprm, m$transform_data(data), data[[m$output]], scorefun, init, lower, upper, kseq, cachedir = cachedir)
# Load the cached result if it exists # Load the cached result if it exists
if(file.exists(cnm) & !cacheload){ if(file.exists(cnm) & !cachererun){
res <- readRDS(cnm) res <- readRDS(cnm)
# Set the optimized parameters into the model # Set the optimized parameters into the model
model$insert_prm(res$par) model$insert_prm(res$par)
......
...@@ -60,7 +60,7 @@ library(roxygen2) ...@@ -60,7 +60,7 @@ library(roxygen2)
# ---------------------------------------------------------------- # ----------------------------------------------------------------
# Build the package # Build the package
document() document()
build(".", vignettes=TRUE) build(".", vignettes=FALSE)
# Install it # Install it
install.packages("../onlineforecast_0.9.4.tar.gz") install.packages("../onlineforecast_0.9.4.tar.gz")
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment