##The parameter function
theta.h0 <- function(p, dk, ...) {
i <- (1:dk-1)
(p[1] + p[2]*i)*exp(p[3]*i + p[4]*i^2)
}
##Generate coefficients
theta0 <- theta.h0(c(-0.1,0.1,-0.1,-0.001),4*12)
##Plot the coefficients
plot(theta0)
##Generate the predictor variable
set.seed(13)
x <- simplearma.sim(list(ar=0.6),1500*12,1,12)
##Simulate the response variable
y <- midas.sim(500,theta0,x,1)
##Remove unnecessary history of x
x <- window(x,start=start(y))
##Fit restricted model
mr <- midas_r(y~fmls(x,4*12-1,12,theta.h0)-1,
list(y=y,x=x),
start=list(x=c(-0.1,0.1,-0.1,-0.001)))
##The gradient function
theta.h0.gradient <-function(p, dk,...) {
i <- (1:dk-1)
a <- exp(p[3]*i + p[4]*i^2)
cbind(a, a*i, a*i*(p[1]+p[2]*i), a*i^2*(p[1]+p[2]*i))
}
##Perform test (the expected result should be the acceptance of null)
hAhr.test(mr)
mr <- midas_r(y~fmls(x,4*12-1,12,theta.h0)-1,
list(y=y,x=x),
start=list(x=c(-0.1,0.1,-0.1,-0.001)),
user.gradient=TRUE)
##Use exact gradient. Note the
hAhr.test(mr)
Run the code above in your browser using DataLab