[Depmix-commits] r59 - trunk
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 7 10:22:06 CET 2008
Author: ingmarvisser
Date: 2008-03-07 10:22:06 +0100 (Fri, 07 Mar 2008)
New Revision: 59
Added:
trunk/viterbi.R
Removed:
trunk/viterbi2.R
Log:
Renamed viterbi to .R instead of .r
Copied: trunk/viterbi.R (from rev 58, trunk/viterbi2.R)
===================================================================
--- trunk/viterbi.R (rev 0)
+++ trunk/viterbi.R 2008-03-07 09:22:06 UTC (rev 59)
@@ -0,0 +1,64 @@
+viterbi <- function(hmm) {
+ # returns the most likely state sequence
+ nt <- sum(hmm at ntimes)
+ lt <- length(hmm at ntimes)
+ et <- cumsum(hmm at ntimes)
+ bt <- c(1,et[-lt]+1)
+
+ ns <- hmm at nstates
+
+ delta <- psi <- matrix(nrow=nt,ncol=ns)
+ state <- vector(length=nt)
+
+ prior <- exp(logDens(hmm at initModel))
+
+ A <- hmm at trans
+ B <- apply(hmm at logdens,c(1,3),sum)
+
+ for(case in 1:lt) {
+ # initialization
+ delta[bt[case],] <- - (log(prior[case,]) + B[bt[case],])
+ psi[bt[case],] <- 0
+ # recursion
+ for(i in ((bt[case]+1):et[case])) {
+ for(j in 1:ns) {
+ delta[i,j] <- min(delta[i-1,] - log(A[i,,j])) - B[i,j]
+ k <- which.min(delta[i-1,] - log(A[i,,j]))
+ if(length(k) == 0) k <- 0
+ psi[i,j] <- k
+ }
+ }
+ #trace maximum likely state
+ state[et[case]] <- which.min(delta[et[case],])
+ for(i in (et[case]-1):bt[case]) {
+ state[i] <- psi[i+1,state[i+1]]
+ }
+ }
+ return(state)
+}
+
+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)
+}
\ No newline at end of file
Deleted: trunk/viterbi2.R
===================================================================
--- trunk/viterbi2.R 2008-03-07 09:21:34 UTC (rev 58)
+++ trunk/viterbi2.R 2008-03-07 09:22:06 UTC (rev 59)
@@ -1,64 +0,0 @@
-viterbi <- function(hmm) {
- # returns the most likely state sequence
- nt <- sum(hmm at ntimes)
- lt <- length(hmm at ntimes)
- et <- cumsum(hmm at ntimes)
- bt <- c(1,et[-lt]+1)
-
- ns <- hmm at nstates
-
- delta <- psi <- matrix(nrow=nt,ncol=ns)
- state <- vector(length=nt)
-
- prior <- exp(logDens(hmm at initModel))
-
- A <- hmm at trans
- B <- apply(hmm at logdens,c(1,3),sum)
-
- for(case in 1:lt) {
- # initialization
- delta[bt[case],] <- - (log(prior[case,]) + B[bt[case],])
- psi[bt[case],] <- 0
- # recursion
- for(i in ((bt[case]+1):et[case])) {
- for(j in 1:ns) {
- delta[i,j] <- min(delta[i-1,] - log(A[i,,j])) - B[i,j]
- k <- which.min(delta[i-1,] - log(A[i,,j]))
- if(length(k) == 0) k <- 0
- psi[i,j] <- k
- }
- }
- #trace maximum likely state
- state[et[case]] <- which.min(delta[et[case],])
- for(i in (et[case]-1):bt[case]) {
- state[i] <- psi[i+1,state[i+1]]
- }
- }
- return(state)
-}
-
-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)
-}
\ No newline at end of file
More information about the depmix-commits
mailing list