Plans for Mixture model package - help in the process

Thank you, I see how to make some examples from these models run with Newton-Raphson, but it would take me longer than I want for the first edition of the package. So that it works for all the models I want to make available. Will work on that addition for a future version.

On another issue that is higher priority in our models, is the addition of Hiddent Markov Models (HMM). I am working on applying HMM with multiple subjects in time series. The example from the **mxExpectationHiddenMarkov()** function is applied with a single time series

start_prob <- c(.2,.4,.4)
transition_prob <- matrix(c(.8, .1, .1,
.3, .6, .1,
.1, .3, .6), 3, 3)
noise <- .05

# simulate a trajectory
state <- sample.int(3, 1, prob=transition_prob %*% start_prob)
trail <- c(state)

for (rep in 1:500) {
state <- sample.int(3, 1, prob=transition_prob[,state])
trail <- c(trail, state)
}

# add noise
trailN <- sapply(trail, function(v) rnorm(1, mean=v, sd=sqrt(noise)))

classes <- list()

for (cl in 1:3) {
classes[[cl]] <- mxModel(paste0("cl", cl), type="RAM",
manifestVars=c("ob"),
mxPath("one", "ob", value=cl, free=FALSE),
mxPath("ob", arrows=2, value=noise, free=FALSE),
mxFitFunctionML(vector=TRUE))
}

m1 <-
mxModel("hmm", classes,
mxData(data.frame(ob=trailN), "raw"),
mxMatrix(nrow=3, ncol=1, free=c(F,T,T),
lbound=0.001, ubound=.99,
labels=paste0('i',1:3), name="initial"),
mxMatrix(nrow=length(classes), ncol=length(classes),
labels=paste0('t', 1:(length(classes) * length(classes))),
name="transition"),
mxExpectationHiddenMarkov(
components=sapply(classes, function(m) m$name),
initial="initial",
transition="transition", scale="softmax"),
mxFitFunctionML())

m1$transition$free[1:(length(classes)-1), 1:length(classes)] <- TRUE

m1 <- mxRun(m1)
summary(m1)
m1$expectation$output

But for most scenarios we have multiple subjects time series. My idea was to define the classes as random intercept models as multilevel models based on the time variables. Or should the HMM be define in another way with multiple subjects?

But when I define the model like this I get an error

