利用KFAS拟合具有三次样条群效应和周期性主体效应的功能混合效应模型

时间:2014-10-29 18:17:26

标签: r model time-series state space

#我的状态向量由两部分组成,因此对于两个主体,状态向量的维数为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))

0 个答案:

没有答案