Skip to content
Snippets Groups Projects
Select Git revision
  • 1f459106053306821d9a1cdaaf8f9485b43f63df
  • master default protected
  • feature/quantileforecast
  • develop
  • add_kseq
5 results

rls_update.R

Blame
  • 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) {