added a function to return the fit characteristics

3 files changed, 30 insertions, 20 deletions

diff --git a/NAMESPACE b/NAMESPACE
index db6bfaa..70e2611 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -36,6 +36,7 @@ export(dataSlice)
 export(detrend)
 export(estpoly)
 export(etfe)
+export(fitch)
 export(getcov)
 export(idframe)
 export(idfrd)
diff --git a/R/estpoly.R b/R/estpoly.R
index 132cabf..f48766c 100644
--- a/R/estpoly.R
+++ b/R/estpoly.R
@@ -18,26 +18,22 @@ print.estpoly <- function(x,...){
 summary.estpoly <- function(x)
 {
   model <- x$sys
-  if(model$type=="arx"||model$type=="armax"){
-    coefs <- c(model$A[-1],model$B)
-    na <- length(model$A) - 1; nk <- model$ioDelay; 
-    nb <- length(model$B)
-    if(model$type=="armax"){
-      coefs <- c(coefs,model$C[-1])
-      nc <- length(model$C)-1
-    } 
-  } else if(model$type=="oe"){
-    coefs <- c(model$B,model$F1[-1])
-    nf <- length(model$F1) - 1; nk <- model$ioDelay; 
-    nb <- length(model$B)
-  }
+  coefs <- params(model)
   
   se <- sqrt(diag(getcov(x)))
   params <- data.frame(Estimated=coefs,se=se)
   
+  report <- list(fit=fitch(x),params=params)
+  res <- list(model=model,report=report)
+  class(res) <- "summary.estpoly"
+  res
+}
+
+#' @export
+fitch <- function(x){
   y <- fitted(x) + resid(x)
   ek <- as.matrix(resid(x))
-  N <- nrow(ek); np <- nrow(params)
+  N <- nrow(ek); np <- length(params(x$sys))
   
   # fit characteristics
   mse <- det(t(ek)%*%ek)/N
@@ -48,11 +44,7 @@ summary.estpoly <- function(x)
   nAIC <- log(mse) + 2*np/N
   BIC <- N*log(mse) + N*dim(matrix(y))[2]*(log(2*pi)+1) + np*log(N)
   
-  report <- list(fit=list(MSE=mse,FPE=fpe,FitPer = nrmse*100,AIC=AIC,AICc=AICc,
-                          nAIC=nAIC,BIC=BIC),params=params)
-  res <- list(model=model,report=report)
-  class(res) <- "summary.estpoly"
-  res
+  list(MSE=mse,FPE=fpe,FitPer = nrmse*100,AIC=AIC,AICc=AICc,nAIC=nAIC,BIC=BIC)
 }
 
 #' @export
diff --git a/R/poly.R b/R/poly.R
index 15591e3..138cbbd 100644
--- a/R/poly.R
+++ b/R/poly.R
@@ -164,4 +164,21 @@ print.idpoly <- function(mod,se=NULL,dig=3){
     }
   }
   cat("\n")
-}
\ No newline at end of file
+}
+
+params <- function(x){
+  if(x$type=="arx"||x$type=="armax"){
+    coefs <- c(x$A[-1],x$B)
+    na <- length(x$A) - 1; nk <- x$ioDelay; 
+    nb <- length(x$B)
+    if(x$type=="armax"){
+      coefs <- c(coefs,x$C[-1])
+      nc <- length(x$C)-1
+    } 
+  } else if(x$type=="oe"){
+    coefs <- c(x$B,x$F1[-1])
+    nf <- length(x$F1) - 1; nk <- x$ioDelay; 
+    nb <- length(x$B)
+  }
+  coefs
+} 
\ No newline at end of file