[Depmix-commits] r148 - trunk/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jun 10 15:16:51 CEST 2008


Author: ingmarvisser
Date: 2008-06-10 15:16:50 +0200 (Tue, 10 Jun 2008)
New Revision: 148

Added:
   trunk/R/viterbi.R
Removed:
   trunk/R/viterbi2.R
Modified:
   trunk/R/depmixfit.R
Log:
Renamed veterbi2.R to viterbi.R (this is the one in use)

Modified: trunk/R/depmixfit.R
===================================================================
--- trunk/R/depmixfit.R	2008-06-10 13:14:35 UTC (rev 147)
+++ trunk/R/depmixfit.R	2008-06-10 13:16:50 UTC (rev 148)
@@ -118,7 +118,7 @@
 			
 		}
 		
-		object at posterior <- viterbi2(object)
+		object at posterior <- viterbi(object)
 		
 		return(object)
 	}
Copied: trunk/R/viterbi.R (from rev 144, trunk/R/viterbi2.R)
===================================================================
--- trunk/R/viterbi.R	                        (rev 0)
+++ trunk/R/viterbi.R	2008-06-10 13:16:50 UTC (rev 148)
@@ -0,0 +1,60 @@
+# 
+# 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((object at dens),c(1,3),prod)
+	
+	for(case in 1:lt) {
+		# initialization
+		delta[bt[case],] <- prior[case,]*B[bt[case],]
+		delta[bt[case],] <- delta[bt[case],]/(sum(delta[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] <- max(delta[i-1,]*(A[i,,j]))*B[i,j]
+						k <- which.max(delta[i-1,]*A[i,,j])
+					} else {
+						delta[i,j] <- max(delta[i-1,]*A[,,j])*B[i,j]
+						k <- which.max(delta[i-1,]*A[,,j])
+					}
+					if(length(k) == 0) k <- 0
+					psi[i,j] <- k
+				}
+				delta[i,] <- delta[i,]/(sum(delta[i,]))
+			}
+		}
+		
+		# trace maximum likely state
+		state[et[case]] <- which.max(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/viterbi2.R
===================================================================
--- trunk/R/viterbi2.R	2008-06-10 13:14:35 UTC (rev 147)
+++ trunk/R/viterbi2.R	2008-06-10 13:16:50 UTC (rev 148)
@@ -1,60 +0,0 @@
-# 
-# Maarten Speekenbrink, 23-3-2008
-# 
-
-viterbi2 <-
-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((object at dens),c(1,3),prod)
-	
-	for(case in 1:lt) {
-		# initialization
-		delta[bt[case],] <- prior[case,]*B[bt[case],]
-		delta[bt[case],] <- delta[bt[case],]/(sum(delta[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] <- max(delta[i-1,]*(A[i,,j]))*B[i,j]
-						k <- which.max(delta[i-1,]*A[i,,j])
-					} else {
-						delta[i,j] <- max(delta[i-1,]*A[,,j])*B[i,j]
-						k <- which.max(delta[i-1,]*A[,,j])
-					}
-					if(length(k) == 0) k <- 0
-					psi[i,j] <- k
-				}
-				delta[i,] <- delta[i,]/(sum(delta[i,]))
-			}
-		}
-		
-		# trace maximum likely state
-		state[et[case]] <- which.max(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)
-}
-



More information about the depmix-commits mailing list