nnFTS/README.Rmd at master · aefdz/nnFTS · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
---
title: "On Projection Methods for Functional Time Series Forecasting"
author: "Antonio Elías"
date: "20/01/2020"
output:
  md_document:
    variant: markdown_github
---

```{r setup, include=FALSE, message = FALSE, warning = FALSE, fig.asp = 0.5, fig.align = 'center'}
knitr::opts_chunk$set(echo = TRUE)

devtools::install_github("aefdz/nnFTS", dep = FALSE)
library("nnFTS")
```

[![License](https://img.shields.io/badge/license-GPL%20v3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0)

On Projection Methods for Functional Time Series Forecasting
===========

## Enveloping without prediction or forecasting
```{r, message = FALSE}
data(sinedata)
focal <- '1'
dist <- 'l2' # dist<-'supremum'
plot <- TRUE

resultsBand <- envelope(sinedata, focal, dist, plot)
resultsBand #Envelope
```

## Curve Extension
```{r, message = FALSE}
kcurves <- 10 # number of curves of the envelope involved in the band

dataPartially <- rainbow::fds(sinedata$x[1:25], sinedata$y[1:25,])
results <- envelope(dataPartially, focal, dist, plot = FALSE)

pl <- plotBand(sinedata, focal, results$Jordered, kcurves, cut = 25)
```

## To explore different values of cut and kcurves (only running in Rstudio)

```{r, eval = FALSE}
manipulate(
  {
  plotBand(sinedata, focal, results$Jordered, kcurves)
  },
  kcurves = slider(min = 1, max = length(results$Jordered), step = 1, ticks = TRUE),
  cut = slider(1, 99, initial = 50, step = 1)
)
```

## Spanish Electricity Demand Example

### Envelope forecast
```{r, eval = TRUE}
data(electricityDemand)
focal <- "saturday/29/12/2018"
data <- rainbow::fts(electricityDemand$x, electricityDemand$y[,1:1825])
point <- envelope.forecast(data, focal, h = 1, distance = "l2", typePoint = "expw", theta = 1)

plot(data, col = "grey50")
lines(data$x, point, col = "red")
lines(electricityDemand$x, electricityDemand$y[,"sunday/30/12/2018"], col = "blue")
```

```{r, eval = TRUE}
data(electricityDemand)
# DU half day
focal <- "monday/31/12/2018"
data <- electricityDemand
data$y[72:144, focal] <- NA
point <- envelope.forecast(data, focal, h = 1, distance = "l2", typePoint = "expw", theta = 1)

plot(data, col = "grey50")
lines(data$x, point, col = "red")
lines(data$x, electricityDemand$y[,"monday/31/12/2018"], col = "blue")
abline(v = data$x[72])
```

### Functional kNearest neighbour forecast
```{r, eval = TRUE}
data(electricityDemand)
focal <- "saturday/29/12/2018"
data <- rainbow::fts(electricityDemand$x, electricityDemand$y[,1:1825])
point <- fknn.forecast(data, focal, k = 3, h = 1, distance = "l2", typePoint = "expw", theta = 1)

plot(data, col = "grey50")
lines(data$x, point, col = "red")
lines(electricityDemand$x, electricityDemand$y[,"sunday/30/12/2018"], col = "blue")
```

```{r, eval = TRUE}
data(electricityDemand)
# DU half day
focal <- "monday/31/12/2018"
data <- electricityDemand
data$y[72:144, focal] <- NA
point <- fknn.forecast(data, focal, k = 3, h = 1, distance = "l2", typePoint = "expw", theta = 1)

plot(data, col = "grey50")
lines(data$x, point, col = "red")
lines(data$x, electricityDemand$y[,"monday/31/12/2018"], col = "blue")
abline(v = data$x[72])
```