[Depmix-commits] r482 - pkg/depmixS4/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jun 23 22:50:17 CEST 2011


Author: ingmarvisser
Date: 2011-06-23 22:50:17 +0200 (Thu, 23 Jun 2011)
New Revision: 482

Modified:
   pkg/depmixS4/R/fb.R
Log:
Removed call to C-code for apply.

Modified: pkg/depmixS4/R/fb.R
===================================================================
--- pkg/depmixS4/R/fb.R	2011-06-23 08:40:15 UTC (rev 481)
+++ pkg/depmixS4/R/fb.R	2011-06-23 20:50:17 UTC (rev 482)
@@ -19,19 +19,23 @@
 	
 	# NOTE: xi[t,i,j] = P(S[t] = j & S[t+1] = i) !!!NOTE the order of i and j!!!
 	
-# 	B <- apply(B,c(1,3),prod)
-	
-	bin <- array(0,dim=dim(B)[c(1,3)])
-	res <- .C("ddens",
-		as.double(B),
-		B=as.double(bin),
-		dim=dim(B),
-		package="depmixS4")[c("B")]
-	B <- matrix(res$B,nc=2,byrow=TRUE)
-	
 	nt <- nrow(B)	
 	ns <- ncol(init)
 	
+# 	print(head(B))
+# 	
+# 	bin <- array(0,dim=dim(B)[c(1,3)])
+# 	res <- .C("ddens",
+# 		as.double(B),
+# 		out=as.double(bin),
+# 		dim=dim(B),
+# 		package="depmixS4")[c("out")]
+# 	B <- matrix(res$out,nc=ns,byrow=TRUE)
+# 	
+# 	print(head(B))
+	
+	B <- apply(B,c(1,3),prod)
+	
 	if(is.null(ntimes)) ntimes <- nt
 	
 	lt <- length(ntimes)


More information about the depmix-commits mailing list