[Depmix-commits] r62 - trunk

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Mar 7 13:56:05 CET 2008


Author: ingmarvisser
Date: 2008-03-07 13:56:05 +0100 (Fri, 07 Mar 2008)
New Revision: 62

Modified:
   trunk/depmixNew-test3.R
Log:
Updated balance scale example to work with EM

Modified: trunk/depmixNew-test3.R
===================================================================
--- trunk/depmixNew-test3.R	2008-03-07 10:51:11 UTC (rev 61)
+++ trunk/depmixNew-test3.R	2008-03-07 12:56:05 UTC (rev 62)
@@ -20,6 +20,7 @@
 source("llratio.R")
 source("lystig.R")
 source("fb.R")
+source("EM.R")
 
 # now fit some latent class models
 trstart=c(1,0,0,1)
@@ -27,9 +28,11 @@
 
 # ntimes is added as an argument
 
+respstart=runif(16)
 mod <- depmix(list(d1~1,d2~1,d3~1,d4~1), data=balance, nstates=2,
 	family=list(multinomial(),multinomial(),multinomial(),multinomial()),
-	trstart=trstart,instart=instart,ntimes=rep(1,nrow(balance)))
+	respstart=respstart,trstart=trstart,instart=instart,
+	ntimes=rep(1,nrow(balance)))
 
 pars <- getpars(mod)
 fixed <- c(1,0,1,1,1,1,rep(c(1,0),8))
@@ -46,54 +49,41 @@
 # Add age as covariate on class membership
 # 
 
-instart=c(0.5,0.5,0,0)
-mod2 <- depmix(list(d1~1,d2~1,d3~1,d4~1), data=balance, nstates=2,
-	family=list(multinomial(),multinomial(),multinomial(),multinomial()),
-	trstart=trstart, instart=instart, ntimes=rep(1,nrow(balance)), 
-	prior=~age, initdata=balance)
+setwd("/Users/ivisser/Documents/projects/depmixProject/depmixNew/rforge/depmix/trunk/")
 
-fixed <- c(1,0,1,0,1,1,1,1,rep(c(1,0),8))
-mod2 <- fit(mod2,fixed=fixed)
+load("data/balance.rda")
 
-logLik(mod2)
-AIC(mod2)
-BIC(mod2)
+source("responses.R")
+source("depmix.R")
+source("depmix.fitted.R")
 
-llratio(mod2,mod1)
+source("llratio.R")
+source("lystig.R")
+source("fb.R")
+source("EM.R")
 
+# source("responses.R")
 
-predict(mod2 at response[[1]][[1]])[1,]
-predict(mod2 at response[[1]][[2]])[1,]
-predict(mod2 at response[[1]][[3]])[1,]
-predict(mod2 at response[[1]][[4]])[1,]
+# respstart=getpars(mod)[7:22]
+# 
+# invlogit <- function(x) {
+# 	exp(x)/(1+exp(x))
+# }
+# respstart[1:8*2] <- sapply(respstart[1:8*2],invlogit)
+instart=c(0.5,0.5,0,0)
+respstart=c(rep(c(0.1,0.9),4),rep(c(0.9,0.1),4))
+trstart=c(1,0,0,1)
+mod2 <- depmix(list(d1~1,d2~1,d3~1,d4~1), data=balance, nstates=2,
+	family=list(multinomial(),multinomial(),multinomial(),multinomial()),
+	trstart=trstart, instart=instart, respstart=respstart,
+	ntimes=rep(1,nrow(balance)), prior=~age, initdata=balance)
 
-predict(mod2 at response[[2]][[1]])[1,]
-predict(mod2 at response[[2]][[2]])[1,]
-predict(mod2 at response[[2]][[3]])[1,]
-predict(mod2 at response[[2]][[4]])[1,]
+fixed <- c(1,0,1,0,1,1,1,1,rep(c(1,0),8))
+mod3 <- fit(mod2,fixed=fixed)
 
+mod4 <- fit(mod2,fixed=fixed,method="donlp")
 
-plot.multinomial <- function(object,var=1) {	
-	base=1
-	coef <- object at parameters$coefficients[,-base]
-	print(coef)
-	range=range(object at x[,2])
-	print(range) 
-	linv <- function(x) {
-		invlogit(coef[2]*(x+coef[1]))
-	}
-	plot(linv,xlim=range)
-	return(range)
-}
+llratio(mod3,mod1)
 
-logit <- function(p) {
-	log(p/(1-p))
-}
 
-invlogit <- function(x) {
-	exp(x)/(1+exp(x))
-}
 
-
-
-



More information about the depmix-commits mailing list