small stuff

DESCRIPTION

 Package: onlineforecast
 Type: Package
 Title: Forecast Modelling for Online Applications
-Version: 0.9.3
+Version: 0.9.4
 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 the paper "Short-term heat load forecasting for single family houses" <doi:10.1016/j.enbuild.2013.04.022>.
 License: GPL-3
 Encoding: UTF-8

R/bspline.R

@@ -68,7 +68,7 @@
 #' @export
 bspline <- function(X, Boundary.knots = NA, intercept = FALSE, df = NULL, knots = NULL, degree = 3, bknots = NA, periodic = FALSE) {
     # bknots is just a short for Boundary.knots and replace if Boundary.knots are not given.
-    if(is.na(Boundary.knots)){
+    if(is.na(Boundary.knots[1])){
         Boundary.knots <- bknots
     }
     # If a list, then call on each element
@@ -81,9 +81,12 @@ bspline <- function(X, Boundary.knots = NA, intercept = FALSE, df = NULL, knots
         nams(val) <- nams(X)
         return(val)
     }
-    # X is a data.frame or matrix
+    # X must be a data.frame or matrix
+    if(!(class(X) %in% c("data.frame","matrix"))){ stop("X must be a data.frame or matrix") }
     # First find the horizons, they are used in the end
     nms <- nams(X)
+    # All columns must be like "k12"
+    #if(length(grep("^[k|h][[:digit:]]+$", nms)) != length(nms)){ stop("All column names must indicate a horizon, so start with k and then an integer") }
     # Run for each horizon and calculate the basis splines
     L <- lapply(1:ncol(X), function(i) {
       if (is.na(Boundary.knots[1])) {

R/data.list.R

@@ -330,68 +330,73 @@ check.data.list <- function(object){
     # Which is data.frame or matrix?
     dfOrMat <- sapply(D, function(x){ (class(x) %in% c("matrix","data.frame"))[1] })
     # Vectors check
-    vecchecks <- c("ok","NAs","length","class")
     vecseq <- which(!dfOrMat & names(dfOrMat) != "t")
-    Observations <- data.frame(matrix("", nrow=length(vecseq), ncol=length(vecchecks), dimnames=list(names(vecseq),vecchecks)), stringsAsFactors=FALSE)
-    Observations$ok <- "V"
-    #
-    for(i in 1:length(vecseq)){
+    Observations <- NA
+    if(length(vecseq) > 0){
+        cat("Observation vectors:\n")
+        vecchecks <- c("ok","NAs","length","class")
+        Observations <- data.frame(matrix("", nrow=length(vecseq), ncol=length(vecchecks), dimnames=list(names(vecseq),vecchecks)), stringsAsFactors=FALSE)
+        Observations$ok <- "V"
         #
-        nm <- names(vecseq)[i]
-        # NAs
-        NAs <- round(max(sum(is.na(D[nm])) / length(D[nm])))
-        Observations$NAs[i] <- pst(NAs,"%")
-        # Check the length
-        if(length(D[[nm]]) != length(D$t)){
-            Observations$length[i] <- length(D[[nm]])
-        }
-        # Its class
-        Observations$class[i] <- class(D[[nm]])
-        # Not ok?
-        if(sum(Observations[i, 3] == "") < 1){
-            Observations$ok[i] <- ""
+        for(i in 1:length(vecseq)){
+            #
+            nm <- names(vecseq)[i]
+            # NAs
+            NAs <- round(max(sum(is.na(D[nm])) / length(D[nm])))
+            Observations$NAs[i] <- pst(NAs,"%")
+            # Check the length
+            if(length(D[[nm]]) != length(D$t)){
+                Observations$length[i] <- length(D[[nm]])
+            }
+            # Its class
+            Observations$class[i] <- class(D[[nm]])
+            # Not ok?
+            if(sum(Observations[i, 3] == "") < 1){
+                Observations$ok[i] <- ""
+            }
         }
+        print(Observations)
     }
     #
     # For forecasts
     dfseq <- which(dfOrMat)
-    dfchecks <- c("ok","maxNAs","meanNAs","nrow","colnames","sameclass","class")
-    Forecasts <- data.frame(matrix("", nrow=length(dfseq), ncol=length(dfchecks), dimnames=list(names(dfseq),dfchecks)), stringsAsFactors=FALSE)
-    Forecasts$ok <- "V"
-    #
-    for(i in 1:length(dfseq)){
+    Forecasts <- NA
+    if(length(dfseq) > 0){
+        cat("\nForecast data.frames or matrices:\n")
+        dfchecks <- c("ok","maxNAs","meanNAs","nrow","colnames","sameclass","class")
+        Forecasts <- data.frame(matrix("", nrow=length(dfseq), ncol=length(dfchecks), dimnames=list(names(dfseq),dfchecks)), stringsAsFactors=FALSE)
+        Forecasts$ok <- "V"
         #
-        nm <- names(dfseq)[i]
-        colnms <- nams(D[[nm]])
-        # max NAs
-        maxNAs <- round(max(sapply(colnms, function(colnm){ 100*sum(is.na(D[[nm]][ ,colnm])) / nrow(D[[nm]]) })))
-        Forecasts$maxNAs[i] <- pst(maxNAs,"%")
-        # Mean NAs
-        meanNAs <- round(mean(sapply(colnms, function(colnm){ 100*sum(is.na(D[[nm]][ ,colnm])) / nrow(D[[nm]]) })))
-        Forecasts$meanNAs[i] <- pst(meanNAs,"%")
-        # Check the number of rows
-        if(nrow(D[[nm]]) != length(D$t)){
-            Forecasts$nrow[i] <- nrow(D[[nm]])
-        }
-        # Check the colnames, are they unique and all k+integer?
-        if(!length(unique(grep("^k[[:digit:]]+$",colnms,value=TRUE))) == length(colnms)){
-            Forecasts$colnames[i] <- "X"
-        }
-        if(!length(unique(sapply(colnms, function(colnm){ class(D[[nm]][ ,colnm]) }))) == 1){
-            Forecasts$sameclass[i] <- "X"
-        }else{
-            Forecasts$class[i] <- class(D[[nm]][ ,1])
-        }
-        # Not ok?
-        if(sum(Forecasts[i, ] == "") < (length(dfchecks)-4)){
-            Forecasts$ok[i] <- ""
+        for(i in 1:length(dfseq)){
+            #
+            nm <- names(dfseq)[i]
+            colnms <- nams(D[[nm]])
+            # max NAs
+            maxNAs <- round(max(sapply(colnms, function(colnm){ 100*sum(is.na(D[[nm]][ ,colnm])) / nrow(D[[nm]]) })))
+            Forecasts$maxNAs[i] <- pst(maxNAs,"%")
+            # Mean NAs
+            meanNAs <- round(mean(sapply(colnms, function(colnm){ 100*sum(is.na(D[[nm]][ ,colnm])) / nrow(D[[nm]]) })))
+            Forecasts$meanNAs[i] <- pst(meanNAs,"%")
+            # Check the number of rows
+            if(nrow(D[[nm]]) != length(D$t)){
+                Forecasts$nrow[i] <- nrow(D[[nm]])
+            }
+            # Check the colnames, are they unique and all k+integer?
+            if(!length(unique(grep("^k[[:digit:]]+$",colnms,value=TRUE))) == length(colnms)){
+                Forecasts$colnames[i] <- "X"
+            }
+            if(!length(unique(sapply(colnms, function(colnm){ class(D[[nm]][ ,colnm]) }))) == 1){
+                Forecasts$sameclass[i] <- "X"
+            }else{
+                Forecasts$class[i] <- class(D[[nm]][ ,1])
+            }
+            # Not ok?
+            if(sum(Forecasts[i, ] == "") < (length(dfchecks)-4)){
+                Forecasts$ok[i] <- ""
+            }
         }
+        print(Forecasts)
     }
-    #
-    message("Observation vectors:")
-    print(Observations)
-    message("\nForecast data.frames or matrices:")
-    print(Forecasts)
 
     invisible(list(Observations=Observations, Forecasts=Forecasts))
 }

R/lagdl.R

+## Do this in a separate file to see the generated help:
+#library(devtools)
+#document()
+#load_all(as.package("../../onlineforecast"))
+#?lagdl
+
+#' Lagging by shifting the values back or fourth always returning a data.list.
+#'
+#' This function lags (shifts) the values of the vector. A data.list is always returned with each data.frame lagged with \code{lagdf}.
+#'
+#' 
+#' @title Lagging which returns a data.list
+#' @param x The data.list to be lagged.
+#' @param lagseq The integer(s) setting the lag steps.
+#' @return A data.list.
+#' @seealso \code{\link{lagdl.data.frame}} which is run when \code{x} is a data.frame.
+#' @examples
+#' # The values are simply shifted in each data.frame with lagdf
+#'
+#'@export
+
+lagdl <- function(D, lagseq){
+    iseq <- which(sapply(D,class) %in% c("data.frame","matrix"))
+    D[iseq] <- lapply(iseq, function(i){
+        lagdf(D[[i]], lagseq)
+    })
+    return(D)
+}

R/make_input.R

@@ -28,7 +28,7 @@ make_input <- function(observations, kseq){
     val <- sapply(kseq, function(k){
         observations
     })
-    ## set row and column names
+    # set row and column names
     nams(val) <- paste0('k', kseq)
     return( as.data.frame(val) )
 }

inst/CITATION

@@ -15,3 +15,12 @@ citEntry(
       "We are in process of writing a journal paper about the package, but for now we referer to the paper 'Short-term heat load forecasting for single family houses', in which the implemented modelling is described."
   )
 )
+
+citEntry(
+  entry    = "Manual",
+  title    = "{{onlineforecast}: Forecast Modelling for Online Applications}",
+  author   = "Peder Bacher and Hjörleifur G. Bergsteinsson",
+  year     = "2020",
+  note     = "R package version 0.9.3",
+  url      = "https://onlineforecasting.org"
+)

make.R

@@ -60,10 +60,10 @@ library(roxygen2)
 # ----------------------------------------------------------------
 # Build the package
 document()
-build(".", vignettes=TRUE)
+build(".", vignettes=FALSE)
 
 # Install it
-install.packages("../onlineforecast_0.9.3.tar.gz")
+install.packages("../onlineforecast_0.9.4.tar.gz")
 
 library(onlineforecast)
 # ----------------------------------------------------------------

vignettes/setup-and-use-model.Rmd

@@ -362,6 +362,7 @@ There are quite a few functions available for input transformations:
 - `one()` generates an matrix of ones (for including an intercept).
 - `fs()` generate Fourier series for modelling harmonic functions.
 - `bspline()` wraps the `bs()` function for generating base splines.
+- `pbspline()` wraps the `pbs()` function for generating periodic base splines.
 - `AR()` generates auto-regressive model inputs.
 
 and they can even be combined, see more details in [onlineforecasting] and in their help