fHMM/sandbox.R at master · timoadam/fHMM · 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
108
109
110
111
112
113
114
115
116
### load code ---------------------------------------------------------------
rm(list = ls())
library(magrittr)
devtools::load_all()
#install.packages("../fHMM_1.0.2.tar.gz", repos = NULL, type = "source", INSTALL_opts = c('--no-lock'))

### download data -----------------------------------------------------------
download_data(symbol = "^GDAXI", from = "2000-01-01", to = Sys.Date(),
              file = tempfile())

### simulated HMM -----------------------------------------------------------
seed <- 1
controls = list(
  states  = 2,
  sdds    = "gamma",
  horizon = 1000,
  fit     = list("runs" = 100)
)
controls %<>% set_controls
data <- prepare_data(controls, seed = seed)
data %>% summary
data %>% plot
model <- fit_model(data, ncluster = 7, seed = seed) %>%
  decode_states %>%
  compute_residuals
summary(model)
model %<>% reorder_states(state_order = 1:2)
compare_models(model)
model %>% plot("ll")
model %>% plot("sdds")
model %>% plot("pr")
model %>% plot("ts")
model %>% predict(ahead = 10)

### empirical HMM -----------------------------------------------------------
seed <- 1
controls = list(
  states = 3,
  sdds   = "t",
  data   = list(file        = "inst/extdata/dax.csv",
                date_column = "Date",
                data_column = "Close",
                logreturns  = TRUE,
                from        = "2015-01-01"),
  fit    = list("runs" = 14)
)
controls %<>% set_controls
data <- prepare_data(controls)
summary(data)
events <- list(dates = c("2001-09-11", "2008-09-15", "2020-01-27"),
               labels = c("9/11 terrorist attack", "Bankruptcy Lehman Brothers",
                          "First COVID-19 case Germany")) %>% fHMM_events
plot(data, events)
model <- fit_model(data, ncluster = 7, seed = seed) %>%
  decode_states %>%
  compute_residuals
summary(model)
model %>% plot("ll")
model %>% plot("sdds")
model %<>% reorder_states(state_order = c(3,1,2))
model %>% plot("pr")
model %>% plot("ts", events = events)
model %>% predict(ahead = 10)

### simulated HHMM ----------------------------------------------------------
seed <- 1
controls <- list(
  hierarchy = TRUE,
  states    = c(2,2),
  sdds      = c("t(sigma = 0.1, df = Inf)",
                "gamma(sigma = 0.1)"),
  horizon   = c(50,10),
  fit       = list("runs" = 7)
)
controls %<>% set_controls
data <- prepare_data(controls, seed = seed)
summary(data)
plot(data)
model <- fit_model(data, ncluster = 7) %>%
  decode_states %>%
  compute_residuals
summary(model)
compare_models(model)
model %>% plot("ll")
model %>% plot("sdds")
model %<>% reorder_states(state_order = matrix(c(1,2,1,2,2,1),2,3))
model %>% plot("pr")
model %>% plot("ts")
model %>% predict(ahead = 10)

### empirical HHMM ----------------------------------------------------------
seed <- 1
controls <- list(
  hierarchy = TRUE,
  states    = c(2,2),
  sdds      = c("t(df = 1)", "t(df = 1)"),
  period    = "m",
  data      = list(file = c("inst/extdata/dax.csv", "inst/extdata/vw.csv"),
                   from = "2010-01-01",
                   to = "2020-01-01",
                   logreturns = c(TRUE,TRUE)),
  fit       = list("runs" = 100)
)
controls <- set_controls(controls)
data <- prepare_data(controls)
plot(data)
model <- fit_model(data, ncluster = 7, seed = seed) %>%
  decode_states %>%
  compute_residuals
summary(model)
compare_models(model)
model %>% plot("ll")
model %>% plot("sdds")
model %>% plot("pr")
model %>% plot("ts", events = events)
model %>% predict(ahead = 10)