Small enhancements

tsmodels · Nov 10, 2024 · 7bf48cc · 7bf48cc
1 parent a30c72c
commit 7bf48cc
Show file tree

Hide file tree

Showing 9 changed files with 59 additions and 9 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: tsgarch
 Type: Package
 Title: Univariate GARCH Models
-Version: 1.0.3
+Version: 1.0.4
 Authors@R: c(person("Alexios", "Galanos", role = c("aut", "cre","cph"), email = "alexios@4dscape.com", comment = c(ORCID = "0009-0000-9308-0457")))
 Maintainer: Alexios Galanos <alexios@4dscape.com>
 Depends: R (>= 3.5.0), methods, tsmethods (>= 1.0.2)

diff --git a/NAMESPACE b/NAMESPACE
@@ -96,6 +96,7 @@ importFrom(lubridate,tz)
 importFrom(lubridate,weeks)
 importFrom(lubridate,years)
 importFrom(nloptr,nloptr)
+importFrom(numDeriv,hessian)
 importFrom(numDeriv,jacobian)
 importFrom(progressr,handlers)
 importFrom(progressr,progressor)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,12 @@
+# tsgarch 1.0.4
+
+* Now returning the series name of the data in the spec object for use in
+multivariate models.
+
+* If the hessian cannot be calculated in the first step for the scaling, then
+a numerical approximation is used instead. There seems to be some instability
+in the egarch-nig model for some datasets.
+
 # tsgarch 1.0.3
 
 * Added the log-likelihood vector to the returned fitted and filtered object

diff --git a/R/estimate.R b/R/estimate.R
@@ -97,8 +97,11 @@ solve_model <- function(init_pars, env, const, lower, upper, control) {
     optimal_pars <- sol$solution
     # check hessian and use for scaling
     H <- tmb$he(optimal_pars)
+    if (any(is.na(H))) {
+        warning("\nunable to calculate hessian for parameter scaling in initial step. Reverting to numerical estimation.")
+        H <- hessian(env$fun, x = optimal_pars, env = env)
+    }
     object$parmatrix <- pmatrix
-
     scaled_solution <- .estimate_garch_model_scaled(optimal_pars, H, object, control, stationarity_constraint)
     D <- solve(diag(scaled_solution$par_scale, length(scaled_solution$par_scale), length(scaled_solution$par_scale)))
     pars <- scaled_solution$solution$solution * scaled_solution$solution$par_scale

diff --git a/R/methods.R b/R/methods.R
@@ -1,3 +1,5 @@
+# estimate ---------------------------------------------------
+
 #' Estimates an GARCH model given a specification object using maximum likelihood and autodiff
 #'
 #' @param object an object of class \dQuote{tsgarch.spec} or \dQuote{tsgarch.multispec}
@@ -67,6 +69,8 @@ estimate.tsgarch.spec <- function(object, solver = "nloptr", control = NULL, sta
     return(out)
 }
 
+# coef ---------------------------------------------------
+
 #' Extract Model Coefficients
 #'
 #' @description Extract the estimated coefficients of a model.
@@ -86,6 +90,8 @@ coef.tsgarch.estimate <- function(object, ...)
     return(out)
 }
 
+# sigma ---------------------------------------------------
+
 #' Extract Volatility (Conditional Standard Deviation)
 #'
 #' @description Extract the conditional standard deviation from a GARCH model.
@@ -125,6 +131,8 @@ sigma.tsgarch.multi_estimate <- function(object, ...)
     return(out)
 }
 
+# fitted ---------------------------------------------------
+
 #' Extract Model Fitted Values
 #'
 #' @description Extract the fitted values of the estimated model.
@@ -164,6 +172,7 @@ fitted.tsgarch.multi_estimate <- function(object, ...)
     return(out)
 }
 
+# residuals ---------------------------------------------------
 
 #' Extract Model Residuals
 #'
@@ -210,6 +219,7 @@ residuals.tsgarch.multi_estimate <- function(object, standardize = FALSE, ...)
     return(out)
 }
 
+# vcov ---------------------------------------------------
 
 #' The Covariance Matrix of the Estimated Parameters
 #'
@@ -252,6 +262,8 @@ vcov.tsgarch.estimate <- function(object, adjust = FALSE, type = c("H","OP","QML
     return(V)
 }
 
+# confidence intervals ---------------------------------------------------
+
 #' Confidence Intervals for Model Parameters
 #'
 #' @param object an object of class tsgarch.estimate.
@@ -298,6 +310,7 @@ confint.tsgarch.estimate <- function(object, parm, level = 0.95, vcov_type = "H"
     return(ci)
 }
 
+# log likelihood ---------------------------------------------------
 
 #' Extract Log-Likelihood
 #'
@@ -323,6 +336,7 @@ logLik.tsgarch.estimate <- function(object, ...)
     return(out)
 }
 
+# summary ---------------------------------------------------
 
 #' GARCH Model Estimation Summary
 #'
@@ -448,6 +462,8 @@ as_flextable.summary.tsgarch.estimate <- function(x, digits = max(3L, getOption(
     return(out)
 }
 
+# equation ---------------------------------------------------
+
 #' Model Equation (LaTeX)
 #'
 #' @description Generates a list of model equations in LaTeX.
@@ -502,6 +518,7 @@ tsequation.tsgarch.estimate <- function(object, ...)
     return(out)
 }
 
+# persistence ---------------------------------------------------
 
 #' Model Persistence
 #'
@@ -550,6 +567,9 @@ persistence.tsgarch.spec <- function(object, ...)
     return(.persistence(pars, env))
 }
 
+
+# unconditional ---------------------------------------------------
+
 #' Unconditional Value
 #'
 #' @description Unconditional value of a GARCH model variance.
