[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