|
1 | | -## ' Goodness-of-Fit test for a garma_model. |
2 | | -## This function commented out for now. Does not appear to work well. |
3 | | -## ' |
4 | | -## ' Provides a goodness-of-fit test for a GARMA Model, using the method of Delgado, Hidalgo and Velasco (2005). |
5 | | -## ' |
6 | | -## ' This routine provides a test for White noise using eqn (6) of Delgado, Hidalgo and Velasco (2005). The |
7 | | -## ' statistic calculated is \eqn{\alpha_n^0=\frac{1}{\sqrt{\tilde{n}}}\left(\frac{G_n^0(\lambda_j)}{G_T^0(\pi)}-\frac{\lambda_j}{\pi}\right)} |
8 | | -## ' which is asymptotically distributed as a Brownian Bridge, |
9 | | -## ' where \eqn{G_n^0(\lambda_j)=\frac{2\pi}{\tilde{n}}\sum_{j=1}^{[\tilde{n}\lambda_j/\pi]}I_\epsilon(\lambda_j)} |
10 | | -## ' |
11 | | -## ' So any interval \eqn{[0,\lambda]} |
12 | | -## ' will have an asymptotically \eqn{N\left(0,\frac{\lambda}{\pi}\left(1-\frac{\lambda}{\pi}\right)\right)} distribution. |
13 | | -## ' |
14 | | -## ' @param object (garma_model) The garma_model to test. |
15 | | -## ' @param gof.lag (int) max lag to test. |
16 | | -## ' @return None. |
17 | | -## ' @export |
18 | | -# gof<-function(object,gof.lag=10) { |
19 | | -# r <- as.numeric(residuals(object)) |
20 | | -# n <- length(r) |
21 | | -# tilde_n <- as.integer(n/2) |
22 | | -# if (gof.lag>tilde_n) stop('ERROR: number of lags not supported by length of data.\n') |
23 | | -# |
24 | | -# I_eps <- spec.pgram(r,taper=0,fast=FALSE,demean=FALSE,detrend=FALSE,plot=FALSE) |
25 | | -# G_lambda <- sum(I_eps$spec[1:gof.lag]) |
26 | | -# G_pi <- sum(I_eps$spec) |
27 | | -# # in next line the (2*gof.lag/n) is a simplification: |
28 | | -# # lambda_{gof.lag}/pi = (2*pi*gof.lag/n)/pi = (2*gof.lag/n) |
29 | | -# s <- 1/sqrt(tilde_n)*(G_lambda/G_pi-(2*gof.lag/n)) |
30 | | -# var_s <- (2*gof.lag/n)*(1-2*gof.lag/n) |
31 | | -# cat(sprintf('lambda/pi %f\nG_lambda %f\nG_pi %f\ns %f\nvar_s %f\n',2*gof.lag/n,G_lambda,G_pi,s,var_s)) |
32 | | -# s2 <- s/sqrt(var_s) |
33 | | -# p <- 1-pnorm(s2) |
34 | | -# |
35 | | -# cat(sprintf('\nTest for H0: Residuals up to lag %d are White Noise.\napprox z-statistic: %0.4f\np-value: %0.4f\n',gof.lag,s2,p)) |
36 | | -# } |
| 1 | +#' Goodness-of-Fit test for a garma_model. |
| 2 | +#' |
| 3 | +#' Provides a goodness-of-fit test for a GARMA Model, using Bartletts Tp test. |
| 4 | +#' This has been justified for long memory and for GARMA models by Delgado, Hidalgo and Velasco (2005). |
| 5 | +#' |
| 6 | +#' @param object (garma_model) The garma_model to test. |
| 7 | +#' @return Invisibly returns the array of p-values from the test. |
| 8 | +#' @export |
| 9 | +gof<-function(object) { |
| 10 | +r<- as.numeric(residuals(object)) |
| 11 | +n<- length(r) |
| 12 | +tilde_n<- as.integer(n/2) |
| 13 | + |
| 14 | +I_eps<- spec.pgram(r,taper=0,fast=FALSE,demean=FALSE,detrend=FALSE,plot=FALSE) |
| 15 | +pv<-numeric(0) |
| 16 | +for (iin2:length(I_eps$spec))pv<- c(pv, ks.test(I_eps$spec[1:i],ecdf(I_eps$spec))$p.value) |
| 17 | + cat(sprintf('\nBartletts Tp test.\n\nTest for H0: Residuals are White Noise.\nEvaluating %d frequencies, smallest p-value: %0.4f at frequency %.4f period %.4f.\n', |
| 18 | + length(I_eps$spec),min(pv), |
| 19 | + (which.min(pv)+1)*2*pi/n, |
| 20 | +n/((which.min(pv)+1)) |
| 21 | + )) |
| 22 | +return(invisible(pv)) |
| 23 | +} |