Running hmm with 9 parameters
Error in runHelper(model, frontendStart, intervals, silent, suppressWarnings, :
hmm.fitfunction: component class1.fitfunction must be in probability units

Here is my model so far

dat <- rio::import("schizophrenia_markov.sav")
head(dat)

dat$time <- as.factor(dat$time)

nclass <- 2
class <- list()
for(cl in 1:nclass){
class[[cl]] <- mxModel(paste0("class",cl),
type='RAM',
mxModel(paste0('time',cl), type="RAM",
latentVars = c('time'),
mxData(data.frame(time=unique(dat$time)), 'raw', primaryKey='time'),
mxPath('time', arrows=2, values=1)),
manifestVars = c('DEP'),
mxData(dat[,c("DEP","time")], 'raw'),
mxPath('one', 'DEP'),
mxPath('DEP', arrows=2, values=1),
mxPath(paste0('time',cl,'.time'), 'DEP', values=1,
free=FALSE, joinKey='time'),
mxFitFunctionML(vector=TRUE)
)
}

hmm <- mxModel("hmm", class,
mxData(dat[,c("DEP","time")], 'raw'),
mxMatrix(nrow=length(class), ncol=1, free=c(F,T),
lbound=0.001, ubound=.999, values=1,
labels=paste0('i',1:length(class)),
name="initial"),
mxMatrix(nrow=length(class), ncol=length(class),
labels=paste0('t', 1:(length(class) * length(class))),
name="transition"),
mxExpectationHiddenMarkov(
components=sapply(class, function(m) m$name),
initial="initial",
transition="transition", scale="softmax"),
mxFitFunctionML())

hmm$transition$free[1:(length(class)-1), 1:length(class)] <- TRUE

hmmFit <- mxRun(hmm)
summary(hmmFit)

Thanks for all the help!

I was able to make the random intefcept mode work with the wide data format

library(tidyr)
library(OpenMx)

dat <- rio::import("schizophrenia_markov.sav")
head(dat)

###### random intercept SEM structure
dat$time <- as.factor(dat$time)

dat2 <- spread(dat[,c("ID","DEP","time")], key="time", value="DEP")
head(dat2)
colnames(dat2) <- c("ID", paste0("t",0:6))

dat3 <- data.frame(dat2[,2:8])

dataRaw <- mxData( observed=dat3, type="raw" )
vars <- colnames(dat3)
vars

nclass <- 2
class <- list()
for(cl in 1:nclass){
class[[cl]] <- mxModel(paste0("class",cl),
type="RAM",
latentVars = c("int"),
manifestVars=vars,
dataRaw,
mxPath( from="int", arrows=2,
free=T, values=1),
mxPath( from="one", to="int", arrows=1,
free=TRUE, values=1 ),
mxPath( from="int", to=vars, arrows=1,
free=F, values=1 ),
mxPath( from=vars, arrows=2,
free=T, values=rep(0, length(vars)),
labels=paste("e",cl),
lbound=0.001
),
mxPath( from="one", to=vars,
arrows=1,
free=F, values=rep(0, length(vars)),
labels=c(paste0("mean",cl,1:length(vars))) ),
mxFitFunctionML(vector=T)
)
}

hmm <- mxModel("hmm", class,
dataRaw,
mxMatrix(nrow=length(class), ncol=1, free=c(F,T),
lbound=0.0001, ubound=.9999,
values=1,
labels=paste0('i',1:length(class)),
name="initial"),
mxMatrix(nrow=length(class), ncol=length(class),
labels=paste0('t', 1:(length(class) * length(class))),
name="transition"),
mxExpectationHiddenMarkov(
components=sapply(class, function(m) m$name),
initial="initial",
transition="transition", scale="softmax"),
mxFitFunctionML())

hmm$transition$free[1:(length(class)-1), 1:length(class)] <- TRUE

hmmFit <- mxRun(hmm)
hmmFit <- mxTryHard(hmm, extraTries=50, maxMajorIter=5000, exhaustive=T)

summary(hmmFit)
hmmFit$expectation$output

But this is still not the model I am looking to replicate from HMM. As the model I am looking to replicate is to have multiple subjects with multiple time points. From here the "initial" would be the proportions in each latent class at the first time point, and the "transition" would be the transition between latent classes over time.
So, as another option I attempted to use the long format data, and add the time variable as second level predictor to the initial and transition. But this didnt work as I could only add the time predictor to the initial states and from the data, instead of the second level structure model (similar to this [post](https://github.com/OpenMx/OpenMx/blob/3cb6593af0754be134e107cf4f42315d8c18db2b/inst/models/passing/xxm-3.R) )

dat$time <- as.factor(dat$time)

nclass <- 2
class <- list()
for(cl in 1:nclass){
class[[cl]] <- mxModel(paste0("class",cl),
type='RAM',
manifestVars = c('DEP'),
mxData(dat[,c("DEP","time")], 'raw'),
mxPath('one', 'DEP'),
mxPath('DEP', arrows=2, values=1),
#mxPath(paste0('time',cl,'.time'), 'DEP', values=1,free=FALSE,joinKey='time'),
mxFitFunctionML(vector=TRUE)
)
}

hmm <- mxModel("hmm", class,
## MLM model structure
mxModel(paste0('time'), type="RAM",
latentVars = c('time'),
mxData(data.frame(time=unique(as.factor(dat$time))), 'raw',
primaryKey='time'),
mxPath('time', arrows=2, values=1)),
mxData(dat[,c("DEP","time")], 'raw'),
mxMatrix( type = "Full", nrow = 2, ncol = 2,
free=c(TRUE, FALSE,TRUE,TRUE), values=1,
labels = c("p11","p21", "p12", "p22"),
name = "initialM" ),
mxMatrix(nrow=2, ncol=1, labels=c(NA, "data.time"), values=1,
name="initialV"),#,joinKey='time'),
mxAlgebra(initialM %*% initialV, name="initial"),
mxMatrix(nrow=length(class), ncol=length(class),
labels=paste0('t', 1:(length(class) * length(class))),
name="transitionM"),
mxMatrix(nrow=2, ncol=2, labels=c("data.time", "data.time","data.time", "data.time"), values=1,
name="transitionV"),#,joinKey='time'),
mxAlgebra(transitionM %*% transitionV, name="transition"),
#mxPath('time.time', 'initial', free=FALSE, values=1, joinKey="time"),
mxExpectationHiddenMarkov(
components=sapply(class, function(m) m$name),
initial="initial",
transition="transition", scale="softmax"),
mxFitFunctionML())

hmm$transitionM$free[1:(length(class)-1), 1:length(class)] <- TRUE

hmmFit <- mxTryHard(hmm, extraTries=50, maxMajorIter=5000, exhaustive=T)

summary(hmmFit)
hmmFit$expectation$output

From the **schizophrenia_markov.sav**, the results I am trying to rplicate are
Initial states
Class[=0]
1 2
0.9919 0.0081

Transitions
Class
Class[-1] 1 2
1 0.8351 0.1649
2 0.0013 0.9987

Not sure how to set up the **mxExpectationHiddenMarkov()** correctly here

Appreciate the help

Trying to apply the multilevel structure in the HMM for estimation with multiple subjects and multiple time points