## ----download dax data, eval = TRUE-------------------------------------------
library("fHMM")
library("dplyr")
dax <- download_data(symbol = "^GDAXI", from = "1990-01-01", to = "2020-01-01") %>%
  as_tibble() %>%
  reframe(
    date = as.Date(Date, format = "%Y-%m-%d"),
    logreturn = c(NA, diff(log(Close), lag = 1))
  ) %>%
  filter(!is.na(logreturn)) %>%
  print()

## ----plot-dax-data, eval = TRUE-----------------------------------------------
library("ggplot2")
ggplot(dax, aes(x = date, y = logreturn)) +
  geom_point() +
  geom_line() +
  scale_x_date() +
  scale_y_continuous(labels = scales::label_percent())

## ----define ino object--------------------------------------------------------
# Nop_hmm <- Nop$new(
#   f = fHMM::ll_hmm,
#   npar = 6,
#   observations = dax$logreturn,
#   sdds = "normal",
#   states = 2,
#   negative = TRUE
# )

## ----set optimizer------------------------------------------------------------
# Nop_hmm$set_optimizer(optimizeR::Optimizer$new("stats::nlm"))

## ----parallel setting---------------------------------------------------------
# future::plan(future::multisession, workers = 10)

## ----progress setting---------------------------------------------------------
# progressr::handlers(global = TRUE)

## ----random initialization----------------------------------------------------
# Nop_hmm$
#   initialize_random(runs = 100)$
#   optimize(optimization_label = "random_naive")

## ----initialization sampler---------------------------------------------------
# sampler <- function() {
#   c(stats::runif(2, -2, -1), stats::rnorm(2), log(stats::runif(2, 0.5, 2)))
# }

## ----sampler initialization---------------------------------------------------
# Nop_hmm$
#   initialize_random(sampler = sampler, runs = 100)$
#   optimize(optimization_label = "random")

## ----optimization of educated guesses-----------------------------------------
# Nop_hmm$
#   initialize_grid(
#     lower = c(-2, -2, -0.1, -0.1, log(0.1), log(0.1)),
#     upper = c(-1, -1, 0.1, 0.1, log(1), log(1)),
#     breaks = 2
#   )$
#   optimize(optimization_label = "educated_guess")

## ----subset initialization----------------------------------------------------
# Nop_hmm$
#   reduce_argument("observations", how = "first", proportion = 0.25)$
#   initialize_random(sampler = sampler, runs = 100)$
#   optimize(optimization_label = "reduced")$
#   fixed_argument("reset", argument_name = "observations")$
#   initialize_continue("reduced")$
#   optimize(optimization_label = "initialized_reduced")

## ----standardize initialization 1---------------------------------------------
# Nop_hmm$standardize_argument("observations")

## ----standardize initialization values----------------------------------------
# observations <- Nop_hmm$fixed_argument("get", argument_name = "observations")
# (center <- attr(observations, "center"))
# (scale <- attr(observations, "scale"))

## ----standardize initialization 2---------------------------------------------
# Nop_hmm$
#   initialize_random(sampler = sampler, runs = 100)$
#   optimize(optimization_label = "standardized")$
#   fixed_argument(action = "reset", argument_name = "observations")

## ----transform----------------------------------------------------------------
# transform <- function(x) {
#   c(x[1:2], x[3:4] * scale + center, log(exp(x[3:4]) * scale + center))
# }

## ----overview of optima, eval = TRUE------------------------------------------
Nop_hmm$optima(sort_by_value = TRUE, digits = 0)

## ----get number of converged runs, include = FALSE, eval = TRUE---------------
optima <- Nop_hmm$optima(sort_by_value = TRUE, digits = 0)
global <- optima |> arrange(value) |> slice(1) |> pull(n)
total <- sum(optima$n)
local <- total - global

## ----summary of results, eval = TRUE------------------------------------------
Nop_hmm$results |> select(value, parameter, seconds)

## ----best parameter, eval = TRUE----------------------------------------------
Nop_hmm$minimum

## ----proportion of converged runs, eval = TRUE--------------------------------
Nop_hmm$results |> 
  filter(.original) |>
  mutate(global_optimum = value < -22445) |>
  group_by(.optimization_label) |>
  summarise(proportion = mean(global_optimum, na.rm = TRUE))

## ----optimization-time, eval = TRUE-------------------------------------------
Nop_hmm$results |> autoplot(group_by = "optimization")

## ----summary statistics, eval = TRUE------------------------------------------
Nop_hmm$results |>
  group_by(.optimization_label) %>%
  summarise(
    median_seconds = median(seconds, na.rm = TRUE),
    sd_seconds = sd(seconds, na.rm = TRUE)
  ) %>%
  arrange(median_seconds)

