update

Author: snoweye

DESCRIPTION

@@ -25,7 +25,7 @@ URL: http://r-pbd.org/
 BugReports: http://group.r-pbd.org/
 MailingList: Please send questions and comments regarding pbdR to
         [email protected]
-Packaged: 2013-06-25 18:48:18 UTC; snoweye
+Packaged: 2013-06-27 20:30:11 UTC; snoweye
 Author: Wei-Chen Chen [aut, cre],
   George Ostrouchov [aut]
 Maintainer: Wei-Chen Chen <[email protected]>

R/01_as_dmat.r

@@ -6,9 +6,10 @@ as.dmat <- function(X.spmd, bldim = .BLDIM, ICTXT = .ICTXT,
 
   N.spmd <- nrow(X.spmd)
   p <- ncol(X.spmd)
-  N <- spmd.allreduce.integer(N.spmd, integer(1), op = "sum")
-
-  X.dmat <- ddmatrix(0, N, p, bldim = c(N.spmd, p), CTXT = 2)
+  N <- spmd.allreduce.integer(N.spmd, integer(1), op = "sum", comm = comm)
+  N.block.row <- spmd.allreduce.integer(N.spmd, integer(1), op = "max",
+                                        comm = comm)
+  X.dmat <- ddmatrix(0, N, p, bldim = c(N.block.row, p), ICTXT = 2)
   X.dmat@Data <- X.spmd
   X.dmat <- redistribute(X.dmat, bldim = bldim, ICTXT = ICTXT)
 

R/dmat_00_readme.r

@@ -27,7 +27,7 @@ cat('
 #   W.dmat: double ddmatrix[N, K], conditional log posterior probability.
 #   W.dmat.rowSums: double ddmatrix[N, 1], log density for each observations.
 #   U.dmat: double ddmatrix[N, K], W.spmd plus log eta.
-#   CLASS.dmat: double ddmatrix[N, 1], classification of observations.
+#   CLASS: double ddmatrix[N, 1], classification of observations.
 #   CHECK: list[4], for output.
 #     - algorithm: string[1], "em.dmat" or "kmeans.dmat".
 #     - i.iter: integer[1], current iteration.
@@ -56,7 +56,7 @@ cat('
 
 ### Output: 
 # (different)
-#   CLASS.dmat
+#   CLASS
 # (rank = 0, only, identical)
 #   PARAM, CHECK
 ')

R/dmat_em_base.r

@@ -337,10 +337,11 @@ em.onestep.dmat <- function(PARAM){
 ### Obtain classifications.
 em.update.class.dmat <- function(){
   ### WCC: original
-  .pmclustEnv$CLASS.dmat <- apply(.pmclustEnv$Z.dmat, 1, which.max)
+  # .pmclustEnv$CLASS.dmat <- apply(.pmclustEnv$Z.dmat, 1, which.max)
   ### WCC: temp dmat
-  # tmp.1 <- apply(.pmclustEnv$Z.dmat, 1, which.max)
-  # .pmclustEnv$CLASS.dmat <- tmp.1 
+  tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
+  tmp.2 <- unlist(apply(tmp.1, 1, which.max))
+  .pmclustEnv$CLASS <- tmp.2	# This is not a ddmatrix
   ### WCC: temp spmd
   # tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
   # tmp.2 <- matrix(apply(tmp.1, 1, which.max), ncol = 1)

R/dmat_em_tools.r

@@ -2,27 +2,26 @@
 
 ### This function collects N.CLASS
 get.N.CLASS.dmat <- function(K){
-  tabulate(as.vector(.pmclustEnv$CLASS.dmat), nbins = K)
+  tabulate(as.vector(.pmclustEnv$CLASS), nbins = K)	# This is not a ddmatrix.
 } # End of get.N.CLASS.dmat().
 
-
 get.CLASS <- function(PARAM){
-  A <- exists("CLASS.dmat", envir = .pmclustEnv)
+  A <- exists("CLASS", envir = .pmclustEnv)
   B <- exists("CLASS.spmd", envir = .pmclustEnv)
 
   if(A & B){
-    comm.stop("CLASS.spmd and CLASS.dmat both exist in .pmclustEnv")
+    comm.stop("CLASS and CLASS.spmd both exist in .pmclustEnv")
   } else{
     if(A){
       ret <- spmd.allgather.integer(as.integer(.pmclustEnv$CLASS.spmd),
                                     integer(PARAM$N))
       ret <- unlist(ret)
-    }
-    if(B){
-      ret <- as.integer(as.vector(.pmclustEnv$CLASS.dmat))
+    } else if(B){
+      ret <- as.integer(.pmclustEnv$CLASS)
+    } else{
+      comm.stop("CLASS and CLASS.spmd do not exist in .pmclustEnv")
     }
   }
 
   ret
 } # End of get.CLASS().
-

R/dmat_kmeans_base.r

@@ -30,7 +30,7 @@ kmeans.m.step.dmat <- function(PARAM){
     # tmp <- as.vector(colMeans(X.dmat[.pmclustEnv$CLASS.dmat == i.k,]))
     # PARAM$MU[, i.k] <- as.vector(tmp)
     ### WCC: temp
-    tmp.1 <- .pmclustEnv$CLASS.dmat == i.k
+    tmp.1 <- .pmclustEnv$CLASS == i.k	# This is not a ddmatrix.
     tmp.2 <- X.dmat[tmp.1,]
     tmp.3 <- colMeans(tmp.2)
     tmp.4 <- as.vector(tmp.3)
@@ -46,10 +46,11 @@ kmeans.logL.step.dmat <- function(){
   # tmp.diff <- sum(.pmclustEnv$CLASS.dmat != tmp)
   # .pmclustEnv$CLASS.dmat <- tmp
   ### WCC: temp
-  tmp.1 <- apply(.pmclustEnv$Z.dmat, 1, which.min)
-  tmp.2 <- .pmclustEnv$CLASS.dmat != tmp.1
-  tmp.diff <- sum(tmp.2)
-  .pmclustEnv$CLASS.dmat <- tmp.1
+  tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
+  tmp.2 <- unlist(apply(tmp.1, 1, which.min))
+  tmp.3 <- .pmclustEnv$CLASS != tmp.2	# This is not a ddmatrix.
+  tmp.diff <- sum(tmp.3)
+  .pmclustEnv$CLASS <- tmp.2
 
   as.integer(tmp.diff)
 } # End of kmeans.logL.step.dmat().
@@ -139,8 +140,9 @@ kmeans.update.class.dmat <- function(){
   ### WCC: original
   # .pmclustEnv$CLASS.dmat <- apply(.pmclustEnv$Z.dmat, 1, which.min)
   ### WCC: temp
-  tmp.1 <- apply(.pmclustEnv$Z.dmat, 1, which.min)
-  .pmclustEnv$CLASS.dmat <- tmp.1
+  tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
+  tmp.2 <- unlist(apply(tmp.1, 1, which.min))
+  .pmclustEnv$CLASS <- tmp.2	# This is not a ddmatrix
 
   invisible()
 } # End of kmeans.update.class.dmat().

R/dmat_kmeans_initial.r

@@ -36,10 +36,10 @@ initial.center.dmat <- function(PARAM, MU = NULL){
   }
 
   ### WCC: original
-  .pmclustEnv$CLASS.dmat <- apply(.pmclustEnv$Z.dmat, 1, which.max)
+  # .pmclustEnv$CLASS.dmat <- apply(.pmclustEnv$Z.dmat, 1, which.max)
   ### WCC: temp
-  # tmp.1 <- apply(.pmclustEnv$Z.dmat, 1, which.max)
-  # .pmclustEnv$CLASS.dmat <- tmp.1
+  tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
+  .pmclustEnv$CLASS <- unlist(apply(tmp.1, 1, which.max))
 
   PARAM
 } # End of initial.center.dmat().

R/dmat_my_tools.r

@@ -58,7 +58,7 @@ set.global.dmat <- function(K = 2, X.dmat = NULL, PARAM = NULL,
   .pmclustEnv$U.dmat <- ddmatrix(0, N, K)
 
   # .pmclustEnv$CLASS.dmat <- ddmatrix(0, N, 1)
-  .pmclustEnv$CLASS.dmat <- rep(0, N) 
+  .pmclustEnv$CLASS <- rep(0, N)	# This is not a ddmatrix.
 
   .pmclustEnv$CHECK <- list(algorithm = algorithm[1],
                             i.iter = 0, abs.err = Inf,