Skip to content

Commit

Permalink
version 1.4.2
Browse files Browse the repository at this point in the history
  • Loading branch information
@cran-robot
Markus J. Fülle authored and cran-robot committed Mar 20, 2023
1 parent b035a82 commit 57275e1
Show file tree
Hide file tree
Showing 15 changed files with 173 additions and 145 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
View file
@@ -1,6 +1,6 @@
Package: BEKKs
Title: Multivariate Conditional Volatility Modelling and Forecasting
Version: 1.4.1
Version: 1.4.2
Author: Markus J. Fülle [aut, cre],
Alexander Lange [aut],
Christian M. Hafner [aut],
Expand All @@ -27,13 +27,13 @@ Imports: Rcpp, reshape2, ggplot2, mathjaxr, gridExtra, grid, ggfortify,
lubridate, utils, pbapply, numDeriv, moments
LinkingTo: Rcpp, RcppArmadillo
NeedsCompilation: yes
SystemRequirements: C++11
SystemRequirements: C++17
License: MIT + file LICENSE
Encoding: UTF-8
LazyData: true
Suggests: testthat (>= 2.1.0)
RdMacros: mathjaxr
RoxygenNote: 7.1.2
Packaged: 2022-12-16 23:52:54 UTC; Markus
Packaged: 2023-03-20 18:10:58 UTC; Markus
Repository: CRAN
Date/Publication: 2022-12-18 16:40:14 UTC
Date/Publication: 2023-03-20 18:30:02 UTC
28 changes: 14 additions & 14 deletions MD5
View file
@@ -1,13 +1,13 @@
9a5937ffde1e11e72515fc1680ff449c *DESCRIPTION
421f9e6fc6d5b6837d0325d888adbf73 *DESCRIPTION
fdd9e3011159a1dd8e133cd4d66fe902 *LICENSE
ce0cc3dae598876d0ef733d7bf8791c1 *NAMESPACE
24125a47a448a49be316bb017abc016e *NAMESPACE
fd764fc77faaaf459e7b881978a7f355 *R/BEKKs.R
2bf5a8fe459176e6c91f4c91303d95be *R/Portmanteau_test.R
130075140b16127630a7b7cb4c0be1fb *R/Portmanteau_test.R
f0a2f5305f00c850c722e3bcd122fea9 *R/RcppExports.R
09ef86cbc81ec7a96c3f05d4c47f4515 *R/VaR.R
36058398f953b038b0826bb6ce509c52 *R/backtest.R
93b643c7d020cd84d0a7ea0d465f0da3 *R/bekk_fit.R
015754d3c18612d1a341d09570152f6e *R/bekk_fit_methods.R
02c97e2f5f3094f91509eda98170e3a2 *R/bekk_fit.R
02d105e2da1ffb2f4730319d5ef6bc2b *R/bekk_fit_methods.R
dba615b18ec8c50c4ea334a0d8768fc5 *R/bekk_forecast.R
08f74435b73e5cc04fb6aba6799ddfa2 *R/bekk_functions.R
92480aa8712e1746ce098bf49d2c2779 *R/bekk_mc_eval.R
Expand All @@ -25,7 +25,7 @@ bb2d60ac1d45f363e31812a77c5f3d26 *R/plot.virf.R
b2637e851cd7a0c769b8304a4365042f *R/summary.var.R
c27973819a419c73a8c9fd021470929d *R/virf.R
2580ad453157da7cf1b8323040fac617 *R/zzz.R
2f6e66f2950ce0496b8cb7b097d63965 *build/BEKKs.pdf
18c77a61515e16e97892ccdf6cc24790 *build/BEKKs.pdf
68d30c6d85e802243b39a8a862993c1f *data/GoldStocksBonds.RData
3bf0bc324b5f877e8f3599dcc4f5bf42 *data/StocksBonds.RData
e9fba967f9a3fd4d4715d0a15ae3905d *man/BEKKs.Rd
Expand All @@ -34,7 +34,7 @@ dbed8e39f4d5a010e35f8479597c6809 *man/StocksBonds.Rd
ad71518946df0c202cac58919165be50 *man/VaR.Rd
60345284df78c4a9768938bb5add9277 *man/backtest.Rd
2d3946dd1cc8eac394201f622c6e27f8 *man/bekk_fit.Rd
2ab5d64bb7db7b1331b639ad9420e2b0 *man/bekk_fit_methods.Rd
09d50c1d26edf0566c40689f1519a12c *man/bekk_fit_methods.Rd
80e38079c08f1700c27cc2a2f4d72324 *man/bekk_spec.Rd
378c26d3c6458f053d3216b36b3c04b4 *man/figures/Data.png
c0e9ee41c69cae8a8a9ca62ea08fa860 *man/figures/VaR_in_sample.png
Expand All @@ -48,15 +48,15 @@ a736e5bf5d404d2e996cb3671d0d9a69 *man/figures/flow.png
0e9e1b73585d41fc6ac69e5a41840df2 *man/predict.Rd
ff61f9ddad31a9cfbcd92c03f284f43d *man/simulate.Rd
fbddc440819a7af8a088cf6679eaf3d4 *man/virf.Rd
59fb4c82277b964cc55ac446729321d7 *src/BekkFunctions.cpp
306122ad3fa2fb204bedaaa42cd10040 *src/BekkSim.cpp
68c9372eecfff74b2e6a839ab30c7f93 *src/IndicatorFunction.cpp
756062a5215768530327bf49fada2151 *src/BekkFunctions.cpp
d943d6e9b60d27763ef39b0161ede967 *src/BekkSim.cpp
de391382b4a8770ee44481768521ccb9 *src/IndicatorFunction.cpp
f01bd691a1a206830ea554d89cc95ec5 *src/IndicatorFunctions.h
13b03cd3dd721948c30479759060bb49 *src/Makevars
61059660eb073d93e00e8ee054237071 *src/Makevars.win
347e713ef8e6a269f073f40532d36628 *src/Makevars
347e713ef8e6a269f073f40532d36628 *src/Makevars.win
c83c039c6bd0bd648e148d465f799e07 *src/RcppExports.cpp
9843a0fdb066931328c0ed1c68d17f62 *src/ScalarBEKK.cpp
e45bd677c8bfde56158f2d2c74c6ffe1 *src/YLagCr.cpp
874a913d88b9517ee68d0b3968079569 *src/ScalarBEKK.cpp
0649a003933eb16d7693bb04e4582808 *src/YLagCr.cpp
dfb30b063a47bb527010c9a1f347290c *tests/testthat.R
d0b997c98c8762ed4d004c9e16995f46 *tests/testthat/test-Grid_Search.R
9fc5581b95d0b182c34e2abba8c58e87 *tests/testthat/test-asymmetric_grid_search.R
Expand Down
2 changes: 0 additions & 2 deletions NAMESPACE
View file
@@ -1,7 +1,5 @@
# Generated by roxygen2: do not edit by hand

