Changed lag() to lg()

R/AR.R

@@ -79,7 +79,7 @@ AR <- function(lags){
         # Check if saved output values for AR exists
     	if(is.na(model$yAR[1])){
             # First time its called, so just use output values from data
-            val <- matrix(lag(data[[model$output]], lag), nrow=length(data$t), ncol=length(model$kseq))
+            val <- matrix(lg(data[[model$output]], lag), nrow=length(data$t), ncol=length(model$kseq))
     	}else{
             y <- c(model$yAR, data$y)
             # Find the seq for the new y lagged vector

R/data.list.R

@@ -174,7 +174,7 @@ subset.data.list <- function(x, subset = NA, nms = NA, kseq = NA, lagforecasts =
     if(lagforecasts){
         val <- lapply(val, function(X){
             if(any(class(X) == "data.frame") & length(grep("^k[[:digit:]]+$",names(X))) > 0) {
-                return(lag.data.frame(X, lagseq="+k"))
+                return(lg.data.frame(X, lagseq="+k"))
             }else{
                 return(X)
             }

R/lag.R

@@ -2,7 +2,7 @@
 #library(devtools)
 #document()
 #load_all(as.package("../../onlineforecast"))
-#?lag
+#?lg
 
 lag_vector <- function(x, lag){
     if (lag > 0) {
@@ -23,38 +23,40 @@ lag_vector <- function(x, lag){
 #' vector is returned. If \code{lagseq} is an integer vector, then a data.frame is returned with the columns
 #' as the vectors lagged with the values in lagseq.
 #'
-#' Note that this changes the behaviour of the default \code{\link{lag}()} function.
 #' 
 #' @title Lagging of a vector
 #' @param x The vector to be lagged.
 #' @param lagseq The integer(s) setting the lag steps.
-#' @param ... Not used.
 #' @return A vector or a data.frame.
 #' @name lag
-#' @seealso \code{\link{lag.data.frame}} which is run when \code{x} is a data.frame.
+#' @seealso \code{\link{lg.data.frame}} which is run when \code{x} is a data.frame.
 #' @examples
 #' # The values are simply shifted
 #' # Ahead in time
-#' lag(1:10, 3)
+#' lg(1:10, 3)
 #' # Back in time
-#' lag(1:10, -3)
+#' lg(1:10, -3)
 #' # Works but returns a numric
-#' lag(as.factor(1:10), 3)
+#' lg(as.factor(1:10), 3)
 #' # Works and returns a character
-#' lag(as.character(1:10), 3)
+#' lg(as.character(1:10), 3)
 #' # Giving several lag values
-#' lag(1:10, c(1:3))
-#' lag(1:10, c(5,3,-1))
+#' lg(1:10, c(1:3))
+#' lg(1:10, c(5,3,-1))
 #'
 #' # See also how to lag a forecast data.frame
-#' ?lag.data.frame
+#' ?lg.data.frame
 #'
 #'
-#'
-#' @importFrom stats lag
+#'@export
+
+lg <- function(x, lagseq){
+    UseMethod("lg")
+}
+
 
 #' @export
-lag.numeric <- function(x, lagseq, ...) {
+lg.numeric <- function(x, lagseq) {
     if(length(lagseq) == 1){
         return(lag_vector(x, lagseq))
     }else{
@@ -69,19 +71,19 @@ lag.numeric <- function(x, lagseq, ...) {
 
 
 #' @export
-lag.factor <- function(x, lagseq, ...) {
-    lag.numeric(x, lagseq)
+lg.factor <- function(x, lagseq) {
+    lg.numeric(x, lagseq)
 }
 
 
 #' @export
-lag.character <- function(x, lagseq, ...) {
-    lag.numeric(x, lagseq)
+lg.character <- function(x, lagseq) {
+    lg.numeric(x, lagseq)
 }
 
 #' @export
-lag.logical <- function(x, lagseq, ...) {
-    lag.numeric(x, lagseq)
+lg.logical <- function(x, lagseq) {
+    lg.numeric(x, lagseq)
 }
 
 
@@ -92,9 +94,8 @@ lag.logical <- function(x, lagseq, ...) {
 #' @title Lagging of a data.frame
 #' @param x The data.frame to have columns lagged
 #' @param lagseq The sequence of lags as an integer. Alternatively, as a character "+k", "-k", "+h" or "-h", e.g. "k12" will with "+k" be lagged 12.
-#' @param ... Not used.
 #' @return A data.frame with columns that are lagged
-#' @name lag.data.frame
+#' @name lg.data.frame
 #' @examples
 #' 
 #' # dataframe of forecasts
@@ -102,30 +103,30 @@ lag.logical <- function(x, lagseq, ...) {
 #' X
 #'
 #' # Lag all columns
-#' lag(X, 1)
-#' \dontshow{if(!all(is.na(lag(X, 1)[1, ]))){stop("Lag all columns didn't work")}}
+#' lg(X, 1)
+#' \dontshow{if(!all(is.na(lg(X, 1)[1, ]))){stop("Lag all columns didn't work")}}
 #'
 #' # Lag each column different steps
-#' lag(X, 1:3)
+#' lg(X, 1:3)
 #' # Lag each columns with its k value from the column name
-#' lag(X, "+k")
+#' lg(X, "+k")
 #' \dontshow{
-#'     if(any(lag(X, 1:3) != lag(X, "+k"),na.rm=TRUE)){stop("Couldn't lag +k")}
+#'     if(any(lg(X, 1:3) != lg(X, "+k"),na.rm=TRUE)){stop("Couldn't lag +k")}
 #' }
 #' # Also works for columns named hxx
 #' names(X) <- gsub("k", "h", names(X))
-#' lag(X, "-h")
+#' lg(X, "-h")
 #'
 #' # If not same length as columns in X, then it doesn't know how to lag
-#' \donttest{lag(X, 1:2)}
+#' \donttest{lg(X, 1:2)}
 #'
 #' \dontshow{
-#' if(!class(lag(data.frame(k1=1:10), 2)) == "data.frame"){stop("Trying to lag data.frame with 1 column, but return is not class data.frame")}
-#' if(!all(dim(lag(data.frame(k1=1:10), "+k")) == c(10,1))){stop("Trying to lag data.frame with 1 column, but return is not class data.frame")}
+#' if(!class(lg(data.frame(k1=1:10), 2)) == "data.frame"){stop("Trying to lag data.frame with 1 column, but return is not class data.frame")}
+#' if(!all(dim(lg(data.frame(k1=1:10), "+k")) == c(10,1))){stop("Trying to lag data.frame with 1 column, but return is not class data.frame")}
 #' }
 #'
 #' @export
-lag.data.frame <- function(x, lagseq, ...) {
+lg.data.frame <- function(x, lagseq) {
     X <- x
     nms <- nams(X)
     if (length(lagseq) == 1) {
@@ -173,22 +174,22 @@ lag.data.frame <- function(x, lagseq, ...) {
 }
 
 #' @export
-lag.matrix <- function(x, lagseq, ...){
-    lag.data.frame(x, lagseq)
+lg.matrix <- function(x, lagseq){
+    lg.data.frame(x, lagseq)
 }
 
 ## ## Test
 ## x <- data.frame(k1=1:5,k2=6:10)
 ## ##
-## lag(x, lagseq=1)
+## lg(x, lagseq=1)
 ## source("nams.R")
-## lag(as.matrix(x), lagseq=c(1,2))
+## lg(as.matrix(x), lagseq=c(1,2))
 ## ##
-## lag(x, lagseq="+k")
-## lag(x, "+k")
-## lag(x, "-k")
+## lg(x, lagseq="+k")
+## lg(x, "+k")
+## lg(x, "-k")
 
-## lag.data.table <- function(x, nms, lagseq, per_reference = FALSE) {
+## lg.data.table <- function(x, nms, lagseq, per_reference = FALSE) {
 ##     DT <- x
 ##     if (!per_reference) {
 ##         ## Don't do it per reference

R/persistence.R

@@ -38,7 +38,7 @@ persistence <- function(y, kseq, perlen=NA){
     }else{
         # A periodic persistence
         Yhat <- as.data.frame(sapply(kseq, function(k){
-            lag(y, (perlen-k)%%perlen)
+            lg(y, (perlen-k)%%perlen)
         }))
     }
     names(Yhat) <- pst("k",kseq)

R/plot_ts.R

@@ -136,7 +136,7 @@ plot_ts.data.list <- function(object, patterns=".*", xlim = NA, ylims = NA, xlab
                             # Started with k, then it's forecasts and must be lagged to sync
                             if( prefix == "k" ){
                                 ks <- as.integer(gsub("k","",nams(DL[[nm]])[i]))
-                                X <- lag(X, lagseq=ks)
+                                X <- lg(X, lagseq=ks)
                             }
                             # Fix if it is a vector
                             if(is.null(dim(X))) {

R/residuals.R

@@ -43,7 +43,7 @@
 residuals.data.frame <- function(object, y, ...){
     Yhat <- object
     # Add some checking at some point
-    Residuals <- y - lag(Yhat, "+k")
+    Residuals <- y - lg(Yhat, "+k")
     # Named with hxx (it's not a forecast, but an observation available at t)
     names(Residuals) <- gsub("k","h",names(Residuals))
     #

R/rls_summary.R

@@ -104,7 +104,7 @@ rls_summary <- function(object, scoreperiod = NA, scorefun = rmse, usecomplete =
         #abscv <- abs(s/m)
         # # An AR1 coefficient can tell a bit about the behaviour of the coefficient
         # x <- c(val)
-        # xl1 <- lag(x,1)
+        # xl1 <- lg(x,1)
         #
         c(mean=m, sd=s, min=min(val,na.rm=TRUE), max=max(val,na.rm=TRUE)) #coefvar=abscv, skewness=skewness(val, na.rm=TRUE))#, ar1=unname(lm(x ~ xl1)$coefficients[2]))
     }))

data/all/make.R

@@ -35,7 +35,7 @@ for (ii in 1:length(nms)) {
     i <- i[grep("k[[:digit:]]+$", names(data_or)[i])]
     # 
     #
-    data[[nms[ii]]] <- lag(data_or[ ,i], -1:-length(i))
+    data[[nms[ii]]] <- lg(data_or[ ,i], -1:-length(i))
     names(data[[nms[ii]]]) <- pst("k", 1:length(i))
     row.names(data[[nms[ii]]]) <- NULL
     data[[nms[ii]]] <- as.data.frame(data[[nms[ii]]])

make.R

@@ -43,7 +43,7 @@ library(roxygen2)
 #use_test("newtest")
 
 # # Run all tests
-# test()
+test()
 
 # # Run the examples
 # run_examples()

vignettes/.gitignore

-*.html
-*.R

vignettes/forecast-evaluation.Rmd

@@ -14,7 +14,7 @@ vignette: >
 library(knitr)
 # This vignettes name
 vignettename <- "forecast-evaluation"
-# REMEMBER TO CHANGE IN shared-init.Rmd and copy in to each vignette, if chaging setup
+# REMEMBER: IF CHANGING IN THE shared-init (next block), then copy to the others!
 ```
 <!--shared-init-start-->
 ```{r init, cache=FALSE, include=FALSE, purl=FALSE}
@@ -308,7 +308,7 @@ for(nm in nms[-1]){
 ok <- as.data.frame(ok)
 names(ok) <- pst("k",kseq)
 # Lag to match resiuduals in time
-ok <- lag(ok, "+k")
+ok <- lg(ok, "+k")
 # Only the score period
 ok <- ok & D$scoreperiod
 # Finally, the vector with TRUE for all points with no NAs for any forecast
@@ -339,7 +339,7 @@ RMSE <- sapply(nms, function(nm){
     
 ```{r, include=FALSE}
 # sapply(kseq, function(k){
-#     rmse(y - lag(YhatDM[ ,pst("k",k)], k))
+#     rmse(y - lg(YhatDM[ ,pst("k",k)], k))
 #     # hej det er vilfred jeg er peders søn og jeg elsker min far go jeg god til matematik og jeg elsker også min mor 
 # })
 ```

vignettes/make.R

-# REMEMBER TO CHANGE IN shared-init.Rmd and copy in to each vignette, if chaging setup
+# REMEMBER TO CHANGE IN shared-init in all
 
 library(knitr)
 library(rmarkdown)

vignettes/online-updating.Rmd

@@ -17,7 +17,7 @@ vignette: >
 library(knitr)
 # This vignettes name
 vignettename <- "online-updating"
-# REMEMBER TO CHANGE IN shared-init.Rmd and copy in to each vignette, if chaging setup
+# REMEMBER: IF CHANGING IN THE shared-init (next block), then copy to the others!
 ```
 
 <!--shared-init-start-->

vignettes/setup-and-use-model.Rmd

@@ -17,7 +17,7 @@ vignette: >
 library(knitr)
 # This vignettes name
 vignettename <- "setup-and-use-model"
-# REMEMBER TO CHANGE IN shared-init.Rmd and copy in to each vignette, if chaging setup
+# REMEMBER: IF CHANGING IN THE shared-init (next block), then copy to the others!
 ```
 
 <!--shared-init-start-->

vignettes/setup-data.Rmd

@@ -18,7 +18,7 @@ vignette: >
 library(knitr)
 ## This vignettes name
 vignettename <- "setup-data"
-# REMEMBER TO CHANGE IN shared-init.Rmd and copy in to each vignette, if chaging setup
+# REMEMBER: IF CHANGING IN THE shared-init (next block), then copy to the others!
 ```
 
 <!--shared-init-start-->
@@ -291,7 +291,7 @@ legend("topright", c("8-step forecasts","Observations"), bg="white", lty=1, col=
 Notice how the are not aligned, since the forecasts are 8 hours ahead. To align
 them the forecasts must be lagged 8 steps by:
 ```{r}
-plot(D$t[i], lag(D$I$k8[i], 8), type="l", col=2, xlab="Time", ylab="Global radiation (W/m²)")
+plot(D$t[i], lg(D$I$k8[i], 8), type="l", col=2, xlab="Time", ylab="Global radiation (W/m²)")
 lines(D$t[i], D$I.obs[i])
 legend("topright", c("8-step forecasts lagged","Observations"), bg="white", lty=1, col=2:1)
 ```
@@ -334,7 +334,7 @@ example the heatload vs. ambient temperature 8-step forecast:
 ```{r, fig.width=2*fhs, fig.height=fhs, out.width=ows2}
 par(mfrow=c(1,2))
 plot(D$Ta$k8, D$heatload)
-plot(lag(D$Ta$k8, 8), D$heatload)
+plot(lg(D$Ta$k8, 8), D$heatload)
 ```
 So lagging (thus aligning in time) makes less slightly less scatter.
 
@@ -350,7 +350,7 @@ Just as a quick side note: This is the principle used for fitting onlineforecast
 models, simply shift forecasts to align with the observations:
 ```{r, fig.width=fhs, fig.height=fhs, out.width=ows}
 ## Lag the 8-step forecasts to be aligned with the observations
-x <- lag(D$I$k8, 8)
+x <- lg(D$I$k8, 8)
 ## Take a smaller range
 x <- x[i]
 ## Take the observations

vignettes/shared-init.Rmd

-```{r init, cache=FALSE, include=FALSE, purl=FALSE}
-# Width will scale all
-figwidth <- 12
-# Scale the wide figures (100% out.width)
-figheight <- 4
-# Heights for stacked time series plots
-figheight1 <- 5
-figheight2 <- 6.5
-figheight3 <- 8
-figheight4 <- 9.5
-figheight5 <- 11
-# Set the size of squared figures (same height as full: figheight/figwidth)
-owsval <- 0.35
-ows <- paste0(owsval*100,"%")
-ows2 <- paste0(2*owsval*100,"%")
-# 
-fhs <- figwidth * owsval
-
-# Set for square fig: fig.width=fhs, fig.height=fhs, out.width=ows}
-# If two squared the:  fig.width=2*fhs, fig.height=fhs, out.width=ows2
-
-# Check this: https://bookdown.org/yihui/rmarkdown-cookbook/chunk-styling.html
-# Set the knitr options
-knitr::opts_chunk$set(
-  collapse = TRUE,
-  comment = "##    ",
-  prompt = FALSE,
-  cache = TRUE,
-  cache.path = paste0("tmp-output/tmp-",vignettename,"/"),
-  fig.align="center",
-  fig.path = paste0("tmp-output/tmp-",vignettename,"/"),
-  fig.height = figheight,
-  fig.width = figwidth,
-  out.width = "100%"
-)
-options(digits=3)
-
-hook_output <- knit_hooks$get("output")
-knit_hooks$set(output = function(x, options) {
-  lines <- options$output.lines
-  if (is.null(lines)) {
-    return(hook_output(x, options))  # pass to default hook
-  }
-  x <- unlist(strsplit(x, "\n"))
-  more <- "## ...output cropped"
-  if (length(lines)==1) {        # first n lines
-    if (length(x) > lines) {
-      # truncate the output, but add ....
-      x <- c(head(x, lines), more)
-    }
-  } else {
-    x <- c(more, x[lines], more)
-  }
-  # paste these lines together
-  x <- paste(c(x, ""), collapse = "\n")
-  hook_output(x, options)
-})
-
-```
-
-[onlineforecasting]: https://onlineforecasting.org/articles/onlineforecasting.pdf
-[building heat load forecasting]: https://onlineforecasting.org/examples/building-heat-load-forecasting.html
-[onlineforecasting.org]: https://onlineforecasting.org