.packageName <- "mAr"
"mAr.eig" <-
function(A,C, ...)
{

# A has m rows and mp columns
m=dim(A)[1]
p=(dim(A)[2])/m

# Augmented coefficient matrix
At=matrix(nrow=m*p,ncol=m*p)
if (p==1) At=A else{
At[seq(1,m),seq(1,m*p)]=A
At[seq(m+1,m*p),seq(1,m*p-m)]=diag(1,(p-1)*m)
At[seq(m+1,m*p),seq(m*p-m+1,m*p)]=0
}

# Computation of eigenvalues and eigenvectors
l=eigen(At)$values
V=eigen(At)$vectors

# test stability of AR model
if ((any(Mod(l)>1))) warning("unstable AR model")


# fix phase of eigenvectors to satisfy normalisation conditions
a=matrix(nrow=1,ncol=dim(V)[2])
b=matrix(nrow=1,ncol=dim(V)[2])
St=matrix(nrow=dim(V)[2],ncol=dim(V)[2])
for (j in seq(1,dim(V)[2])){
a=Re(V[,j])
b=Im(V[,j])
ph=0.5*atan(2*sum(a*b)/( b %*% b - a %*% a))
na=sqrt(sum((cos(ph)*a - sin(ph)*b)^2))
nb=sqrt(sum((sin(ph)*a + sin(ph)*b)^2))
if(nb>na && ph < 0){ph=ph-pi/2}
if(nb>na && ph >0){ph=ph+pi/2}
St[,j]=V[,j] %*% exp(1i*ph)
}

# m-dimensional eigenvectors
S=St[seq(1+(p-1)*m,p*m),]

# transformed noise-covariance matrix
StInv=solve(St)[,seq(1,m)]
Ct=StInv %*% C %*% t(Conj(StInv))

# damping time and period for eigenmode i
tau=matrix(nrow=1,ncol=m*p)
per=matrix(nrow=1,ncol=m*p)
exctn=matrix(nrow=1,ncol=m*p)
for (i in seq(1,m*p)){
tau[i]=-2/log((abs(l[i]))^2)
a=Re(l[i])
b=Im(l[i])
if (identical(b,0)  && a>=0) {per[i]=Inf}
if (identical(b,0)  && a<0) {per[i]=2}
else {per[i]=2*pi/abs(atan2(b,a))}
exctn[i]=Re(Ct[i,i]/(1-(abs(l[i]))^2))
}

# relative dynamical importance of modes
exctn=exctn/sum(exctn)

return (list(dampTime=tau,period=per,excitations=exctn,eigv=S))

}
"mAr.est" <-
function(x,pmin,pmax, ...)
{

x=as.matrix(x)
n=dim(x)[1]
m=dim(x)[2]

if(pmin >= pmax)
	stop("pmin must be < pmax")

if(round(pmin) != pmin || round(pmax) != pmax)
	stop("order model must be an integer")

ne=n-pmax	# length of time vector
npmax=m*pmax+1

if(ne <= npmax)
	stop("time series too short")


#
# Model order selection
#


# Model of order pmax

K=matrix(nrow=ne,ncol=npmax+m)
K[,1]=rep(1,ne)
for(j in 1:pmax) { K[,seq(2+m*(j-1),1+m*j)]=data.matrix(x[seq(pmax-j+1,n-j),1:m]) }
K[,seq(npmax+1,npmax+m)]=data.matrix(x[seq(pmax+1,n),1:m])

q=ncol(K)
delta=(q^2+q+1)*(.Machine$double.eps) # regularisation parameter
scale=sqrt(delta)*sqrt(apply(K^2,2,sum))

R=qr.R(qr((rbind(K,diag(scale)))),complete=TRUE) # QR factorisation of data matrix K

R22=R[seq(npmax+1,npmax+m),seq(npmax+1,npmax+m)]

logdp=c(pmin:pmax)
logdp[pmax]=2*log(abs(prod(diag(R22)))) # log determinant of residual cross-product matrix

sbc=c(pmin:pmax)
sbc[pmax]=logdp[pmax]/m - log(ne)*(ne-npmax)/ne


# Downdating - approximate order selection criteria for models of order pmax-1:pmin

p=seq((pmax),pmin,-1)
np=c(pmin:pmax)
np[p]=m*p+1

invdp= solve(R22) %*% t(solve(R22))

for(i in seq(pmax-1,pmin,-1)){
Rp=R[seq(np[i]+1,np[i]+m),seq(npmax+1,npmax+m)]
L=chol(t(diag(1,m,m) + Rp %*% invdp %*% t(Rp)))
N=solve(L) %*% Rp %*% invdp
invdp=invdp - (t(N) %*% N)
logdp[i]= logdp[i+1] + 2*log(abs(prod(diag(L))))
sbc[i]=logdp[i]/m - log(ne)*(ne-np[i])/ne # Schwartz's Bayesian Criterion
}

# selected optimal order
popt=which.min(sbc)
npopt=m*popt+1


#
# Parameters estimation for optimal order model
#

Ropt11=R[seq(1,npopt),seq(1,npopt)]
Ropt12=R[seq(1,npopt),seq(npmax+1,npmax+m)]
Ropt22=R[seq(npopt+1,npmax+m),seq(npmax+1,npmax+m)]

Ropt11[,1]=Ropt11[,1]*max(scale[2:(npmax+m)])/scale[1] # re-scaling R11's first column to improve condition

B=t(solve(Ropt11) %*% Ropt12) # Estimated augmented parameter matrix

w=B[,1]*max(scale[2:(npmax+m)])/scale[1] # intercept vector
A=B[,2:npopt] # coefficient matrix

C=(t(Ropt22) %*% Ropt22)/(ne-npopt) # bias-corrected covariance matrix estimate

# Residuals

t=seq(1,(n-popt))
res=matrix(nrow=(n-popt),ncol=m)
res[t,seq(1,m)]=x[t+popt,]-(rep(1,n-popt) %*% t(w))
for (j in seq(1,popt)) {res[t,seq(1,m)]=res[t,seq(1,m)]-(x[(t-j+popt),] %*% t(A[, seq(m*j-m+1,j*m)]))}


return (list(pHat=popt,SBC=sbc[pmin:pmax],wHat=w,AHat=A,CHat=C,res=res))


}
"mAr.sim" <-
function(w,A,C,N, ...)
{

# A has m rows and mp columns
m=dim(A)[1]
p=(dim(A)[2])/m

# Augmented coefficient matrix
At=matrix(nrow=m*p,ncol=m*p)
if (p==1) {At=A}
else{
At[seq(1,m),seq(1,m*p)]=A
At[seq(m+1,m*p),seq(1,m*p-m)]=diag(1,(p-1)*m)
At[seq(m+1,m*p),seq(m*p-m+1,m*p)]=0
}

# test stability of AR model
l=(eigen(At,only.values = TRUE))$values
if ((any(Mod(l)>1))) warning("unstable AR model")

# discard first nd simulated values
nd=1000

U=chol(C) #upper triangular matrix

# generate independent gaussian noise vectors with mean 0 and covariance matrix C
# uses mvrnorm in MASS to simulate from a multivariate normal distribution
require(MASS)
noisevec=mvrnorm(nd+N, rep(0,m),C)
matw=rep(1,nd+N)%*%t(w)
vec=noisevec+matw

# p initial values equal to the process mean
if (any(w!=0)){
B=diag(1,m)
for(j in seq(1,p)) {B=B-A[,seq(m*j-m+1,j*m)]}
mproc=as.vector(solve(B) %*% w) # process mean
xi=(matrix(1,nrow=p,ncol=1)) %*% mproc
} else { xi=matrix(nrow=p,ncol=m)
xi[,]=0
}
# initialisation of state vector
u=matrix(nrow=p+nd+N,ncol=m)
u[seq(1,p),seq(1,m)]=xi
u[seq(p+1,p+nd+N),seq(1,m)]=0

# simulate nd+N observations of multivariate AR(p) process
Atr=t(A)
x=matrix(ncol=m,nrow=p)

for(k in seq(p+1,nd+N+p)){
for(j in seq(1,p)){
x[j,]=u[k-j,]%*%Atr[seq(m*j-m+1,m*j),]}
u[k,]=as.matrix(apply(x,2,sum)+ vec[k-p,])
}

# return N simulated observations
v=u[seq(nd+p+1,nd+p+N),]
simulated=data.frame(v[,seq(1,m)])

return (simulated)

}
