release v0.7.0 -- see NEWS.md

Author: thierrymoudiki

DESCRIPTION

@@ -2,7 +2,7 @@ Package: ahead
 Type: Package
 Title: Time Series Forecasting
 Version: 0.7.0
-Date: 2023-08-20
+Date: 2023-08-23
 Author: T. Moudiki
 Maintainer: T. Moudiki <thierry.moudiki@gmail.com>
 Description: Univariate and multivariate time series forecasting.

NAMESPACE

@@ -1,5 +1,6 @@
 useDynLib(ahead, .registration=TRUE)
 S3method(plot, mtsforecast)
+S3method(plot, pairs)
 S3method(predict, ridge)
 importFrom(Rcpp, evalCpp)
 importFrom(VineCopula, C2RVine)
@@ -16,8 +17,8 @@ importFrom(fGarch, garchFit)
 importFrom("grDevices", "colorRampPalette")
   importFrom("graphics", "abline", "par", "points", "polygon")
   importFrom("stats", "t.test")
-importFrom("stats", "as.ts", "complete.cases", "end", "frequency",
-           "median", "predict", "predict.lm", "qnorm", "quantile",
+importFrom("stats", "as.ts", "complete.cases", "ecdf", "end", "frequency",
+           "lag", "median", "predict", "predict.lm", "qnorm", "quantile",
            "residuals", "rnorm", "rt", "sd", "setNames", "start",
            "ts", "tsp", "tsp<-")
 importFrom("utils", "tail")
@@ -32,5 +33,5 @@ export("loessf")
 export("ridge2f")
 export("ridge")
 export("varf")
+export("getreturns")
 export("getsimulations")
-export("splitts")

NEWS.md

@@ -1,12 +1,13 @@
 # version 0.7.0
 
-- `getsimulations` extracts simulations from a given time series (from `ridge2f` and `basicf`)
-- moving block bootstrap in `ridge2f`, `basicf` and `loessf` (in addition to circular block bootstrap from 0.6.2)
-- adjust copulas on residuals for `ridge2f`
+- moving block bootstrap in `ridge2f`, `basicf` and `loessf`, in addition to circular block bootstrap from 0.6.2
+- adjust R-Vine copulas on residuals for `ridge2f` simulation
 - new plots for simulations see (new) vignettes
-- split conformal prediction intervals (very experimental right now)
-- neutralization (TODO)(list with yM and mats, check with time(y) :o )
-- `Depends` vs `Imports` (beneficial to Python and rpy2 for installation time?)
+- split conformal prediction intervals (**very very experimental** and basic right now, too conservative)
+- `Depends` and selective `Imports` (beneficial to Python and rpy2 for installation time?)
+- `getsimulations` extracts simulations from a given time series (from `ridge2f` and `basicf`)
+- `getreturns` extracts returns/log-returns from multivariate time series
+- `splitts` splits time series using a proportion of data
 
 # version 0.6.2
 

R/basic.R

@@ -104,6 +104,7 @@ basicf <- function(y,
   fits <- ts(t(replicate(n = n_inputs, expr = point_forecast)),
              start = start_x, frequency = freq_x)
   resids <- y - fits
+  colnames(resids) <- colnames(y)
 
   # out-of-sample
   fcast <- ts(t(replicate(n = h, expr = point_forecast)),

R/getreturns.R

@@ -0,0 +1,37 @@
+#' Calculate returns or log-returns for multivariate time series
+#'
+#' @param x Multivariate time series
+#' @param type Type of return: basic return ("basic") or log-return ("log")
+#'
+#' @return The returns
+#' @export
+#'
+#' @examples
+#'
+#' returns <- getreturns(EuStockMarkets)
+#' log_returns <- getreturns(EuStockMarkets,
+#'                           type = "log")
+#'
+#' par(mfrow=c(1, 3))
+#' matplot(EuStockMarkets, type = 'l', main = "Closing Prices of \n European stocks (1991-1998)",
+#' xlab = "time")
+#' matplot(returns, type = 'l', main = "Returns", xlab = "time")
+#' matplot(log_returns, type = 'l', main = "Log-returns", xlab = "time")
+#'
+getreturns <- function(x, type = c("basic", "log"))
+{
+  # ?rlang::abort #?
+  stopifnot(is.ts(x))
+  names_x <- colnames(x)
+  type <- match.arg(type)
+
+  if (identical(type, "basic"))
+  {
+    res <- diff(x)/lag(x)
+    colnames(res) <- names_x
+    return (res)
+  }
+  res <- diff(log(x))
+  colnames(res) <- names_x
+  return (res)
+}

R/plot.R

@@ -1,8 +1,9 @@
-#' Plot multivariate time series forecast
+#' Plot multivariate time series forecast or residuals
 #'
-#' @param x result from varf or ridge2f (multivariate time series forecast)
+#' @param x result from \code{basicf}, \code{ridge2f} or \code{varf} (multivariate time series forecast)
 #' @param selected_series name of the time series selected for plotting
-#' @param type_graph "pi": basic prediction intervals; "dist": a distribution of predictions; "sims": the simulations
+#' @param type_graph "pi": basic prediction intervals;
+#' "dist": a distribution of predictions; "sims": the simulations
 #' @param level confidence levels for prediction intervals
 #' @param ... additional parameters to be passed to \code{plot} or \code{matplot}
 #'
@@ -41,9 +42,10 @@
 #'
 #'
 plot.mtsforecast <- function(x, selected_series,
-                             type_graph = c("pi", "dist", "sims"),
-                             level = 95,
-                             ...)
+                             type_graph = c("pi",
+                                            "dist",
+                                            "sims"),
+                             level = 95, ...)
 {
   type_graph <- match.arg(type_graph)
 
@@ -73,6 +75,8 @@ plot.mtsforecast <- function(x, selected_series,
       lines(y_upper, col="gray60")
       lines(y_lower, col="gray60")
       lines(y_mean)
+
+      return()
     }
 
     if (type_graph == "dist")
@@ -107,6 +111,8 @@ plot.mtsforecast <- function(x, selected_series,
       bands_add(abs, y_mean, col = color[3], ci_upper = x_summary[2, ],
                 ci_lower = x_summary[4, ])
 
+      return()
+
     }
 
     if (type_graph == "sims")
@@ -149,15 +155,93 @@ plot.mtsforecast <- function(x, selected_series,
         ...
       )
       lines(x = time_inputs, y = input_series, lwd = 2)
-    }
-
 
+      return()
+    }
   } else {
-   stop("Method not implemented for this type of object")
+    stop("Method not implemented for this type of object")
   }
 }
 
 
