summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSuraj Yerramilli2015-08-23 16:21:47 +0530
committerSuraj Yerramilli2015-08-23 16:21:47 +0530
commitc95cf09232ecc5d808f8767354aae061b54e1026 (patch)
tree8252e3d6c1be707b65d1f4d283504102854e5104
parent6690438dc5ff4a2dde1c15cf09a0a953c5b06bc3 (diff)
downloadSysID-R-code-c95cf09232ecc5d808f8767354aae061b54e1026.tar.gz
SysID-R-code-c95cf09232ecc5d808f8767354aae061b54e1026.tar.bz2
SysID-R-code-c95cf09232ecc5d808f8767354aae061b54e1026.zip
Added multivariate support for impulse response estimates
-rw-r--r--R/nonparam.R36
-rw-r--r--man/impulseest.Rd6
2 files changed, 29 insertions, 13 deletions
diff --git a/R/nonparam.R b/R/nonparam.R
index 8f6cc41..f3faa26 100644
--- a/R/nonparam.R
+++ b/R/nonparam.R
@@ -3,10 +3,10 @@
#' \code{impulseest} is used to estimate impulse response coefficients from
#' the data
#'
-#' @param data an object of class \code{idframe}
+#' @param x an object of class \code{idframe}
#' @param M Order of the FIR Model (Default:\code{30})
#' @param K Transport delay in the estimated impulse response
-#' (Default:\code{0})
+#' (Default:NULL)
#' @param regul Parameter indicating whether regularization should be
#' used. (Default:\code{FALSE})
#' @param lambda The value of the regularization parameter. Valid only if
@@ -30,14 +30,31 @@
#' plot(fit)
#'
#' @export
-impulseest <- function(data,M=30,K=0,regul=F,lambda=1){
+impulseest <- function(x,M=30,K=NULL,regul=F,lambda=1){
+
+ N <- dim(x$output)[1]
+ if(is.null(K))
+ K <- rep(0,nInputSeries(x)*nOutputSeries(x))
- N <- dim(data$output)[1]
- ind <- (M+K+1):N
+ out <- rep(list(0),length(K))
- z_reg <- function(i) data$input[(i-K):(i-M-K),]
+ for(i in seq(nOutputSeries(x))){
+ for(j in seq(nInputSeries(x))){
+ index <- (i-1)*nInputSeries(x)+j
+ out[[index]] <- impulsechannel(outputData(x)[,i,drop=F],
+ inputData(x)[,j,drop=F],N,K(index),
+ regul,lambda)
+ }
+ }
+ class(out) <- "impulseest"
+ return(out)
+}
+
+impulsechannel <- function(y,u,N,K=0,regul=F,lambda=1){
+ ind <- (M+K+1):N
+ z_reg <- function(i) u[(i-K):(i-M-K),]
Z <- t(sapply(ind,z_reg))
- Y <- data$output[ind,]
+ Y <- y[ind,]
# Dealing with Regularization
if(regul==F){
@@ -55,9 +72,8 @@ impulseest <- function(data,M=30,K=0,regul=F,lambda=1){
se <- sqrt(diag(vcov))
out <- list(coefficients=coefficients,residuals=residuals,lags=K:(M+K),
- x=inputNames(data),y=outputNames(data),se = se)
- class(out) <- "impulseest"
- return(out)
+ x=colnames(u),y=colnames(y),se = se)
+ out
}
#' Impulse Response Plots
diff --git a/man/impulseest.Rd b/man/impulseest.Rd
index ccfadc6..0eddac7 100644
--- a/man/impulseest.Rd
+++ b/man/impulseest.Rd
@@ -4,15 +4,15 @@
\alias{impulseest}
\title{Estimate Impulse Response Coefficients}
\usage{
-impulseest(data, M = 30, K = 0, regul = F, lambda = 1)
+impulseest(x, M = 30, K = NULL, regul = F, lambda = 1)
}
\arguments{
-\item{data}{an object of class \code{idframe}}
+\item{x}{an object of class \code{idframe}}
\item{M}{Order of the FIR Model (Default:\code{30})}
\item{K}{Transport delay in the estimated impulse response
-(Default:\code{0})}
+(Default:NULL)}
\item{regul}{Parameter indicating whether regularization should be
used. (Default:\code{FALSE})}