[Depmix-commits] r480 - in pkg/depmixS4: R src

[noreply at r-forge.r-project.org]

Author: ingmarvisser
Date: 2011-06-22 22:23:51 +0200 (Wed, 22 Jun 2011)
New Revision: 480

Modified:
   pkg/depmixS4/R/fb.R
   pkg/depmixS4/src/ddens.cc
Log:
Added now working C-code to replace an often apply'd call to flatten an array into a matrix in function fb (5-fold improvement for this operation, but total time savings is limited).

Modified: pkg/depmixS4/R/fb.R
===================================================================
--- pkg/depmixS4/R/fb.R	2011-06-22 13:18:25 UTC (rev 479)
+++ pkg/depmixS4/R/fb.R	2011-06-22 20:23:51 UTC (rev 480)
@@ -19,8 +19,16 @@
 	
 	# 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)
+# 	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)
 	
Modified: pkg/depmixS4/src/ddens.cc
===================================================================
--- pkg/depmixS4/src/ddens.cc	2011-06-22 13:18:25 UTC (rev 479)
+++ pkg/depmixS4/src/ddens.cc	2011-06-22 20:23:51 UTC (rev 480)
@@ -4,20 +4,20 @@
 
 void ddens(double *dens, double *res, int *dim) {
 	
-	Rprintf("dim 0: %d \n", dim[0]);
-	Rprintf("dim 1: %d \n", dim[1]);
-	Rprintf("dim 2: %d \n", dim[2]);
+// 	Rprintf("dim 0: %d \n", dim[0]);
+// 	Rprintf("dim 1: %d \n", dim[1]);
+// 	Rprintf("dim 2: %d \n", dim[2]);
 	
 	for(int t=0; t<dim[0]; t++) {
-		Rprintf("t: %d \n", t);
+// 		Rprintf("t: %d \n", t);
 		for(int i=0; i<dim[1]; i++) {
-			Rprintf("i: %d \n", i);
+// 			Rprintf("i: %d \n", i);
 			res[t*dim[2]+i] = dens[i*dim[0]*dim[2]+t];
-			Rprintf("dens %f \n", dens[i*dim[0]*dim[2]+t]);
+// 			Rprintf("dens %f \n", dens[i*dim[0]*dim[2]+t]);
 			for(int j=1; j<dim[2]; j++) {
-				Rprintf("j: %d \n", j);
-				res[t*dim[2]+i] *= dens[i*dim[0]*dim[2]+j*dim[1]+t];
-				Rprintf("dens %f \n", dens[i*dim[0]*dim[2]+j*dim[1]+t]);
+// 				Rprintf("j: %d \n", j);
+				res[t*dim[2]+i] *= dens[i*dim[0]*dim[2]+j*dim[0]+t];
+// 				Rprintf("dens %f \n", dens[i*dim[0]*dim[2]+j*dim[0]+t]);
 				
 			}
 		}