+#' Plot bivariate distributions
+#'
+#' @param x bivariate matrix or time series
+#' @param y additional series (default is \code{NULL})
+#' @export
+#'
+#' @examples
+#'
+#' obj <- ahead::ridge2f(fpp::insurance, h = 10, type_pi = "blockbootstrap",
+#' block_length=5, B = 10)
+#'
+#' \dontrun{
+#' plot(obj$residuals, type_graph = "pairs")
+#' }
+#'
+#'
+plot.pairs <- function(x, y = NULL)
+{
+  x <- matrix(unlist(x), ncol = 2)
+  if (!is.null(y))
+  {
+    y <- matrix(unlist(y), ncol = 2)
+    if (length(x) != length(y)) stop("'x' and 'y' must have the same dimensions")
+    xvar <- c(x[,1], y[,1])
+    yvar <- c(x[,2], y[,2])
+    nb  <- dim(x)[1]
+    zvar <- as.factor(c(rep("x", nb), rep("y", nb)))
+    xy <- data.frame(xvar, yvar, zvar)
+  }
+  else
+  {
+    xvar <- x[,1]
+    yvar <- x[,2]
+    nb  <- dim(x)[1]
+    zvar <- as.factor(rep("x", nb))
+    xy <- data.frame(xvar, yvar, zvar)
+  }
+
+  #placeholder plot - prints nothing at all
+  empty <- ggplot()+ggplot2::geom_point(ggplot2::aes(1,1), colour="white") +
+    ggplot2::theme(
+      plot.background = ggplot2::element_blank(),
+      panel.grid.major = ggplot2::element_blank(),
+      panel.grid.minor = ggplot2::element_blank(),
+      panel.border = ggplot2::element_blank(),
+      panel.background = ggplot2::element_blank(),
+      axis.title.x = ggplot2::element_blank(),
+      axis.title.y = ggplot2::element_blank(),
+      axis.text.x = ggplot2::element_blank(),
+      axis.text.y = ggplot2::element_blank(),
+      axis.ticks = ggplot2::element_blank()
+    )
+
+  # plot slow af
+
+  #scatterplot of x and y variables
+  scatter <- ggplot(xy, ggplot2::aes(xvar, yvar)) +
+    ggplot2::geom_point(ggplot2::aes(color=zvar)) +
+    ggplot2::scale_color_manual(values = c("blue", "red")) +
+    ggplot2::theme(legend.position=c(1,1),legend.justification=c(1,1))
+
+  #marginal density of x - plot on top
+  plot_top <- ggplot(xy, ggplot2::aes(xvar, fill=zvar)) +
+    ggplot2::geom_density(alpha=.5) +
+    ggplot2::scale_fill_manual(values = c("blue", "red")) +
+    ggplot2::theme(legend.position = "none")
+
+  #marginal density of y - plot on the right
+  plot_right <- ggplot(xy, ggplot2::aes(yvar, fill=zvar)) +
+    ggplot2::geom_density(alpha=.5) +
+    ggplot2::coord_flip() +
+    ggplot2::scale_fill_manual(values = c("blue", "red")) +
+    ggplot2::theme(legend.position = "none")
+
+  #arrange the plots together, with appropriate height and width for each row and column
+  grid.arrange(plot_top, empty, scatter, plot_right, ncol=2, nrow=2, widths=c(4, 1), heights=c(1, 4))
+}
+
 # plot bands # work in progress #scratchinghead
 bands_plot <- function(x, y_mean, ci_upper, ci_lower, col, y.goal = NULL, goal.col = "blue", ...)
 {