Select Git revision
ClassUse.pkl
Code owners
Assign users and groups as approvers for specific file changes. Learn more.
rls_update.R 5.78 KiB
#library(devtools)
#document()
#load_all(as.package("../../onlineforecast"))
#?rls_update
#' Calculates the RLS update of the model coefficients with the provived data.
#'
#' See vignette ??ref(recursive updating, not yet finished) on how to use the function.
#'
#' @title Updates the model fits
#' @param model A model object
#' @param datatr a data.list with transformed data (from model$transform_data(D))
#' @param y A vector of the model output for the corresponding time steps in \code{datatr}
#' @param runcpp Optional, default = TRUE. If TRUE, a c++ implementation of the update is run, otherwise a slower R implementation is used.
#' @return
#'
#' Returns a named list for each horizon (\code{model$kseq}) containing the variables needed for the RLS fit (for each horizon, which is saved in model$Lfits):
#'
#' It will update variables in the forecast model object.
#'
#' @seealso
#' See \code{\link{rls_predict}}.
#'
#' @examples
#'
#' # See rls_predict examples
#'
#' @export
rls_update <- function(model, datatr = NA, y = NA, runcpp=TRUE) {
# Take the inputs data and bind with the kept inputs data in the fit
#
# The data must be kept for later updating, done below
# The last part of the input data is needed for next update
# Find the number of parameters for the regression
np <- length(datatr)
# Keep only the last kmax rows for next time
kmax <- max(as.integer(gsub("k", "", nams(datatr[[1]]))))
# Check if data was kept
kept_input_data <- !is.na(model$datatr[1])
#
if (kept_input_data) {
# Find the start index for iterating later (the index to start updating from)
# How many points are kept plus one
istart <- nrow(model$datatr[[1]]) + 1
# Bind together new and kept data
for (i in 1:length(datatr)) {
# Bind them
datatr[[i]] <- rbind(model$datatr[[i]], datatr[[i]])
# Keep only the last kmax rows for next time
# Done below: model$datatr[[i]] <- datatr[[i]][(n+1):(kmax+n), ]
}
# Also for y to sync with X
y <- c(rep(NA,istart-1), y)
} else {
# Set later when nothing is kept (it must be set to k+1)
istart <- NA
}
# The number of points
n <- length(y)
# Parameters for rls
lambda <- model$regprm$lambda
if(runcpp){
L <- lapply(model$Lfits, function(fit) {