@@ -603,6 +623,8 @@ unconditional.tsgarch.spec <- function(object, ...)
     return(out)
 }
 
+# information criteria ---------------------------------------------------
+
 #' Akaike's An Information Criterion
 #'
 #' @description Extract the AIC from an estimated model.
@@ -642,6 +664,8 @@ BIC.tsgarch.estimate <- function(object, ...)
 }
 
 
+# nobs ---------------------------------------------------
+
 #' Extract the Number of Observations
 #'
 #' @description Extract the number of observations from an estimated model.
@@ -661,6 +685,7 @@ nobs.tsgarch.estimate <- function(object, ...)
     return(object$nobs)
 }
 
+# news impact ---------------------------------------------------
 
 #' News Impact Curve
 #'
@@ -720,6 +745,7 @@ plot.tsgarch.newsimpact <- function(x, y = NULL, ...)
     return(invisible(x))
 }
 
+# plots ---------------------------------------------------
 
 #' Estimated Model Plots
 #'
@@ -763,6 +789,7 @@ plot.tsgarch.estimate <- function(x, y = NULL, ...)
     return(invisible(x))
 }
 
+# filtering ---------------------------------------------------
 
 #' Model Filtering
 #'
@@ -812,6 +839,7 @@ tsfilter.tsgarch.spec <- function(object, y = NULL, newxreg = NULL, newvreg = NU
     return(.filter.tsgarch.spec(object, y = y, newxreg = newxreg, newvreg = newvreg))
 }
 
+# predict ---------------------------------------------------
 
 #' Model Prediction
 #'
@@ -877,6 +905,7 @@ predict.tsgarch.estimate <- function(object, h = 1, newxreg = NULL, newvreg = NU
     return(p)
 }
 
+# probability integral transform ---------------------------------------------------
 
 #' Probability Integral Transform (PIT)
 #'
@@ -910,6 +939,7 @@ pit.tsgarch.estimate <- function(object, ...)
     return(p)
 }
 
+# half life ---------------------------------------------------
 
 #' Half Life
 #'
@@ -934,6 +964,9 @@ halflife.tsgarch.estimate <- function(object, ...)
     return(out)
 }
 
+
+# omega ---------------------------------------------------
+
 #' Omega (Variance Equation Intercept)
 #'
 #' @description Returns the intercept of a GARCH model.
@@ -978,6 +1011,8 @@ omega.tsgarch.spec <- function(object, ...)
     return(target_omega)
 }
 
+# simulate ---------------------------------------------------
+
 #' Model Simulation
 #'
 #' @description Simulates paths of a GARCH model.

diff --git a/R/multispec.R b/R/multispec.R
@@ -97,9 +97,6 @@ to_multi_estimate <- function(object, ...)
         invalid_class <- which(!check_class)
         stop(paste0("\nnot all objects in list of class `tsgarch.estimate` :", invalid_class))
     }
-    if (is.null(names(object))) {
-        names(object) <- paste0("series_",1:length(object))
-    }
     anchor_date <- index(fitted(object[[1]]))
     check_dates <- sapply(2:length(object), function(i) all.equal(anchor_date, index(fitted(object[[i]]))))
     attr(object, "index_match") <- TRUE

diff --git a/R/specification.R b/R/specification.R
@@ -49,7 +49,12 @@ garch_modelspec <- function(y, model = "garch", constant = FALSE,
     if  (!is.xts(y)) {
         stop("y must be an xts object")
     }
+    if (NCOL(y) > 1) {
+        stop("y must be a univariate time series")
+    }
+    series_name <- colnames(y)
     spec <- initialize_data(y)
+    spec$target$series_name <- series_name
     # 2. validate arguments
     model <- match.arg(model[1], choices = valid_garch_models())
     distribution <- match.arg(distribution[1], choices = valid_distributions())

diff --git a/R/tsgarch-package.R b/R/tsgarch-package.R
@@ -8,7 +8,7 @@
 #' @importFrom zoo na.fill coredata index is.zoo `coredata<-` as.zoo
 #' @importFrom xts xts as.xts is.xts merge.xts
 #' @importFrom sandwich estfun bwNeweyWest vcovHAC vcovOPG bread
-#' @importFrom numDeriv jacobian
+#' @importFrom numDeriv jacobian hessian
 #' @importFrom nloptr nloptr
 #' @importFrom flextable flextable as_flextable set_caption italic fontsize separate_header add_footer_row add_footer_lines append_chunks as_chunk as_equation as_paragraph compose colformat_double set_header_labels padding bold align autofit hline width
 #' @importFrom graphics grid layout lines par

diff --git a/README.md b/README.md
@@ -1,7 +1,7 @@
 
-[![R-CMD-check](https://github.com/tsmodels/tsgarch/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/tsmodels/tsgarch/actions/workflows/R-CMD-check.yaml)
-[![Last-changedate](https://img.shields.io/badge/last%20change-2024--09--22-yellowgreen.svg)](/commits/master)
-[![packageversion](https://img.shields.io/badge/Package%20version-1.0.3-orange.svg?style=flat-square)](commits/master)
+[![R-CMD-check](https://github.com/tsmodels/tsgarch/actions/workflows/rcmdcheck.yaml/badge.svg)](https://github.com/tsmodels/tsgarch/actions/workflows/rcmdcheck.yaml)
+[![Last-changedate](https://img.shields.io/badge/last%20change-2024--11--10-yellowgreen.svg)](/commits/master)
+[![packageversion](https://img.shields.io/badge/Package%20version-1.0.4-orange.svg?style=flat-square)](commits/master)
 [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/tsgarch)](https://cran.r-project.org/package=tsgarch)
 
 # tsgarch