1
2# This library is free software; you can redistribute it and/or
3# modify it under the terms of the GNU Library General Public
4# License as published by the Free Software Foundation; either
5# version 2 of the License, or (at your option) any later version.
6#
7# This library is distributed in the hope that it will be useful,
8# but WITHOUT ANY WARRANTY; without even the implied warranty of
9# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10# GNU Library General Public License for more details.
11#
12# You should have received a copy of the GNU Library General
13# Public License along with this library; if not, write to the
14# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
15# MA  02111-1307  USA
16
17
18################################################################################
19# FUNCTION:                DESCRIPTION:
20#  garchKappa               Computes Expection for APARCH Models
21#  .garchKappaFun           Internal function used by garchKappa()
22# FUNCTION:                DESCRIPTION:
23#  .truePersistence         Computes true persistence
24################################################################################
25
26
27garchKappa <-
28    function(cond.dist = c("norm", "ged", "std", "snorm", "sged", "sstd",
29    "snig"), gamma = 0, delta = 2, skew = NA, shape = NA)
30{
31    # A function implemented by Diethelm Wuertz
32
33    # Description:
34    #   Computes Expection for APARCH Models
35
36    # FUNCTION:
37
38    # Compute kappa:
39    kappa = integrate(.garchKappaFun, lower = -Inf, upper = Inf, cond.dist =
40        cond.dist[1], gamma = gamma, delta = delta, skew = skew, shape =
41        shape)[[1]]
42    names(kappa) = "kappa"
43    attr(kappa, "control") =
44        c(gamma = gamma, delta = delta, skew = skew, shape = shape)
45    attr(kappa, "cond.dist") = cond.dist[1]
46
47    # Return Value:
48    kappa
49}
50
51
52# ------------------------------------------------------------------------------
53
54
55.garchKappaFun <-
56    function(x,
57    cond.dist = c("norm", "ged", "std", "snorm", "sged", "sstd", "snig"),
58    gamma = 0, delta = 2, skew = NA, shape = NA)
59{
60    # A function implemented by Diethelm Wuertz
61
62    # Description:
63    #   Internal function used by kappa()
64
65    # FUNCTION:
66
67    # Compute Expectation Value for ...
68    funcE = (abs(x) - gamma*x)^delta
69
70    # Select Appropriate Conditional Density:
71    cond.dist = cond.dist[1]
72    if (cond.dist == "norm") {
73        fun = funcE * dnorm(x)
74    }
75    if (cond.dist == "ged") {
76        fun = funcE * dged(x, nu = shape)
77    }
78    if (cond.dist == "std") {
79        fun = funcE * dstd(x, nu = shape)
80    }
81    if (cond.dist == "snorm") {
82        fun = funcE * dsnorm(x, xi = skew)
83    }
84    if (cond.dist == "sged") {
85        fun = funcE * dsged(x, nu = shape, xi = skew)
86    }
87    if (cond.dist == "sstd") {
88        fun = funcE * dsstd(x, nu = shape, xi = skew)
89    }
90    if (cond.dist == "snig") {
91        fun = funcE * dsnig(x, zeta = shape, rho = skew)
92    }
93
94    # Return Value:
95    fun
96}
97
98
99################################################################################
100
101
102.truePersistence <-
103    function(fun = "norm", alpha = 1, gamma = 0, beta = 0, delta = 1, ...)
104{
105    # A function implemented by Diethelm Wuertz
106
107    # Description:
108    #   Computes persistence for an APARCH process
109
110    # Arguments:
111    #   fun - name of density functions of APARCH innovations
112    #   alpha, gamma - numeric value or vector of APARCH coefficients,
113    #       must be of same length
114    #   beta - numeric value or vector of APARCH coefficients
115    #   delta - numeric value of APARCH exponent
116
117    # Note:
118    #   fun is one of: norm, snorn, std, sstd, ged, sged, snig
119
120    # FUNCTION:
121
122    # Match Density Function:
123    fun = match.fun(fun)
124
125    # Persisgtence Function: E(|z|-gamma z)^delta
126    e = function(x, gamma, delta, ...) {
127        (abs(x)-gamma*x)^delta * fun(x, ...)
128    }
129
130    # Compute Persistence by Integration:
131    persistence = sum(beta)
132    for (i in 1:length(alpha)) {
133        I = integrate(e, -Inf, Inf, subdivisions = 1000,
134            rel.tol = .Machine$double.eps^0.5,
135            gamma = gamma[i], delta = delta, ...)
136        persistence = persistence + alpha[i] * I[[1]]
137    }
138
139    # Warning:
140    if (persistence >= 1) {
141        p = as.character(round(persistence, digits = 3))
142        warning(paste("Divergent persistence p =", p))
143    }
144
145    # Return Value:
146    persistence
147}
148
149
150################################################################################
151
152