#我的状态向量由两部分组成,因此对于两个主体,状态向量的维数为6:组效应(beta(t),beta(t)) and subject specific effect (a1(t), a1(t)
,a2(t), A2(t)的`);拟合的组效果是我所期望的,有人可以帮助我查看我的代码吗?欣赏!
t=c(seq(0.04,1, 0.04))
y1=c(7.1024,1.3367,19.1542,5.5507,NA,NA,4.5526,6.2886,0.6607,1.0462,3.5248,-6.1243,-7.8961,-9.9611,-5.713,-9.886,-15.5728,-6.5457,-1.5192,0.2451,-7.3601,NA,-6.4965,-3.7318,7.9323)
y2=c(9.174,2.0993,3.9269,6.8114,9.001,14.4906,3.2545,14.3478,5.265,10.5539,2.2248,- 6.2799,-13.5552,-6.2439,-2.9577,-5.8744,-11.3646,-5.2671,-14.195,-2.5649,-15.0287,-4.3465,-4.3105,-7.8631,1.4211)
mydata=data.frame(cbind(t,y1,y2))
y=cbind(y1,y2)
# example y1 y2 sequentially fit, Cubic spline smoothing and add subject specific effect;`
deltat=0.04
# transition matix for group effect`
tblock=matrix(c(1,deltat,0,1),2,2,byrow=TRUE)
# transition matrix for subject effect`
qblock=matrix(c(rep(0,4)),2,2,byrow=TRUE )
qblock[1,1]=cos(2*pi*deltat)
qblock[1,2]=sin(2*pi*deltat)/(2*pi)
qblock[2,1]=sin(2*pi*deltat)*(-2*pi)
qblock[2,2]=qblock[1,1]
# state equation covariance `
wblock=matrix(c(rep(0,4)),2,2,byrow=TRUE )
wblock[1,1]=(1/(8*pi*pi))* deltat - (1/(32*pi*pi*pi))* sin(4*pi*deltat)
wblock[1,2]=(1/(16*pi*pi))* ( 1- cos(4*pi*deltat) )
wblock[2,1]=wblock[1,2]
wblock[2,2]=(1/(8*pi))* sin(4*pi*deltat) + deltat/2
library(MASS)
library(KFAS)
attach(mydata)
y=cbind(y1,y2)
model<-SSModel(y~-1+ SSMcustom(Z=matrix(c(1,0,1,0,0,0,1,0,0,0,1,0),2,6,byrow=TRUE),
T=array(diag(6),c(6,6,nrow(mydata))),
Q=array(0,c(6,6,nrow(mydata))),
P1inf=diag(c(0,0,0,0,0,0)), P1=diag(c(1000000,1000000,1,1,1,1)) ) ), data=mydata)
model$T[1,2,]<-c(diff(mydata$t),0.04)
model$T[3,3,]<-qblock[1,1]
model$T[3,4,]<-qblock[1,2]
model$T[4,3,]<-qblock[2,1]
model$T[4,4,]<-qblock[2,2]
model$T[5,5,]<-qblock[1,1]
model$T[5,6,]<-qblock[1,2]
model$T[6,5,]<-qblock[2,1]
model$T[6,6,]<-qblock[2,2]
model$Q[1,1,]<-c(diff(mydata$t),0.04)^3/3
model$Q[1,2,]<-model$Q[2,1,]<-c(diff(mydata$t),1)^2/2
model$Q[2,2,]<-c(diff(mydata$t),1)
model$Q[3,3,]<-wblock[1,1]
model$Q[3,4,]<-wblock[1,2]
model$Q[4,3,]<-wblock[2,1]
model$Q[4,4,]<-wblock[2,2]
model$Q[5,5,]<-wblock[1,1]
model$Q[5,6,]<-wblock[1,2]
model$Q[6,5,]<-wblock[2,1]
model$Q[6,6,]<-wblock[2,2]
# model$Z model$T model$Q model$H
# m is # of state
updatefn<-function(pars,model,...){
model$H[]<-exp(pars[1])
model$Q[1:2,1:2,]<-model$Q[1:2,1:2, ]*exp(pars[2])
model$Q[3:6,3:6,]<-model$Q[3:6,3:6,]*exp(pars[3])
model
}
fit<-fitSSM(model,inits=c( log(23.6), 23.5, 5),updatefn=updatefn,method="BFGS")
names(fit)
fit$model fit$optim.out
out<-KFS(model,smoothing=c('state'),nsim=1000)
names(out)
ts.plot(cbind(y,out$alphahat[,1],
out$alphahat[,1]+out$alphahat[,3],out$alphahat[,1]+out$alphahat[,5]),col=c(1,1,2,4,4))