[Depmix-commits] r88 - in trunk: . R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Mar 18 17:22:11 CET 2008


Author: ingmarvisser
Date: 2008-03-18 17:22:11 +0100 (Tue, 18 Mar 2008)
New Revision: 88

Modified:
   trunk/NAMESPACE
   trunk/R/allGenerics.R
   trunk/R/depmix.R
   trunk/R/depmix.fitted.R
   trunk/depmixNew-test1.R
   trunk/depmixNew-test2.R
   trunk/depmixNew-test3.R
Log:
Updated test files and other minor changes

Modified: trunk/NAMESPACE
===================================================================
--- trunk/NAMESPACE	2008-03-18 15:35:08 UTC (rev 87)
+++ trunk/NAMESPACE	2008-03-18 16:22:11 UTC (rev 88)
@@ -3,9 +3,11 @@
 importFrom(stats, predict)
 importFrom(stats4, AIC, BIC, logLik, plot, summary)
 
-export(
+export(	
+	makeDepmix,
 	lystig,
 	fb,
+	llratio,
 	multinomial,
 	mlogit
 )

Modified: trunk/R/allGenerics.R
===================================================================
--- trunk/R/allGenerics.R	2008-03-18 15:35:08 UTC (rev 87)
+++ trunk/R/allGenerics.R	2008-03-18 16:22:11 UTC (rev 88)
@@ -14,6 +14,12 @@
 setGeneric("depmix", function(response,data=NULL,nstates,transition=~1,family=gaussian(),prior=~1,initdata=NULL,
 		respstart=NULL,trstart=NULL,instart=NULL,ntimes=NULL, ...) standardGeneric("depmix"))
 
+setGeneric("GLMresponse", function(formula, data = NULL, family = gaussian(), pstart =
+                 NULL, fixed = NULL, prob=TRUE, ...) standardGeneric("GLMresponse"))
+
+setGeneric("transInit", function(formula, nstates, data = NULL, family = multinomial(),
+                 pstart = NULL, fixed = NULL, prob=TRUE, ...) standardGeneric("transInit"))
+
 setGeneric("npar", function(object, ...) standardGeneric("npar"))
 
 setGeneric("nobs", function(object, ...) standardGeneric("nobs"))
@@ -38,12 +44,6 @@
 
 setGeneric("getdf",function(object) standardGeneric("getdf"))
 
-setGeneric("GLMresponse", function(formula, data = NULL, family = gaussian(), pstart =
-                 NULL, fixed = NULL, prob=TRUE, ...) standardGeneric("GLMresponse"))
-
-setGeneric("transInit", function(formula, nstates, data = NULL, family = multinomial(),
-                 pstart = NULL, fixed = NULL, prob=TRUE, ...) standardGeneric("transInit"))
-
 setGeneric("setpars", function(object,values,which="pars",...) standardGeneric("setpars"))
 
 setGeneric("getpars", function(object,which="pars",...) standardGeneric("getpars"))
@@ -54,3 +54,4 @@
 
 setGeneric("dens",function(object,...) standardGeneric("dens"))
 
+setGeneric("summary")

Modified: trunk/R/depmix.R
===================================================================
--- trunk/R/depmix.R	2008-03-18 15:35:08 UTC (rev 87)
+++ trunk/R/depmix.R	2008-03-18 16:22:11 UTC (rev 88)
@@ -85,8 +85,8 @@
 
 setMethod("depmix",
 	signature(response="ANY"),
-	function(response,data=NULL,nstates,transition=~1,family=gaussian(),prior=~1,initdata=NULL,
-		respstart=NULL,trstart=NULL,instart=NULL,ntimes=NULL, ...) {
+	function(response, data=NULL, nstates, transition=~1, family=gaussian(), prior=~1, initdata=NULL,
+		respstart=NULL, trstart=NULL, instart=NULL, ntimes=NULL, ...) {
 		
 		if(is.null(data)) {
 			if(is.null(ntimes)) stop("'ntimes' must be provided if not in the data")
@@ -168,7 +168,8 @@
 
 makeTransModels <- function(nstates,formula=~1,data=NULL,stationary,values=NULL, ...) {
 	
-	# defaults that possibly need some work at some point FIX ME
+	# defaults that possibly need some work at some point 
+	# FIX ME
 	base=1
 	prob=TRUE
 		

Modified: trunk/R/depmix.fitted.R
===================================================================
--- trunk/R/depmix.fitted.R	2008-03-18 15:35:08 UTC (rev 87)
+++ trunk/R/depmix.fitted.R	2008-03-18 16:22:11 UTC (rev 88)
@@ -166,7 +166,7 @@
 		cat("Convergence info:",object at message,"\n")
 		print(logLik(object))
 		cat("AIC: ", AIC(object),"\n")
-		cat("BIC: ", AIC(object),"\n")
+		cat("BIC: ", BIC(object),"\n")
 	}
 )
 
Modified: trunk/depmixNew-test1.R
===================================================================
--- trunk/depmixNew-test1.R	2008-03-18 15:35:08 UTC (rev 87)
+++ trunk/depmixNew-test1.R	2008-03-18 16:22:11 UTC (rev 88)
@@ -14,13 +14,6 @@
 # Other tests with optimization of models are moved to depmix-test2.R
 # 
 
-setwd("/Users/ivisser/Documents/projects/depmixProject/depmixNew/rforge/depmix/trunk/")
-
-source("R/responses.R")
-source("R/depmix.R")
-
-load("data/speed.Rda")
-
 # 
 # TEST 1: speed data model with optimal parameters, compute the likelihood
 # 
@@ -47,7 +40,7 @@
 instart=c(0,1)
 inMod <- transInit(~1,ns=2,ps=instart,data=data.frame(rep(1,3)))
 
-mod <- depmix(response=rModels,transition=transition,prior=inMod,ntimes=attr(speed,"ntimes"))
+mod <- makeDepmix(response=rModels,transition=transition,prior=inMod,ntimes=attr(speed,"ntimes"))
 
 ll <- logLik(mod)
 ll.fb <- logLik(mod,method="fb")
@@ -61,10 +54,13 @@
 # model specification made easy
 # 
 
+library(depmixS4)
+
 resp <- c(5.52,0.202,0.472,0.528,6.39,0.24,0.098,0.902)
+trstart=c(0.899,0.101,0.084,0.916)
+instart=c(0,1)
+mod <- depmix(list(rt~1,corr~1),data=speed,nstates=2,family=list(gaussian(),multinomial()),respstart=resp,trstart=trstart,instart=instart,prob=T)
 
-mod <- depmix(list(rt~1,corr~1),data=speed,nstates=2,family=list(gaussian(),multinomial()),respstart=resp,trstart=trstart,instart=instart)
-
 ll2 <- logLik(mod)
 
 cat("Test 1b: ", all.equal(c(ll),c(ll2),check.att=FALSE), "(loglike of speed data) \n")
@@ -126,7 +122,8 @@
 ll <- logLik(mod)
 
 cat("Test 4: ll is now larger than speedll, ie ll is better due to introduction of a covariate \n")
-cat("Test 4: ", ll,"\t", speedll, "\n")
+cat("Test 4: ", ll,"\t", logl, "\n")
+cat("Test 4: ", ll > logl, "\n")
 
 
 # 

Modified: trunk/depmixNew-test2.R
===================================================================
--- trunk/depmixNew-test2.R	2008-03-18 15:35:08 UTC (rev 87)
+++ trunk/depmixNew-test2.R	2008-03-18 16:22:11 UTC (rev 88)
@@ -6,19 +6,6 @@
 # still works it should return TRUE at every test (or make immediate sense
 # otherwise)
 
-
-setwd("/Users/ivisser/Documents/projects/depmixProject/depmixNew/rforge/depmix/trunk/")
-
-source("R/responses.R")
-source("R/depmix.R")
-source("R/depmix.fitted.R")
-source("R/llratio.R")
-source("R/EM.R")
-source("R/lystig.R")
-source("R/fb.R")
-
-load("data/speed.Rda")
-
 set.seed(1)
 mod <- depmix(rt~1,data=speed,nstates=2,trstart=runif(4))
 logLik(mod)
@@ -26,9 +13,6 @@
 
 ll <- logLik(mod1)
 
-
-
-
 # 
 # test model with EM optimization, no covariates
 # 
Modified: trunk/depmixNew-test3.R
===================================================================
--- trunk/depmixNew-test3.R	2008-03-18 15:35:08 UTC (rev 87)
+++ trunk/depmixNew-test3.R	2008-03-18 16:22:11 UTC (rev 88)
@@ -9,18 +9,8 @@
 # BALANCE SCALE data example with age as covariate on class membership
 # 
 
-setwd("/Users/ivisser/Documents/projects/depmixProject/depmixNew/rforge/depmix/trunk/")
+data(balance)
 
-load("data/balance.rda")
-
-source("R/responses.R")
-source("R/depmix.R")
-source("R/depmix.fitted.R")
-source("R/llratio.R")
-source("R/lystig.R")
-source("R/fb.R")
-source("R/EM.R")
-
 # now fit some latent class models
 trstart=c(1,0,0,1)
 instart=c(0.5,0.5)
@@ -57,9 +47,11 @@
 fixed <- c(1,0,1,0,1,1,1,1,rep(c(1,0),8))
 mod3 <- fit(mod2,fixed=fixed)
 
+llratio(mod3,mod1)
+
+
 mod4 <- fit(mod2,fixed=fixed,method="donlp")
 
-llratio(mod3,mod1)
 
 
 



More information about the depmix-commits mailing list