From e8458971744b0fa8aaa8863056888d8901ec8c25 Mon Sep 17 00:00:00 2001
From: Peder <pbac@dtu.dk>
Date: Wed, 23 Sep 2020 13:55:23 +0200
Subject: [PATCH] small stuff
---
DESCRIPTION | 2 +-
R/bspline.R | 7 +-
R/data.list.R | 109 ++++++++++++++++--------------
R/lagdl.R | 28 ++++++++
R/make_input.R | 2 +-
inst/CITATION | 9 +++
make.R | 4 +-
vignettes/setup-and-use-model.Rmd | 1 +
8 files changed, 104 insertions(+), 58 deletions(-)
create mode 100644 R/lagdl.R
diff --git a/DESCRIPTION b/DESCRIPTION
index a90139a..9d12fff 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
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
diff --git a/R/bspline.R b/R/bspline.R
index 39103ed..24aa9e7 100644
--- a/R/bspline.R
+++ b/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])) {
diff --git a/R/data.list.R b/R/data.list.R
index 291ac43..d57a7ac 100644
--- a/R/data.list.R
+++ b/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))
}
diff --git a/R/lagdl.R b/R/lagdl.R
new file mode 100644
index 0000000..5f6696f
--- /dev/null
+++ b/R/lagdl.R
@@ -0,0 +1,28 @@
+## 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)
+}
diff --git a/R/make_input.R b/R/make_input.R
index ff525d1..b7ea05c 100644
--- a/R/make_input.R
+++ b/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) )
}
diff --git a/inst/CITATION b/inst/CITATION
index a7bf2f4..38f0980 100644
--- a/inst/CITATION
+++ b/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"
+)
diff --git a/make.R b/make.R
index 25614e4..cf5912c 100644
--- a/make.R
+++ b/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)
# ----------------------------------------------------------------
diff --git a/vignettes/setup-and-use-model.Rmd b/vignettes/setup-and-use-model.Rmd
index 73b537e..2b04bc6 100644
--- a/vignettes/setup-and-use-model.Rmd
+++ b/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
--
GitLab