[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