S3method(AIC,bekkFit)
S3method(BIC,bekkFit)
S3method(VaR,bekkFit)
S3method(VaR,bekkForecast)
S3method(backtest,bekkFit)
Expand Down
4 changes: 2 additions & 2 deletions R/Portmanteau_test.R
View file
Expand Up @@ -45,8 +45,8 @@ portmanteau.test.bekkFit <- function(x, lags = 5){
return(c/n)
}
c_0 = c_hat(0)
c_0_inv = solve(c_0)

#c_0_inv = solve(c_0)
c_0_inv = chol2inv(chol(c_0))
Q <- function(lgs){
q=0
for(i in 1:lgs){
Expand Down
25 changes: 12 additions & 13 deletions R/bekk_fit.R
View file
Expand Up @@ -226,9 +226,8 @@ bekk_fit.bekk <- function(spec, data, QML_t_ratios = FALSE,
spec = spec,
QML_t_ratios = QML_t_ratios)
class(result) <- c('bekkFit', 'bekk')

result$AIC <- AIC(result)
result$BIC <- BIC(result)
result$AIC <- logLik(result)$AIC
result$BIC <- logLik(result)$BIC
result$Portmanteau.test <- portmanteau.test(result, lags = 5)

return(result)
Expand Down Expand Up @@ -390,8 +389,8 @@ bekk_fit.bekka <- function(spec, data, QML_t_ratios = FALSE,
QML_t_ratios = QML_t_ratios)
class(result) <- c('bekkFit', 'bekka')

result$AIC <- AIC(result)
result$BIC <- BIC(result)
result$AIC <- AIC(result)$AIC
result$BIC <- BIC(result)$BIC
result$Portmanteau.test <- portmanteau.test(result, lags = 5)

return(result)
Expand Down Expand Up @@ -507,8 +506,8 @@ bekk_fit.dbekk <- function(spec, data, QML_t_ratios = FALSE,
QML_t_ratios = QML_t_ratios)
class(result) <- c('bekkFit', 'dbekk')

result$AIC <- AIC(result)
result$BIC <- BIC(result)
result$AIC <- AIC(result)$AIC
result$BIC <- BIC(result)$BIC
result$Portmanteau.test <- portmanteau.test(result, lags = 5)

return(result)
Expand Down Expand Up @@ -633,8 +632,8 @@ bekk_fit.dbekka <- function(spec, data, QML_t_ratios = FALSE,
QML_t_ratios = QML_t_ratios)
class(result) <- c('bekkFit', 'dbekka')

result$AIC <- AIC(result)
result$BIC <- BIC(result)
result$AIC <- AIC(result)$AIC
result$BIC <- BIC(result)$BIC
result$Portmanteau.test <- portmanteau.test(result, lags = 5)

return(result)
Expand Down Expand Up @@ -750,8 +749,8 @@ bekk_fit.sbekk <- function(spec, data, QML_t_ratios = FALSE,
QML_t_ratios = QML_t_ratios)
class(result) <- c('bekkFit', 'sbekk')

result$AIC <- AIC(result)
result$BIC <- BIC(result)
result$AIC <- AIC(result)$AIC
result$BIC <- BIC(result)$BIC
result$Portmanteau.test <- portmanteau.test(result, lags = 5)

return(result)
Expand Down Expand Up @@ -875,8 +874,8 @@ bekk_fit.sbekka <- function(spec, data, QML_t_ratios = FALSE,
QML_t_ratios = QML_t_ratios)
class(result) <- c('bekkFit', 'sbekka')

result$AIC <- AIC(result)
result$BIC <- BIC(result)
result$AIC <- AIC(result)$AIC
result$BIC <- BIC(result)$BIC
result$Portmanteau.test <- portmanteau.test(result, lags = 5)

return(result)
Expand Down
140 changes: 84 additions & 56 deletions R/bekk_fit_methods.R
View file
Expand Up @@ -4,7 +4,7 @@
#'
#' @param x An object of class "bekkFit" from function \link{bekk_fit}.
#' @param object An object of class "bekkFit" from function \link{bekk_fit}.
#' @param k Numeric value, the penalty per parameter to be used; the default k = 2 is the classical AIC.
#' @param k Numeric value, the penalty per parameter for AIC to be used; the default k = 2 is the classical AIC.
#' @param ... Further arguments to be passed to and from other methods.
#'
#' @examples
Expand All @@ -16,68 +16,29 @@
#' obj_spec <- bekk_spec()
#' x1 <- bekk_fit(obj_spec, StocksBonds, QML_t_ratios = FALSE, max_iter = 50, crit = 1e-9)
#'
#' AIC(x1)
#' logLik(x1)
#' }
#' @import xts
#' @import stats

#' @rdname bekk_fit_methods
#' @export
logLik.bekkFit <- function(object, ...) {


llv_inner <- function(x){
if (any(class(x) == 'bekk')) {
logl <- loglike_bekk(x$theta, x$data)
} else if (any(class(x) == 'bekka')) {
logl <- loglike_asymm_bekk(x$theta, x$data, x$signs)
} else if (any(class(x) == 'sbekk')) {
logl <- loglike_sbekk(x$theta, x$data)
} else if (any(class(x) == 'sbekka')) {
logl <- loglike_asymm_sbekk(x$theta, x$data, x$signs)
}else if (any(class(x) == 'dbekk')) {
logl <- loglike_dbekk(x$theta, x$data)
} else if (any(class(x) == 'dbekka')) {
logl <- loglike_asymm_dbekk(x$theta, x$data, x$signs)
}

return(logl)

}

if(!missing(...)) {# several objects: produce data.frame
lls <- sapply(list(object, ...), llv_inner)
vals <- sapply(list(object, ...), function(e1){length(e1$theta)})
aic <- data.frame(df = vals, LLV = lls, AIC = AIC(object, ...)$AIC, BIC = BIC(object, ...)$BIC)
} else {
lls <- llv_inner(object)
#aic <- data.frame(df = length(object$theta), LLV = lls, AIC = AIC(object), BIC = BIC(object))
aic <- lls

}
return(aic)
}

#' @rdname bekk_fit_methods
#' @export
AIC.bekkFit <- function(object, ..., k = 2) {

x <- object

AICinner <- function(e) {
N <- ncol(e$data)
if (any(class(e) == 'bekk')) {
aic <- k * 2 * N^2 + N * (N + 1)/2 - 2 * logLik(e)
aic <- k * 2 * N^2 + N * (N + 1)/2 - 2 * llv(e)
} else if (any(class(e) == 'bekka')) {
aic <- k * 3 * N^2 + N * (N + 1)/2 - 2 * logLik(e)
aic <- k * 3 * N^2 + N * (N + 1)/2 - 2 * llv(e)
} else if (any(class(e) == 'sbekk')) {
aic <- k * 2 + N * (N + 1)/2 - 2 * logLik(e)
aic <- k * 2 + N * (N + 1)/2 - 2 * llv(e)
} else if (any(class(e) == 'sbekka')) {
aic <- k * 3 + N * (N + 1)/2 - 2 * logLik(e)
aic <- k * 3 + N * (N + 1)/2 - 2 * llv(e)
}else if (any(class(e) == 'dbekk')) {
aic <- k * 2 + N * (N + 1)/2 - 2 * logLik(e)
aic <- k * 2 + N * (N + 1)/2 - 2 * llv(e)
} else if (any(class(e) == 'dbekka')) {
aic <- k * 3 + N * (N + 1)/2 - 2 * logLik(e)
aic <- k * 3 + N * (N + 1)/2 - 2 * llv(e)
}
return(aic)
}
Expand All @@ -88,31 +49,30 @@ AIC.bekkFit <- function(object, ..., k = 2) {
aic <- data.frame(df = vals, AIC = lls)
} else {
aic <- AICinner(x)
aic <- data.frame(df = length(x$theta), AIC = aic)
}

return(aic)
}

#' @rdname bekk_fit_methods
#' @export
BIC.bekkFit <- function(object, ...) {

x <- object

BICinner <- function(e) {
N <- ncol(e$data)
if (any(class(e) == 'bekk')) {
bic <- N^2 + N * (N + 1)/2 * log(nrow(e$data)) - 2 * logLik(e)
bic <- N^2 + N * (N + 1)/2 * log(nrow(e$data)) - 2 * llv(e)
} else if (any(class(e) == 'bekka')) {
bic <- 3 * N^2 + N * (N + 1)/2 * log(nrow(e$data)) - 2 * logLik(e)
bic <- 3 * N^2 + N * (N + 1)/2 * log(nrow(e$data)) - 2 * llv(e)
} else if (any(class(e) == 'sbekk')) {
bic <- 2 + N * (N + 1)/2 * log(nrow(e$data)) - 2 * logLik(e)
bic <- 2 + N * (N + 1)/2 * log(nrow(e$data)) - 2 * llv(e)
} else if (any(class(e) == 'sbekka')) {
bic <- 3 + N * (N + 1)/2 * log(nrow(e$data)) - 2 * logLik(e)
bic <- 3 + N * (N + 1)/2 * log(nrow(e$data)) - 2 * llv(e)
} else if (any(class(e) == 'dbekk')) {
bic <- 2 * N + N * (N + 1)/2 * log(nrow(e$data)) - 2 * logLik(e)
bic <- 2 * N + N * (N + 1)/2 * log(nrow(e$data)) - 2 * llv(e)
} else if (any(class(e) == 'dbekka')) {
bic <- 3 * N + N * (N + 1)/2 * log(nrow(e$data)) - 2 * logLik(e)
bic <- 3 * N + N * (N + 1)/2 * log(nrow(e$data)) - 2 * llv(e)
}
return(bic)
}
Expand All @@ -122,12 +82,80 @@ BIC.bekkFit <- function(object, ...) {
vals <- sapply(list(x, ...), function(e1){length(e1$theta)})
bic <- data.frame(df = vals, BIC = lls)
} else {
bic <- BICinner(x)
bic <- data.frame(df = length(x$theta), BIC = BICinner(x))
}

return(bic)
}

#' @rdname bekk_fit_methods
llv <- function(object) {


llv_inner <- function(x){
if (any(class(x) == 'bekk')) {
logl <- loglike_bekk(x$theta, x$data)
} else if (any(class(x) == 'bekka')) {
logl <- loglike_asymm_bekk(x$theta, x$data, x$signs)
} else if (any(class(x) == 'sbekk')) {
logl <- loglike_sbekk(x$theta, x$data)
} else if (any(class(x) == 'sbekka')) {
logl <- loglike_asymm_sbekk(x$theta, x$data, x$signs)
}else if (any(class(x) == 'dbekk')) {
logl <- loglike_dbekk(x$theta, x$data)
} else if (any(class(x) == 'dbekka')) {
logl <- loglike_asymm_dbekk(x$theta, x$data, x$signs)
}

return(logl)

}


lls <- llv_inner(object)



return(lls)
}

#' @rdname bekk_fit_methods
#' @export
logLik.bekkFit <- function(object, ..., k = 2) {


llv_inner <- function(x){
if (any(class(x) == 'bekk')) {
logl <- loglike_bekk(x$theta, x$data)
} else if (any(class(x) == 'bekka')) {
logl <- loglike_asymm_bekk(x$theta, x$data, x$signs)
} else if (any(class(x) == 'sbekk')) {
logl <- loglike_sbekk(x$theta, x$data)
} else if (any(class(x) == 'sbekka')) {
logl <- loglike_asymm_sbekk(x$theta, x$data, x$signs)
}else if (any(class(x) == 'dbekk')) {
logl <- loglike_dbekk(x$theta, x$data)
} else if (any(class(x) == 'dbekka')) {
logl <- loglike_asymm_dbekk(x$theta, x$data, x$signs)
}

return(logl)

}

if(!missing(...)) {# several objects: produce data.frame
lls <- sapply(list(object, ...), llv_inner)
vals <- sapply(list(object, ...), function(e1){length(e1$theta)})
aic <- data.frame(df = vals, LLV = lls, AIC = AIC(object, ..., k = k)$AIC, BIC = BIC(object, ...)$BIC)
} else {
lls <- llv_inner(object)
aic <- data.frame(df = length(object$theta), LLV = lls, AIC = AIC(object, k = k)$AIC, BIC = BIC(object)$BIC)


}
return(aic)
}

#' @rdname bekk_fit_methods
#' @export
print.bekkFit <- function(x,...){
Expand Down
Binary file modified build/BEKKs.pdf
View file
Binary file not shown.

0 comments on commit 57275e1

Please sign in to comment.