Fixed !93 (#94)

* Fixed a bug around the `period` control.

* Fixed date conversion to `character()`.

* refitted models

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: fHMM
 Type: Package
 Title: Fitting Hidden Markov Models to Financial Data
-Version: 1.3.1
+Version: 1.4.0
 Authors@R: c(
     person(given = "Lennart",
            family = "Oelschl\U00E4ger",

NEWS.md

@@ -1,3 +1,9 @@
+# fHMM 1.4.0
+
+* Fixed a bug around the `period` control (#93, thanks to @dongsen86).
+
+* Fixed date conversion to `character()` (thanks to Hee-Young Kim).
+
 # fHMM 1.3.1
 
 * Added citation to JSS paper in DESCRIPTION.

R/data_and_models.R

@@ -25,9 +25,6 @@
 #'   \item \code{Volume}: Trade volume.
 #' }
 #' 
-# #' @source 
-# #' <https://finance.yahoo.com/quote/%5EGSPC>
-#' 
 #' @keywords data
 "spx"
 
@@ -45,10 +42,6 @@
 #'   to = "2022-12-31"    # last observation
 #' )
 #' }
-#' The data is also available as \code{.csv} file via:
-#' \preformatted{
-#' system.file("extdata", "dax.csv", package = "fHMM")
-#' }
 #' 
 #' @format A \code{data.frame} with 9012 rows and the following 7 columns:
 #' \itemize{
@@ -61,9 +54,6 @@
 #'   \item \code{Volume}: Trade volume.
 #' }
 #' 
-# #' @source 
-# #' <https://finance.yahoo.com/quote/%5EGDAXI>
-#' 
 #' @keywords data
 "dax"
 
@@ -93,9 +83,6 @@
 #'   \item \code{Volume}: Trade volume.
 #' }
 #' 
-# #' @source 
-# #' <https://finance.yahoo.com/quote/VOW3.DE>
-#' 
 #' @keywords data
 "vw"
 
@@ -134,17 +121,17 @@
 #' The model was estimated via:
 #' \preformatted{
 #' controls <- set_controls(
-#' states = 2,
-#' sdds   = "normal",
-#' data   = list(
-#'   file        = dax,
-#'   date_column = "Date",
-#'   data_column = "Close",
-#'   logreturns  = TRUE,
-#'   from        = "2000-01-03",
-#'   to          = "2022-12-31"
-#' ),
-#' fit    = list("runs" = 10, "gradtol" = 1e-6, "steptol" = 1e-6)
+#'   states = 2,
+#'   sdds   = "normal",
+#'   data   = list(
+#'     file        = dax,
+#'     date_column = "Date",
+#'     data_column = "Close",
+#'     logreturns  = TRUE,
+#'     from        = "2000-01-03",
+#'     to          = "2022-12-31"
+#'   ),
+#'   fit    = list("runs" = 10, "gradtol" = 1e-6, "steptol" = 1e-6)
 #' )
 #' dax_data <- prepare_data(controls)
 #' dax_model_2n <- fit_model(dax_data, seed = 1)
@@ -255,28 +242,21 @@
 #' @details
 #' The model was estimated via:
 #' \preformatted{
-#' controls <- set_controls(
-#'  hierarchy = TRUE,
-#'  states    = c(3, 2),
-#'  sdds      = c("t", "t"),
-#'  period    = "m",
-#'  data      = list(
-#'    file        = list(unemp, spx),
-#'    date_column = c("date", "Date"),
-#'    data_column = c("rate_diff", "Close"),
-#'    from        = "1970-01-01",
-#'    to          = "2020-01-01",
-#'    logreturns  = c(FALSE, TRUE)
-#'  ),
-#'  fit       = list(
-#'    runs        = 50, 
-#'    iterlim     = 1000,
-#'    gradtol     = 1e-6,
-#'    steptol     = 1e-6
-#'  )
-#')
+#' controls <- list(
+#'   hierarchy = TRUE, states = c(3, 2), 
+#'   sdds = c("t", "t"), period = "m",
+#'   data = list(
+#'     file = list(unemp, spx), 
+#'     data_column = c("rate_diff", "Close"), 
+#'     date_column = c("date", "Date"), 
+#'     from = "1970-01-01", to = "2020-01-01", 
+#'     logreturns = c(FALSE, TRUE)
+#'   ),
+#'   fit = list(runs = 50, iterlim = 1000, gradtol = 1e-6, steptol = 1e-6)
+#' )
+#' controls <- set_controls(controls)
 #' unemp_spx_data <- prepare_data(controls)
-#' unemp_spx_model_3_2 <- fit_model(unemp_spx_data, seed = 1, ncluster = 25)
+#' unemp_spx_model_3_2 <- fit_model(unemp_spx_data, seed = 1, ncluster = 10)
 #' unemp_spx_model_3_2 <- decode_states(unemp_spx_model_3_2)
 #' unemp_spx_model_3_2 <- compute_residuals(unemp_spx_model_3_2)
 #' summary(unemp_spx_model_3_2)

R/fHMM_controls.R

@@ -89,7 +89,7 @@
 #' available data.
 #'
 #' @param period
-#' Only relevant if \code{hierarchy = TRUE} and \code{horizon[2] = NA}.
+#' Only relevant if \code{hierarchy = TRUE}.
 #' 
 #' In this case, a \code{character} which specifies a flexible, periodic 
 #' fine-scale time horizon and can be one of
@@ -100,8 +100,8 @@
 #'   \item \code{"y"} for a year.
 #' } 
 #' 
-#' By default, \code{period = "m"} if \code{hierarchy = TRUE} and 
-#' \code{horizon[2] = NA}, and \code{NA} else.
+#' By default, \code{period = NA}. If \code{period} is not \code{NA}, it
+#' overrules \code{horizon[2]}.
 #'
 #' @param data
 #' Either \code{NA}, in which case data is simulated (the default), or a 
@@ -316,7 +316,7 @@ set_controls <- function(
     states = if (!hierarchy) 2 else c(2, 2), 
     sdds = if (!hierarchy) "normal" else c("normal", "normal"), 
     horizon = if (!hierarchy) 100 else c(100, 30),
-    period = if (hierarchy && is.na(horizon[2])) "m" else NA, 
+    period = NA, 
     data = NA,
     file = NA, 
     date_column = if (!hierarchy) "Date" else c("Date", "Date"), 
@@ -459,7 +459,7 @@ set_controls <- function(
   if (!"period" %in% names(controls)) {
     controls[["period"]] <- period
   }
-  
+
   ### set missing 'data' controls
   if (!"data" %in% names(controls)) {
     controls[["data"]] <- data
@@ -644,16 +644,14 @@ validate_controls <- function(controls) {
         )
       }
     }
-    if (!is.na(controls[["horizon"]][2])) {
-      controls[["period"]] <- NA_character_
-    }
     if (!is.na(controls[["period"]])) {
       if (!controls[["period"]] %in% c("w", "m", "q", "y")) {
         stop(
           "The control 'period' must be one of 'w', 'm', 'q', 'y'.",
           call. = FALSE
         )
       }
+      controls[["horizon"]][2] <- NA_integer_
     }
   } else {
     if (!simulated) {

R/get_initial_values.R

@@ -152,7 +152,7 @@ get_initial_values <- function(
 
     ### cluster data
     cluster <- stats::kmeans(
-      data, centers = states, iter.max = 100, nstart = 100
+      data[!is.na(data)], centers = states, iter.max = 100, nstart = 100
     )$cluster
 
     ### set tpm with state persistence

R/read_data.R

@@ -56,6 +56,15 @@ read_data <- function(controls) {
       data_raw[[i]] <- data_raw[[i]][!is.na(data_raw[[i]][[date_column[i]]]), ]
     }
   }
+
+  ### transform dates to characters
+  for (i in 1:ifelse(controls[["hierarchy"]], 2, 1)) {
+    if (!is.na(date_column[i])) {
+      data_raw[[i]][[date_column[i]]] <- as.character(
+        oeli::check_date(data_raw[[i]][[date_column[i]]])
+      )
+    }
+  }
 
   ### replace NA values by neighbor means
   for (i in 1:ifelse(controls[["hierarchy"]], 2, 1)) {

R/simulate_hmm.R

@@ -30,7 +30,7 @@ simulate_hmm <- function(
     states = if (!hierarchy) 2 else c(2, 2), 
     sdds = if (!hierarchy) "normal" else c("normal", "normal"), 
     horizon = if (!hierarchy) 100 else c(100, 30),
-    period = if (hierarchy && is.na(horizon[2])) "m" else NA, 
+    period = NA, 
     true_parameters = fHMM_parameters(
       controls = controls, hierarchy = hierarchy, states = states, sdds = sdds
     ), 

README.md

@@ -133,20 +133,20 @@ summary(model)
 #> 
 #> Estimates:
 #>                   lb   estimate        ub
-#> Gamma_2.1  2.747e-03  5.024e-03 9.133e-03
-#> Gamma_3.1  2.080e-13  2.060e-13 2.029e-13
-#> Gamma_1.2  1.006e-02  1.839e-02 3.337e-02
-#> Gamma_3.2  1.516e-02  2.446e-02 3.924e-02
-#> Gamma_1.3  2.250e-11  2.232e-11 2.198e-11
-#> Gamma_2.3  1.195e-02  1.898e-02 2.995e-02
+#> Gamma_2.1  2.754e-03  5.024e-03 9.110e-03
+#> Gamma_3.1  2.808e-16  2.781e-16 2.739e-16
+#> Gamma_1.2  1.006e-02  1.839e-02 3.338e-02
+#> Gamma_3.2  1.514e-02  2.446e-02 3.927e-02
+#> Gamma_1.3  5.596e-17  5.549e-17 5.464e-17
+#> Gamma_2.3  1.196e-02  1.898e-02 2.993e-02
 #> mu_1      -3.862e-03 -1.793e-03 2.754e-04
 #> mu_2      -7.994e-04 -2.649e-04 2.696e-04
 #> mu_3       9.642e-04  1.272e-03 1.579e-03
 #> sigma_1    2.354e-02  2.586e-02 2.840e-02
-#> sigma_2    1.226e-02  1.300e-02 1.380e-02
+#> sigma_2    1.225e-02  1.300e-02 1.380e-02
 #> sigma_3    5.390e-03  5.833e-03 6.312e-03
-#> df_1       5.551e+00  1.084e+01 2.115e+01
-#> df_2       6.814e+00  4.866e+01 3.475e+02
+#> df_1       5.550e+00  1.084e+01 2.116e+01
+#> df_2       6.785e+00  4.866e+01 3.489e+02
 #> df_3       3.973e+00  5.248e+00 6.934e+00
 #> 
 #> States:
@@ -156,7 +156,7 @@ summary(model)
 #> 
 #> Residuals:
 #>      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
-#> -3.517897 -0.664017  0.012171 -0.003261  0.673180  3.693577
+#> -3.517900 -0.664018  0.012170 -0.003262  0.673180  3.693568
 ```
 
 Having estimated the model, we can visualize the state-dependent
@@ -262,7 +262,7 @@ optimization <- nlm(
 )
 
 (estimate <- optimization$estimate)
-#> [1] -3.4633918 -3.4406564  0.0599985  1.0645290  0.1151781  1.0794625
+#> [1] -3.46338992 -3.44065582  0.05999848  1.06452907  0.11517811  1.07946252
 ```
 
 6.  To interpret the estimate, it needs to be back transformed to the
@@ -282,8 +282,8 @@ par$Gamma
 ``` r
 estimate$Gamma
 #>            state_1    state_2
-#> state_1 0.96895127 0.03104873
-#> state_2 0.03037199 0.96962801
+#> state_1 0.96895125 0.03104875
+#> state_2 0.03037204 0.96962796
 ```
 
 ``` r