From a58ec3c79d146f7c2f68d805eb70f5ad6ce53729 Mon Sep 17 00:00:00 2001 From: Peder <pbac@dtu.dk> Date: Thu, 3 Sep 2020 22:23:31 +0200 Subject: [PATCH] v0.9.1 submitted --- DESCRIPTION | 5 ++--- R/plot_ts.R | 16 ---------------- R/plotly_ts.R | 13 +++++-------- R/{score_for_k.R => score.R} | 8 ++++---- vignettes/forecast-evaluation.Rmd | 6 +++--- 5 files changed, 14 insertions(+), 34 deletions(-) rename R/{score_for_k.R => score.R} (92%) diff --git a/DESCRIPTION b/DESCRIPTION index fbdecc7..30eec4b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,15 +15,14 @@ Imports: R6 (>= 2.2.2), splines (>= 3.1.1), pbs, - digest, + digest LinkingTo: Rcpp, RcppArmadillo Suggests: knitr, rmarkdown, R.rsp, testthat (>= 2.1.0), - data.table, - plotly + data.table VignetteBuilder: knitr RoxygenNote: 7.1.1 URL: http://onlineforecasting.org diff --git a/R/plot_ts.R b/R/plot_ts.R index 00103da..a05b6af 100644 --- a/R/plot_ts.R +++ b/R/plot_ts.R @@ -60,17 +60,6 @@ #' names(L[[2]]) #' #' -#' # Use plotly -#' \donttest{library(plotly) -#' L <- plot_ts(D, c("heatload","Ta"), kseq=c(1,24), usely=TRUE, xlab="Time", -#' ylabs=c("Heat (kW)","Temperature (C)")) -#' -#' # From plotly the figures are returned and can be further manipulated -#' # e.g. put the legend in the top by -#' L[[length(L)]] <- L[[length(L)]] %>% layout(legend = list(x = 100, y = 0.98)) -#' print(subplot(L, shareX=TRUE, nrows=length(L), titleY = TRUE)) -#' } -#' #' @rdname plot_ts #' @export plot_ts <- function(object, patterns=".*", xlim = NA, ylims = NA, xlab = "", ylabs = NA, @@ -474,11 +463,6 @@ plot_ts_series <- function(data, pattern, iplot = 1, #' # Plot it #' plot_ts(fit1) #' -#' # Plot it with plotly -#' \donttest{ -#' plot_ts(fit1, usely=TRUE) -#' } -#' #' # Return the data #' Dplot <- plot_ts(fit1) #' diff --git a/R/plotly_ts.R b/R/plotly_ts.R index 5f34a21..209ba28 100644 --- a/R/plotly_ts.R +++ b/R/plotly_ts.R @@ -9,20 +9,17 @@ #' #' Simply the same as \code{\link{plot_ts}()} with \code{usely=TRUE}, such that plotly is used. #' -#' The \code{plotly} package must be loaded. +#' The \code{plotly} package must be installed and loaded. #' #' Note that the plot parameters set with \code{\link{par_ts}()} have no effect on the \code{plotly} plots. #' +#' See \url{http://https://onlineforecasting.org/vignettes/nice-tricks.html}. +#' #' @rdname plot_ts #' @examples #' -#' \donttest{ -#' D <- Dbuilding -#' plotly_ts(D, c("heatload","Ta"), kseq=c(1,24)) -#' plotly_ts(D, c("heatload","Ta"), kseq=c(1,24)) -#' plotly_ts(D, c("heatload","Ta$|Taobs$"), kseq=c(1,24)) -#' } -#' +#' # See the website link above +#' #' @export plotly_ts <- function(object, patterns=".*", xlim = NA, ylims = NA, xlab = "", ylabs = NA, diff --git a/R/score_for_k.R b/R/score.R similarity index 92% rename from R/score_for_k.R rename to R/score.R index 6b9cea9..e394c3d 100644 --- a/R/score_for_k.R +++ b/R/score.R @@ -24,7 +24,7 @@ #' Resid <- residuals(Yhat, y) #' #' # Calculate the score for the k1 horizon -#' score(Resid)$val +#' score(Resid)$scoreval #' #' # The first values were excluded, since there are NAs #' head(Resid) @@ -50,10 +50,10 @@ score <- function(Residuals, scoreperiod = NA, usecomplete = TRUE, scorefun = rm scoreperiod <- scoreperiod & complete.cases(Residuals) } # Calculate the objective function for each horizon - val <- sapply(1:ncol(Residuals), function(i){ + scoreval <- sapply(1:ncol(Residuals), function(i){ scorefun(Residuals[scoreperiod,i]) }) - nams(val) <- gsub("h","k",nams(Residuals)) + nams(scoreval) <- gsub("h","k",nams(Residuals)) # - return(list(val=val,scoreperiod=scoreperiod)) + return(list(scoreval=scoreval,scoreperiod=scoreperiod)) } diff --git a/vignettes/forecast-evaluation.Rmd b/vignettes/forecast-evaluation.Rmd index 8da010e..f40ad81 100644 --- a/vignettes/forecast-evaluation.Rmd +++ b/vignettes/forecast-evaluation.Rmd @@ -326,14 +326,14 @@ Now the residuals can be calculated and the score: # Use the residuals function R <- residuals(D$Yhat1, D$y) # And the score as a function of the horizon -score(R, scoreperiod=ok)$val +score(R, scoreperiod=ok)$scoreval ``` Calculated the score (default is RMSE) for all models: ```{r} RMSE <- sapply(nms, function(nm){ - score(residuals(D[[nm]],D$y), ok)$val + score(residuals(D[[nm]],D$y), ok)$scoreval }) ``` @@ -386,7 +386,7 @@ fittmp <- rls_fit(model$prm, model, D) Finally, the score can be calculated on the period following the train period by: ```{r scorefit} -score_fit(fittmp, !D$trainperiod)$val +score_fit(fittmp, !D$trainperiod)$scoreval ``` In this way it's rather easy to set up different schemes, like optimizing the -- GitLab