-
Notifications
You must be signed in to change notification settings - Fork 32
/
RVineVuongTest.R
122 lines (115 loc) · 5.16 KB
/
RVineVuongTest.R
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
117
118
119
120
121
122
#' Vuong Test Comparing Two R-Vine Copula Models
#'
#' This function performs a Vuong test between two d-dimensional R-vine copula
#' models as specified by their [RVineMatrix()] objects.
#'
#' The likelihood-ratio based test proposed by Vuong (1989) can be used for
#' comparing non-nested models. For this let \eqn{c_1} and \eqn{c_2} be two
#' competing vine copulas in terms of their densities and with estimated
#' parameter sets \eqn{\hat{\boldsymbol{\theta}}_1}{\theta_1} and
#' \eqn{\hat{\boldsymbol{\theta}}_2}{\theta_2}. We then compute the
#' standardized sum, \eqn{\nu}, of the log differences of their pointwise
#' likelihoods
#' \eqn{m_i:=\log\left[\frac{c_1(\boldsymbol{u}_i|\hat{\boldsymbol{\theta}}_1)}{c_2(\boldsymbol{u}_i|\hat{\boldsymbol{\theta}}_2)}\right]}{m_i:=log[c_1(u_i|\theta_1)
#' / c_2(u_i|\theta_2) ]} for observations \eqn{\boldsymbol{u}_i\in[0,1],\
#' i=1,...,N}{u_i in [0,1],i=1,...,N} , i.e.,
#' \deqn{\texttt{statistic} := \nu = \frac{\frac{1}{n}\sum_{i=1}^N
#' m_i}{\sqrt{\sum_{i=1}^N\left(m_i - \bar{m} \right)^2}}. }{ statistic := \nu
#' = (1/n\sum_{i=1}^N m_i) / ((\sum_{i=1}^N (m_i - \bar{m} )^2)^0.5). } Vuong
#' (1989) shows that \eqn{\nu} is asymptotically standard normal. According to
#' the null-hypothesis \deqn{H_0:
#' E[m_i] = 0\ \forall i=1,...,N, }{ H_0: E[m_i] = 0 forall i=1,...,N, } we
#' hence prefer vine model 1 to vine model 2 at level \eqn{\alpha} if
#' \deqn{\nu>\Phi^{-1}\left(1-\frac{\alpha}{2}\right), }{ \nu >
#' \Phi^{-1}(1-\alpha/2), } where \eqn{\Phi^{-1}} denotes the inverse of the
#' standard normal distribution function. If
#' \eqn{\nu<-\Phi^{-1}\left(1-\frac{\alpha}{2}\right)}{\nu<-\Phi^{-1}(1-\alpha/2)}
#' we choose model 2. If, however,
#' \eqn{|\nu|\leq\Phi^{-1}\left(1-\frac{\alpha}{2}\right)}{|\nu| <=
#' \Phi^{-1}(1-\alpha/2)}, no decision among the models is possible.
#'
#' Like AIC and BIC, the Vuong test statistic may be corrected for the number
#' of parameters used in the models. There are two possible corrections; the
#' Akaike and the Schwarz corrections, which correspond to the penalty terms in
#' the AIC and the BIC, respectively.
#'
#' @param data An N x d data matrix (with uniform margins).
#' @param RVM1,RVM2 [RVineMatrix()] objects of models 1 and 2.
#'
#' @return \item{statistic, statistic.Akaike, statistic.Schwarz}{Test
#' statistics without correction, with Akaike correction and with Schwarz
#' correction.} \item{p.value, p.value.Akaike, p.value.Schwarz}{P-values of
#' tests without correction, with Akaike correction and with Schwarz
#' correction.}
#'
#' @author Jeffrey Dissmann, Eike Brechmann
#'
#' @seealso [RVineClarkeTest()], [RVineAIC()],
#' [RVineBIC()]
#'
#' @references Vuong, Q. H. (1989). Ratio tests for model selection and
#' non-nested hypotheses. Econometrica 57 (2), 307-333.
#'
#' @examples
#' \donttest{
#' # vine structure selection time-consuming (~ 20 sec)
#'
#' # load data set
#' data(daxreturns)
#'
#' # select the R-vine structure, families and parameters
#' RVM <- RVineStructureSelect(daxreturns[,1:5], c(1:6))
#'
#' # select the C-vine structure, families and parameters
#' CVM <- RVineStructureSelect(daxreturns[,1:5], c(1:6), type = "CVine")
#'
#' # compare the two models based on the data
#' vuong <- RVineVuongTest(daxreturns[,1:5], RVM, CVM)
#' vuong$statistic
#' vuong$statistic.Schwarz
#' vuong$p.value
#' vuong$p.value.Schwarz
#' }
#'
RVineVuongTest <- function(data, RVM1, RVM2) {
## preprocessing of arguments
args <- preproc(c(as.list(environment()), call = match.call()),
check_data,
remove_nas,
check_if_01,
check_nobs,
check_RVMs,
na.txt = " Only complete observations are used.")
list2env(args, environment())
N <- args$n
Model1.ll <- RVineLogLik(data, RVM1, separate = TRUE, calculate.V = FALSE)$loglik
Model2.ll <- RVineLogLik(data, RVM2, separate = TRUE, calculate.V = FALSE)$loglik
anz.1 <- sum(RVM1$family >= 1, na.rm = TRUE) + sum(RVM1$family %in% c(2, 7, 8, 9, 10, 17, 18, 19, 20, 27, 28, 29, 30, 37, 38, 39, 40, 104, 114, 124, 134, 204, 214, 224, 234), na.rm = TRUE)
anz.2 <- sum(RVM2$family >= 1, na.rm = TRUE) + sum(RVM2$family %in% c(2, 7, 8, 9, 10, 17, 18, 19, 20, 27, 28, 29, 30, 37, 38, 39, 40, 104, 114, 124, 134, 204, 214, 224, 234), na.rm = TRUE)
if (all(Model1.ll - Model2.ll == 0)) {
# models are the same
V <- 0
V.Schwarz <- 0
V.Akaike <- 0
p <- 1
p.Schwarz <- 1
p.Akaike <- 1
} else {
LR <- sum(Model1.ll) - sum(Model2.ll)
LR.Schwarz <- LR - ((anz.1 / 2 * log(N) - anz.2 / 2 * log(N)))
LR.Akaike <- LR - (anz.1 - anz.2)
w <- sd(Model1.ll - Model2.ll)
V <- LR / (sqrt(N) * w)
V.Schwarz <- LR.Schwarz / (sqrt(N) * w)
V.Akaike <- LR.Akaike / (sqrt(N) * w)
p <- 2 * pnorm(-abs(V))
p.Schwarz <- 2 * pnorm(-abs(V.Schwarz))
p.Akaike <- 2 * pnorm(-abs(V.Akaike))
}
return(list(statistic = V,
statistic.Akaike = V.Akaike,
statistic.Schwarz = V.Schwarz,
p.value = p,
p.value.Akaike = p.Akaike,
p.value.Schwarz = p.Schwarz))
}