Rfssa (version 2.1.0)

fforecast: Functional Singular Spectrum Analysis Recurrent Forecasting and Vector Forecasting

Description

This function performs functional singular spectrum analysis (FSSA) recurrent forecasting (FSSA R-forecasting) or vector forecasting (FSSA V-forecasting) of univariate or multivariate functional time series (fts) observed over a one-dimensional domain.

Usage

fforecast(U, groups = list(c(1)), h = 1, method = "recurrent", tol = 10^-3)

Value

A list of objects of class fts where each fts corresponds to a forecasted group.

Arguments

U

An object of class fssa that holds the decomposition.

groups

A list of numeric vectors where each vector includes indices of elementary components of a group used for reconstruction and forecasting.

h

An integer that specifies the forecast horizon.

method

A character string specifying the type of forecasting to perform either "recurrent" or "vector".

tol

A double specifying the amount of tolerated error in the approximation of the matrix that corresponds with the operator formed using a Neumann series leveraged in both forecasting algorithms; see Trinka et. al. (2021) for more details.

Examples

if (FALSE) {
# FSSA Forecasting
require(Rfssa)
load_github_data("https://github.com/haghbinh/Rfssa/blob/master/data/Callcenter.RData")
## Define functional objects
D <- matrix(sqrt(Callcenter$calls), nrow = 240)
N <- ncol(D)
time <- substr(seq(ISOdate(1999, 1, 1), ISOdate(1999, 12, 31), by = "day"),1,10)
K <- nrow(D)
u <- seq(0, K, length.out = K)
d <- 22
## Define functional time series
Y <- Rfssa::fts(list(D), list(list(d, "bspline")), list(u),time)
plot(Y, mains = c("Call Center Data Line Plot"),
xlabels = "Time (6 minutes aggregated)",
ylabels = "Sqrt of Call Numbers",type="line",
xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
 list(c(1,60,120,180,240)))
## Perform FSSA decomposition
L <- 28
U <- fssa(Y, L)
groups <- list(1, 2:3, 4:5, 6:7, 1:7)
## Perform FSSA R-forecast and FSSA V-forecast
pr_R <- fforecast(U = U, groups = groups, h = 30,
method = "recurrent", tol = 10^-3)
plot(pr_R[[1]], mains = "Call Center Mean Component Forecast",
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))
plot(pr_R[[2]], mains = "Call Center First Periodic Component Forecast",
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))
plot(pr_R[[3]], mains = "Call Center Second Periodic Component Forecast",
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))
plot(pr_R[[4]], mains = "Call Center Third Periodic Component Forecast",
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))
plot(Y, mains = c("Call Center Data Line Plot"),
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))
plot(pr_R[[5]], mains = "Call Center Extracted Signal Forecast",
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))

pr_V <- fforecast(U = U, groups = groups, h = 30, method = "vector", tol = 10^-3)
plot(pr_V[[1]], mains = "Call Center Mean Component Forecast",
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))
plot(pr_V[[2]], mains = "Call Center First Periodic Component Forecast",
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))
plot(pr_V[[3]], mains = "Call Center Second Periodic Component Forecast",
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))
plot(pr_V[[4]], mains = "Call Center Third Periodic Component Forecast",
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))
plot(Y, mains = c("Call Center Data Line Plot"),
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))
plot(pr_V[[5]], mains = "Call Center Extracted Signal Forecast",
xlabels = "Time (6 minutes aggregated)",
     ylabels = "Sqrt of Call Numbers",type="line",
     xticklabels = list(c("00:00","06:00","12:00","18:00","24:00")),xticklocs =
       list(c(1,60,120,180,240)))

# MFSSA Forecasting
require(Rfssa)
load_github_data("https://github.com/haghbinh/Rfssa/blob/master/data/Jambi.RData")
## Raw image data
NDVI <- Jambi$NDVI
EVI <- Jambi$EVI
time <- Jambi$Date
## Kernel density estimation of pixel intensity
D0_NDVI <- matrix(NA, nrow = 512, ncol = 448)
D0_EVI <- matrix(NA, nrow = 512, ncol = 448)
for (i in 1:448) {
  D0_NDVI[, i] <- density(NDVI[, , i], from = 0, to = 1)$y
  D0_EVI[, i] <- density(EVI[, , i], from = 0, to = 1)$y
}
## Define functional objects
d <- 11
D <- list(D0_NDVI, D0_EVI)
B <- list(list(d, "bspline"),list(d + 4, "fourier"))
U <- list(c(0, 1), c(0, 1))
Y <- Rfssa::fts(D, B, U,time)
plot(Y,mains = c("NDVI","EVI"),xlabels = c("NDVI","EVI"),
     ylabels = c("NDVI Density","EVI Density"),type="line",
     xticklabels = list(c("0","1"),c("0","1")),xticklocs =
       list(c(0,512),c(0,512)))
U <- fssa(Y = Y, L = 45)
groups <- list(c(1:4), c(1), c(2:3), c(4))
pr_R <- fforecast(U = U, groups = groups, h = 1, method = "recurrent")
plot(pr_R[[1]])
plot(pr_R[[2]])
plot(pr_R[[3]])
plot(pr_R[[4]])

pr_V <- fforecast(U = U, groups = groups, h = 1, method = "vector")
plot(pr_V[[1]])
plot(pr_V[[2]])
plot(pr_V[[3]])
plot(pr_V[[4]])
}