diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/estUtil.R | 19 | ||||
| -rw-r--r-- | R/estpoly.R | 6 |
2 files changed, 13 insertions, 12 deletions
diff --git a/R/estUtil.R b/R/estUtil.R index eede460..8bdc668 100644 --- a/R/estUtil.R +++ b/R/estUtil.R @@ -1,8 +1,10 @@ armaxGrad <- function(theta,e,dots){ - y <- dots[[1]]; u <- dots[[2]]; order <- dots[[3]]; N <- dots[[4]] + y <- dots[[1]]; u <- dots[[2]]; order <- dots[[3]]; na <- order[1];nb <- order[2]; nc <- order[3]; nk <- order[4] nb1 <- nb+nk-1 ; n <- max(na,nb1,nc) + N <- dim(y)[1]-2*n + if(is.null(e)){ eout <- matrix(rep(0,N+2*n)) } else{ @@ -63,7 +65,8 @@ levbmqdt <- function(...,obj,theta0,N,opt){ # Update residuals e <- l$Y-l$X%*%theta sumsq <- sum(e^2) - sumSqRatio <- (sumsq0-sumsq)/sumsq0*100 + sumSqRatio <- (sumsq0-sumsq)/sumsq0 + print(c(i,maxIter,sumsq0,sumSqRatio)) # If sum square error with the updated parameters is less than the # previous one, the updated parameters become the current parameters @@ -78,12 +81,13 @@ levbmqdt <- function(...,obj,theta0,N,opt){ update <- 0 } - if((sumSqRatio < tol) || (i == maxIter)){ + if((abs(sumSqRatio) < tol) || (i == maxIter)){ break + } } - if(sumSqRatio < tol){ + if(abs(sumSqRatio) < tol){ WhyStop <- "Tolerance" } else{ WhyStop <- "Maximum Iteration Limit" @@ -91,14 +95,15 @@ levbmqdt <- function(...,obj,theta0,N,opt){ e <- e[1:N,] sigma2 <- sum(e^2)/df - vcov <- sigma2 * Hinv + vcov <- sigma2 * Hinv/sqrt(N) list(params=theta,residuals=e,vcov=vcov,sigma = sqrt(sigma2), - termination=list(WhyStop=WhyStop,iter=i,FcnCount = countObj)) + termination=list(WhyStop=WhyStop,iter=i,FcnCount = countObj, + damping=d,sumSqRatio=sumSqRatio)) } #' @export -optimOptions <- function(tol=0.01,maxIter=20,LMinit=10,LMstep=2){ +optimOptions <- function(tol=1e-5,maxIter=20,LMinit=2,LMstep=2){ return(list(tol=tol,maxIter= maxIter, adv= list(LMinit=LMinit, LMstep=LMstep))) } diff --git a/R/estpoly.R b/R/estpoly.R index 2e2eba4..c512933 100644 --- a/R/estpoly.R +++ b/R/estpoly.R @@ -264,13 +264,9 @@ armax <- function(x,order=c(0,1,1,0),options=optimOptions()){ yout <- apply(y,2,padZeros,n=n) uout <- apply(u,2,padZeros,n=n) - reg <- function(i,y,u,e) { - if(nk==0) v <- i-0:(nb-1) else v <- i-nk:nb1 - matrix(c(-y[i-1:na,],u[v,],e[i-1:nc,])) - } theta0 <- matrix(rnorm(na+nb+nc)) # current parameters - l <- levbmqdt(yout,uout,order,N,obj=armaxGrad,theta0=theta0,N=N, + l <- levbmqdt(yout,uout,order,obj=armaxGrad,theta0=theta0,N=N, opt=options) theta <- l$params e <- ts(l$residuals,start = start(y),deltat = deltat(y)) |