[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