diff options
| -rw-r--r-- | R/estUtil.R | 12 | ||||
| -rw-r--r-- | R/estpoly.R | 11 |
2 files changed, 19 insertions, 4 deletions
diff --git a/R/estUtil.R b/R/estUtil.R index 5ebcacf..b8e5b5e 100644 --- a/R/estUtil.R +++ b/R/estUtil.R @@ -132,13 +132,17 @@ armaxGrad <- function(theta,e,dots){ } oeGrad <- function(theta,e,dots){ - # e - Instrument Variable, not necessarily residuals y <- dots[[1]]; u <- dots[[2]]; order <- dots[[3]]; nb <- order[1];nf <- order[2]; nk <- order[3]; - nb1 <- nb+nk-1 ; n <- max(nb1,nf); df <- N - nb - nf + nb1 <- nb+nk-1 ; n <- max(nb1,nf) + N <- dim(y)[1] - N <- dim(y)[1]-n - eout <- matrix(c(rep(0,n),e[,])) + if(is.null(e)){ + iv <- dots[[4]] + } else{ + iv <- y-e + } + eout <- matrix(c(rep(0,n),iv[,])) reg <- function(i) { if(nk==0) v <- i-0:(nb-1) else v <- i-nk:nb1 diff --git a/R/estpoly.R b/R/estpoly.R index b74e9db..97175ee 100644 --- a/R/estpoly.R +++ b/R/estpoly.R @@ -359,8 +359,19 @@ oe <- function(x,order=c(1,1,0)){ # Initial Guess mod_arx <- arx(x,c(nf,nb,nk)) # fitting ARX model + iv <- matrix(predict(mod_arx)) theta0 <- c(coef(mod_arx)$B,coef(mod_arx)$A[-1]) uout <- apply(u,2,leftPadZeros,n=n) + l <- levbmqdt(y,uout,order,iv,obj=armaxGrad,theta0=theta0,N=N, + opt=options) + theta <- l$params + e <- ts(l$residuals,start = start(y),deltat = deltat(y)) + + model <- idpoly(B = theta[1:nb],F1 = c(1,theta[nb+1:nf]), + - ioDelay = nk,Ts=deltat(x)) + estpoly(sys = model,stats=list(vcov = l$vcov, sigma = l$sigma), + fitted.values=y-e,residuals=e,call=match.call(),input=u, + options = options,termination = l$termination) }
\ No newline at end of file |