[Depmix-commits] r147 - in trunk: R tests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jun 10 15:14:36 CEST 2008


Author: ingmarvisser
Date: 2008-06-10 15:14:35 +0200 (Tue, 10 Jun 2008)
New Revision: 147

Removed:
   trunk/R/viterbi.R
   trunk/R/viterbi.fb.R
Modified:
   trunk/tests/depmixNew-test2.R
Log:
Removed two of three viterbi versions

Deleted: trunk/R/viterbi.R
===================================================================
--- trunk/R/viterbi.R	2008-06-10 12:34:29 UTC (rev 146)
+++ trunk/R/viterbi.R	2008-06-10 13:14:35 UTC (rev 147)
@@ -1,56 +0,0 @@
-# 
-# Maarten Speekenbrink, 23-3-2008
-# 
-
-viterbi <- function(object) {
-	# returns the most likely state sequence
-	nt <- sum(object at ntimes)
-	lt <- length(object at ntimes)
-	et <- cumsum(object at ntimes)
-	bt <- c(1,et[-lt]+1)
-		
-	ns <- object at nstates
-	
-	delta <- psi <- matrix(nrow=nt,ncol=ns)
-	state <- vector(length=nt)
-	
-	prior <- object at init
-	
-    A <- object at trDens
-	B <- apply(log(object at dens),c(1,3),sum)
-	
-	for(case in 1:lt) {
-		# initialization
-		delta[bt[case],] <- - (log(prior[case,]) + B[bt[case],])
-		psi[bt[case],] <- 0
-		# recursion
-		if(object at ntimes[case]>1) {
-			for(i in ((bt[case]+1):et[case])) {
-				for(j in 1:ns) {
-					if(!object at stationary) {
-						delta[i,j] <- min(delta[i-1,] - log(A[i,,j])) - B[i,j]
-						k <- which.min(delta[i-1,] - log(A[i,,j]))
-					} else {
-						delta[i,j] <- min(delta[i-1,] - log(A[,,j])) - B[i,j]
-						k <- which.min(delta[i-1,] - log(A[,,j]))
-					}
-					if(length(k) == 0) k <- 0
-					psi[i,j] <- k
-				}
-			}
-		}
-		
-		# trace maximum likely state
-		state[et[case]] <- which.min(delta[et[case],])
-		
-		# this doesn't need a for loop does it???? FIX ME	  
-		if(object at ntimes[case]>1) {
-			for(i in (et[case]-1):bt[case]) {
-				state[i] <- psi[i+1,state[i+1]]
-			}
-		}
-	}
-	
-	delta <- data.frame(state,delta) 
-	return(delta)
-}

Deleted: trunk/R/viterbi.fb.R
===================================================================
--- trunk/R/viterbi.fb.R	2008-06-10 12:34:29 UTC (rev 146)
+++ trunk/R/viterbi.fb.R	2008-06-10 13:14:35 UTC (rev 147)
@@ -1,31 +0,0 @@
-# 
-# Maarten Speekenbrink, 23-3-2008
-# 
-
-viterbi.fb <-
-function(A,B,prior) {
-    # returns the most likely state sequence
-    nt <- nrow(B)
-    ns <- ncol(A)
-    delta <- psi <- matrix(nrow=nt,ncol=ns)
-    state <- vector(length=nt)
-    # initialization
-    delta[1,] <- - (log(prior) + log(B[1,]))
-    psi[1,] <- 0
-    # recursion
-    for(i in 2:nt) {
-        for(j in 1:ns) {
-            delta[i,j] <- min(delta[i-1,] - log(A[,j])) - log(B[i,j])
-            k <- which.min(delta[i-1,] - log(A[,j]))
-            if(length(k) == 0) k <- 0
-            psi[i,j] <- k
-        }
-    }
-    # trace maximum likely state
-    state[nt] <- which.min(delta[nt,])
-    for(i in (nt-1):1) {
-        state[i] <- psi[i+1,state[i+1]]
-    }
-    return(state)
-}
-

Modified: trunk/tests/depmixNew-test2.R
===================================================================
--- trunk/tests/depmixNew-test2.R	2008-06-10 12:34:29 UTC (rev 146)
+++ trunk/tests/depmixNew-test2.R	2008-06-10 13:14:35 UTC (rev 147)
@@ -1,10 +1,7 @@
 
 # 
-# Started by Ingmar Visser & Maarten Speekenbrink, march 2008
+# Ingmar Visser & Maarten Speekenbrink, march 2008
 # 
-# Usage: go to trunk directory and source this file in R, if the program
-# still works it should return TRUE at every test (or make immediate sense
-# otherwise)
 
 # 
 # test model with EM optimization, no covariates
@@ -15,17 +12,14 @@
 data(speed)
 
 trstart=c(0.899,0.101,0.084,0.916)
-instart=c(0.5,0.5)
-resp <- c(5.52,0.202,0.472,0.528,6.39,0.24,0.098,0.902)
-
 mod <- depmix(list(rt~1,corr~1),data=speed,nstates=2,family=list(gaussian(),multinomial()),trstart=trstart)
-# 	respstart=resp,trstart=trstart,instart=instart)
 
+# logLik before fitting
 logLik(mod)
-
 mod1 <- fit(mod)
+# logLik after fitting
+logLik(mod1)
 
-ll <- logLik(mod1)
 
 # 
 # Test optimization using Rdonlp2


More information about the depmix-commits mailing list