[Depmix-commits] r535 - in pkg/depmixS4: R man

[noreply at r-forge.r-project.org]

Author: maarten
Date: 2012-06-22 21:16:36 +0200 (Fri, 22 Jun 2012)
New Revision: 535

Modified:
   pkg/depmixS4/R/EM.R
   pkg/depmixS4/man/depmix.Rd
Log:
- in EM with hard classification: needed to explicitly set factor levels in formula for computation of gamma.
-changed example slightly (seemed to give problems without defining the model again)

Modified: pkg/depmixS4/R/EM.R
===================================================================
--- pkg/depmixS4/R/EM.R	2012-06-22 18:55:28 UTC (rev 534)
+++ pkg/depmixS4/R/EM.R	2012-06-22 19:16:36 UTC (rev 535)
@@ -221,7 +221,7 @@
 	  if(clsf == "hard") {
 	    fbo <- list()
 		  vstate <- viterbi(object)[,1]
-		  fbo$gamma <- as.matrix(model.matrix(~ factor(vstate) - 1))
+		  fbo$gamma <- as.matrix(model.matrix(~ factor(vstate,levels=1:ns) - 1))
 		  fbo$xi <- array(0,dim=c(sum(ntimes),ns,ns))
 		  fbo$xi[cbind(1:(sum(ntimes)- 1),vstate[-1],vstate[-length(vstate)])] <- 1
 		  fbo$logLike <- sum(log((apply(object at dens,c(1,3),prod))[cbind(1:sum(ntimes),vstate)]))
@@ -237,7 +237,7 @@
 	  if(clsf == "hard") {
 	    fbo <- list()
 		  vstate <- viterbi(object)[,1]
-		  fbo$gamma <- as.matrix(model.matrix(~ factor(vstate) - 1))
+		  fbo$gamma <- as.matrix(model.matrix(~ factor(vstate,levels=1:ns) - 1))
 		  fbo$xi <- array(0,dim=c(sum(ntimes),ns,ns))
 		  fbo$xi[cbind(1:(sum(ntimes)- 1),vstate[-1],vstate[-length(vstate)])] <- 1
 		  fbo$logLike <- sum(log((apply(object at dens,c(1,3),prod))[cbind(1:sum(ntimes),vstate)]))
@@ -292,7 +292,7 @@
 		
 		if(clsf == "hard") {
 		  vstate <- viterbi(object)[,1]
-		  fbo$gamma <- as.matrix(model.matrix(~ factor(vstate) - 1))
+		  fbo$gamma <- as.matrix(model.matrix(~ factor(vstate,levels=1:ns) - 1))
 		  fbo$xi <- array(0,dim=c(sum(ntimes),ns,ns))
 		  fbo$xi[cbind(1:(sum(ntimes)- 1),vstate[-1],vstate[-length(vstate)])] <- 1
 		  fbo$logLike <- sum(log((apply(object at dens,c(1,3),prod))[cbind(1:sum(ntimes),vstate)]))

Modified: pkg/depmixS4/man/depmix.Rd
===================================================================
--- pkg/depmixS4/man/depmix.Rd	2012-06-22 18:55:28 UTC (rev 534)
+++ pkg/depmixS4/man/depmix.Rd	2012-06-22 19:16:36 UTC (rev 535)
@@ -258,6 +258,9 @@
 # using "hard" assignment of observations to the states, we can maximise the
 # classification likelihood instead of the usual marginal likelihood
 # (this example uses the model at the start of these examples)
+data(speed)	
+mod <- depmix(list(rt~1,corr~1),data=speed,nstates=2,
+    family=list(gaussian(),multinomial("identity")),ntimes=c(168,134,137))
 set.seed(1)
 # fit the model by calling fit
 fm3 <- fit(mod,emcontrol=em.control(classification="hard"))