# NOT RUN {
set.seed(12933)
nsubj <- 20
ns <- 4000
ylist <- vector(mode="list",length=nsubj)
xlist <- vector(mode="list",length=nsubj)
timelist <- vector(mode="list",length=nsubj)
priorparm1 <- 0
priorparm2 <- 1
tpmparm1 <- c(-2,-2)
tpmparm2 <- c(0,0)
zeroparm <- c(-2,0)
emitparm <- c(4,0, 6,0)
zeroindex <- c(1,0)
for(n in 1:nsubj){
xlist[[n]] <- matrix(rep(c(0,1,0,1),rep(1000,4)),nrow=4000,ncol=1)
timeindex <- rep(1,4000)
for(i in 2:4000) timeindex[i] <- timeindex[i-1] + sample(1:4,1)
timelist[[n]] <- timeindex
if(n<=10){
workparm <- c(priorparm1,tpmparm1,zeroparm,emitparm)
}else{
workparm <- c(priorparm2,tpmparm2,zeroparm,emitparm)
}
result <- hmmsim2.cont(workparm,2,4000,zeroindex,emit_x=xlist[[n]],
zeroinfl_x=xlist[[n]],timeindex=timeindex)
ylist[[n]] <- result$series
}
prior_init=c(0.5,0.5)
tpm_init=matrix(c(-0.1,0.1,0.1,-0.1),2,2,byrow=TRUE)
zero_init=0.2
emit_init=c(50,400)
####
M <- 2
priorclust <- c(rep(1,10),rep(2,10))
tpmclust <- c(rep(1,10),rep(2,10))
zeroclust <- NULL
emitclust <- NULL
slopeclust <- rep(1,20)
group <- vector(mode="list",length=2)
group[[1]] <- 1:10; group[[2]] <- 11:20
###
time <- proc.time()
result <- dist_learn2(ylist, xlist, timelist, prior_init, tpm_init,
emit_init, zero_init, NULL, rho=1, priorclust,tpmclust,
emitclust,zeroclust,slopeclust,group,ncores=1,
maxit=10, tol=1e-4, method="CG",print=TRUE)
proc.time() - time
# }
Run the code above in your browser using DataLab