added the bj routine

1 files changed, 39 insertions, 0 deletions

diff --git a/R/estUtil.R b/R/estUtil.R
index 2aadc0e..dc0a00d 100644
--- a/R/estUtil.R
+++ b/R/estUtil.R
@@ -159,4 +159,43 @@ oeGrad <- function(theta,e,dots){
   }
   
   return(l)
+}
+
+bjGrad <- function(theta,e,dots){
+  y <- dots[[1]]; uout <- dots[[2]]; order <- dots[[3]];
+  nb <- order[1];nc <- order[2]; nd <- order[3];
+  nf <- order[4]; nk <- order[5];
+  nb1 <- nb+nk-1 ; n <- max(nb1,nc,nd,nf);
+  N <- dim(y)[1]
+  
+  if(is.null(e)){
+    zeta <- dots[[4]]
+    w <- y-zeta
+    e <- dots[[5]]
+  } else{
+    filt_ts <- signal::Arma(b=c(1,theta[nb+1:nc]),
+                            a=c(1,theta[nb+nc+1:nd]))
+    w <- signal::filter(filt_ts,e)
+    zeta <- y-w
+  }
+  zetaout <- matrix(c(rep(0,n),zeta[,]))
+  wout <- matrix(c(rep(0,n),w[,]))
+  eout <- matrix(c(rep(0,n)),e[,])
+  
+  reg <- function(i) {
+    if(nk==0) v <- i-0:(nb-1) else v <- i-nk:nb1
+    matrix(c(uout[v,],eout[i-1:nc,],wout[i-1:nd,],-zetaout[i-1:nf,]))
+  }
+  
+  X <- t(sapply(n+1:N,reg))
+  l <- list(X=X,Y=y)
+  
+  if(!is.null(e)){
+    filt1 <- signal::Arma(b=c(1,theta[nb+nc+1:nd]),
+                          a=c(1,theta[nb+1:nc]))
+    grad <- apply(X,2,signal::filter,filt=filt1)
+    l$grad <- grad
+  }
+  
+  return(l)
 }
\ No newline at end of file