update

Author: snoweye

ChangeLog

@@ -1,7 +1,8 @@
-2013-05-13: Ver. 0.1-5
+2013-06-24: Ver. 0.1-5
   * Add high-level functions "pmclust" and "pkmeans".
   * Add man page and vignettes.
   * Add PiLow to generate.MixSim.
+  * Add GBD data type.
 
 2013-03-25: Ver. 0.1-4
   * Add dmat_* functions/methods to fully utilize pbdR capability, only the

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: pmclust
 Version: 0.1-5
-Date: 2013-05-13
+Date: 2013-06-24
 Title: Parallel Model-Based Clustering
 Authors@R: c(person("Wei-Chen", "Chen", role = c("aut", "cre"), email =
         "[email protected]"), person("George", "Ostrouchov", role = "aut"))
@@ -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-19 20:37:06 UTC; snoweye
+Packaged: 2013-06-25 18:48:18 UTC; snoweye
 Author: Wei-Chen Chen [aut, cre],
   George Ostrouchov [aut]
 Maintainer: Wei-Chen Chen <[email protected]>

NAMESPACE

@@ -82,7 +82,11 @@ export(
   "kmeans.update.class.dmat",
 
   ### Utility functions.
-  "get.N.CLASS.dmat"
+  "get.N.CLASS.dmat",
+
+### GBD functions.
+  ### Global objects.
+  "set.global.gbd"
 )
 
 S3method(print, pmclust)

R/00_pmclust.r

@@ -4,12 +4,12 @@ pmclust <- function(X = NULL, K = 2, MU = NULL,
     algorithm = .PMC.CT$algorithm, RndEM.iter = .PMC.CT$RndEM.iter,
     CONTROL = .PMC.CT$CONTROL, method.own.X = .PMC.CT$method.own.X,
     rank.own.X = .SPMD.CT$rank.source, comm = .SPMD.CT$comm){
-  if(is.null(X)){
+  if(comm.all(is.null(X))){
     # Check global matrix.
     A <- exists("X.spmd", envir = .GlobalEnv)
     B <- exists("X.dmat", envir = .GlobalEnv)
     if((!A) & (!B)){
-      if(! algorithm[1] %in% .PMC.CT$algorithm.spmd){
+      if(! algorithm[1] %in% .PMC.CT$algorithm.gbd){
         comm.stop("A global X.spmd is required in .GlobalEnv.")
       }
       if(! algorithm[1] %in% .PMC.CT$algorithm.dmat){
@@ -34,7 +34,7 @@ pmclust <- function(X = NULL, K = 2, MU = NULL,
     }
   }
 
-  if(algorithm[1] %in% .PMC.CT$algorithm.spmd){
+  if(algorithm[1] %in% .PMC.CT$algorithm.gbd){
     ret <- pmclust.internal(X, K,
                             MU = MU,
                             algorithm = algorithm[1],
@@ -69,12 +69,12 @@ pkmeans <- function(X = NULL, K = 2, MU = NULL,
     algorithm = c("kmeans", "kmeans.dmat"),
     CONTROL = .PMC.CT$CONTROL, method.own.X = .PMC.CT$method.own.X,
     rank.own.X = .SPMD.CT$rank.source, comm = .SPMD.CT$comm){
-  if(is.null(X)){
+  if(comm.all(is.null(X))){
     # Check global matrix.
     A <- exists("X.spmd", envir = .GlobalEnv)
     B <- exists("X.dmat", envir = .GlobalEnv)
     if((!A) & (!B)){
-      if(! algorithm[1] %in% .PMC.CT$algorithm.spmd){
+      if(! algorithm[1] %in% .PMC.CT$algorithm.gbd){
         comm.stop("A global X.spmd is required in .GlobalEnv.")
       }
       if(! algorithm[1] %in% .PMC.CT$algorithm.dmat){

R/00_pmclust_internal.r

@@ -1,21 +1,21 @@
 ### For general internal methods.
 
 pmclust.internal <- function(X = NULL, K = 2, MU = NULL,
-    algorithm = .PMC.CT$algorithm.spmd, RndEM.iter = .PMC.CT$RndEM.iter,
+    algorithm = .PMC.CT$algorithm.gbd, RndEM.iter = .PMC.CT$RndEM.iter,
     CONTROL = .PMC.CT$CONTROL, method.own.X = .PMC.CT$method.own.X,
     rank.own.X = .SPMD.CT$rank.source, comm = .SPMD.CT$comm){
   # Check.
-  if(! (algorithm[1] %in% .PMC.CT$algorithm.spmd)){
+  if(! (algorithm[1] %in% .PMC.CT$algorithm.gbd)){
     comm.stop("The algorithm is not supported")
   }
   if(! (method.own.X[1] %in% .PMC.CT$method.own.X)){
     comm.stop("The method.own.X is not found.")
   }
 
   # Check X.
-  if(is.null(X)){
+  if(comm.all(is.null(X))){
     if(exists("X.dmat", envir = .GlobalEnv)){
-      # Assign X to .pmclustEnv and convert to gbdr.
+      # Assign X to .pmclustEnv and convert to spmdr.
       convert.data(.GlobalEnv$X.dmat, method.own.X[1], rank.own.X, comm)
     } else{
       # Assume X.spmd in .GlobalEnv and no need for converting or check.
@@ -27,14 +27,14 @@ pmclust.internal <- function(X = NULL, K = 2, MU = NULL,
 
   # Set global variables.
   PARAM.org <- set.global(K = K, RndEM.iter = RndEM.iter)
-  if(!is.null(CONTROL)){
+  if(! comm.all(is.null(CONTROL))){
     tmp <- .pmclustEnv$CONTROL[!(names(.pmclustEnv$CONTROL) %in%
                                  names(CONTROL))]
     .pmclustEnv$CONTROL <- c(tmp, CONTROL)
   }
 
   # Initialization for algorithms.
-  if(! is.null(MU)){
+  if(! comm.all(is.null(MU))){
     if(algorithm[1] != "kmeans"){
       PARAM.org <- initial.em(PARAM.org, MU = MU)
     } else{

R/00_pmclust_internal_dmat.r

@@ -10,7 +10,7 @@ pmclust.internal.dmat <- function(X = NULL, K = 2, MU = NULL,
   }
 
   # Check X.
-  if(is.null(X)){
+  if(comm.all(is.null(X))){
     if(! is.ddmatrix(.GlobalEnv$X.dmat)){
       comm.stop("X.dmat is not a ddmatrix.")
     } else{
@@ -27,14 +27,14 @@ pmclust.internal.dmat <- function(X = NULL, K = 2, MU = NULL,
 
   # Set global variables.
   # PARAM.org <- set.global.dmat(K = K, RndEM.iter = RndEM.iter)
-  if(!is.null(CONTROL)){
+  if(! comm.all(is.null(CONTROL))){
     tmp <- .pmclustEnv$CONTROL[!(names(.pmclustEnv$CONTROL) %in%
                                  names(CONTROL))]
     .pmclustEnv$CONTROL <- c(tmp, CONTROL)
   }
 
   # Initialization for algorithms.
-  if(! is.null(MU)){
+  if(! comm.all(is.null(MU))){
     if(algorithm[1] != "kmeans.dmat"){
       PARAM.org <- initial.em.dmat(PARAM.org, MU = MU)
     } else{
@@ -56,7 +56,7 @@ pmclust.internal.dmat <- function(X = NULL, K = 2, MU = NULL,
 #                        "apecma.dmat" = apecma.step.dmat,
                         "kmeans.dmat" = kmeans.step.dmat,
                         NULL)
-  if(is.null(method.step)){
+  if(comm.all(is.null(method.step))){
     comm.stop("Algorithm is not found.")
   }
   PARAM.new <- method.step(PARAM.org)

R/01_as_dmat.r

@@ -1,15 +1,15 @@
-### Convert X.gbd to X.dmat
+### Convert X.spmd to X.dmat
 
-as.dmat <- function(X.gbd, bldim = .BLDIM, ICTXT = .ICTXT,
+as.dmat <- function(X.spmd, bldim = .BLDIM, ICTXT = .ICTXT,
     comm = .SPMD.CT$comm){
-  X.gbd <- load.balance(X.gbd, comm = comm)
+  X.spmd <- load.balance(X.spmd, comm = comm)
 
-  N.gbd <- nrow(X.gbd)
-  p <- ncol(X.gbd)
-  N <- spmd.allreduce.integer(N.gbd, integer(1), op = "sum")
+  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.gbd, p), CTXT = 2)
-  X.dmat@Data <- X.gbd
+  X.dmat <- ddmatrix(0, N, p, bldim = c(N.spmd, p), CTXT = 2)
+  X.dmat@Data <- X.spmd
   X.dmat <- redistribute(X.dmat, bldim = bldim, ICTXT = ICTXT)
 
   X.dmat

R/02_convert_data.r

@@ -9,16 +9,16 @@ convert.data <- function(X, method.own.X = .PMC.CT$method.own.X,
   if(is.ddmatrix(X)){
     # For a ddmatrix.
 
-    .pmclustEnv$X.spmd <- as.gbd(X, comm = comm)
+    .pmclustEnv$X.spmd <- as.spmd(X, comm = comm)
   } else{
-    # for a GBD matrix.
+    # for a spmd matrix.
 
     if(is.null(X)){
       X <- matrix(0, nrow = 0, ncol = 0)
     }
 
-    if(method.own.X[1] == "gbdr"){
-      # For GBD row-major
+    if(method.own.X[1] %in% c("gbdr", "spmdr")){
+      # For spmd row-major
 
       p <- ncol(X)
       p.all <- spmd.allgather.integer(p, integer(COMM.SIZE), comm = comm)
@@ -57,7 +57,7 @@ convert.data <- function(X, method.own.X = .PMC.CT$method.own.X,
       p <- spmd.bcast.integer(as.integer(p), rank.source = rank.own.X,
                               comm = comm)
       if(p == -1){
-        comm.stop("X should be a matrix in rank 0.")
+        comm.stop("X should be a matrix in rank.own.X.")
       } else{
         if(COMM.RANK != rank.own.X){
           X <- matrix(0, nrow = 0, ncol = p)

R/02_load_balance.r

@@ -1,20 +1,20 @@
 ### This file contains functions to load balance of data X.spmd.
 
 balance.info <- function(X.spmd, comm = .SPMD.CT$comm,
-    gbd.major = 1, method = c("block.cyclic", "block0")){
+    spmd.major = 1, method = c("block.cyclic", "block0")){
   COMM.SIZE <- spmd.comm.size(comm)
   COMM.RANK <- spmd.comm.rank(comm)
 
   if(!is.matrix(X.spmd)){
     X.spmd <- as.matrix(X.spmd)
   }
 
-  if(gbd.major == 1){
+  if(spmd.major == 1){
     N.spmd <- nrow(X.spmd)
-  } else if(gbd.major == 2){
+  } else if(spmd.major == 2){
     N.spmd <- ncol(X.spmd)
   } else{
-    stop("gbd.major = 1 or 2.")
+    stop("spmd.major = 1 or 2.")
   }
   N.allspmd <- spmd.allgather.integer(as.integer(N.spmd), integer(COMM.SIZE),
                                       comm = comm)
@@ -60,31 +60,31 @@ balance.info <- function(X.spmd, comm = .SPMD.CT$comm,
                           belong = rank.belong[rank.belong == COMM.RANK])
 
   list(send = send.info, recv = recv.info, N.allspmd = N.allspmd,
-       new.N.allspmd = new.N.allspmd, gbd.major = gbd.major)
+       new.N.allspmd = new.N.allspmd, spmd.major = spmd.major)
 } # End of balance.info()
 
 
 load.balance <- function(X.spmd, bal.info = NULL, comm = .SPMD.CT$comm,
-    gbd.major = 1){
+    spmd.major = 1){
   COMM.RANK <- spmd.comm.rank(comm)
   if(is.null(bal.info)){
-    bal.info <- balance.info(X.spmd, comm = comm, gbd.major = gbd.major)
+    bal.info <- balance.info(X.spmd, comm = comm, spmd.major = spmd.major)
   }
 
   if(!is.matrix(X.spmd)){
     X.spmd <- as.matrix(X.spmd)
   }
-  if(gbd.major == 1){
+  if(spmd.major == 1){
     p <- ncol(X.spmd)
-  } else if(gbd.major == 2){
+  } else if(spmd.major == 2){
     p <- nrow(X.spmd)
   } else{
-    stop("gbd.major = 1 or 2.")
+    stop("spmd.major = 1 or 2.")
   }
 
   send.to <- as.integer(unique(bal.info$send$belong))
   if(length(send.to) > 0){
-    if(gbd.major == 1){
+    if(spmd.major == 1){
       for(i in send.to){
         if(i != COMM.RANK){
           tmp <- matrix(X.spmd[bal.info$send$belong == i,], ncol = p)
@@ -104,7 +104,7 @@ load.balance <- function(X.spmd, bal.info = NULL, comm = .SPMD.CT$comm,
   recv.from <- as.integer(unique(bal.info$recv$org))
   if(length(recv.from) > 0){
     ret <- NULL
-    if(gbd.major == 1){
+    if(spmd.major == 1){
       for(i in recv.from){
         if(i != COMM.RANK){
           tmp <- recv(rank.source = i, tag = i, comm = comm)
@@ -130,7 +130,7 @@ load.balance <- function(X.spmd, bal.info = NULL, comm = .SPMD.CT$comm,
   }
 
   if(bal.info$new.N.allspmd[spmd.comm.rank(comm) + 1] == 0){
-    if(gbd.major == 1){
+    if(spmd.major == 1){
       ret <- matrix(0, nrow = 0, ncol = p)
     } else{
       ret <- matrix(0, nrow = p, ncol = 0)
@@ -148,7 +148,7 @@ unload.balance <- function(new.X.spmd, bal.info, comm = .SPMD.CT$comm){
                                          belong = bal.info$send$org),
                        N.allspmd = bal.info$new.N.allspmd,
                        new.N.allspmd = bal.info$N.allspmd,
-                       gbd.major = bal.info$gbd.major)
+                       spmd.major = bal.info$spmd.major)
   load.balance(new.X.spmd, bal.info = rev.bal.info, comm = comm)
 } # End of unload.balance().
 

R/dmat_em_initial.r

@@ -24,13 +24,13 @@ initial.em.dmat <- function(PARAM, MU = NULL){
 # -1.3357516, 0.5336209, 1.2700404,
 # -1.3110521, 0.2632600, 1.7063794
 # )
-PARAM$MU <- c(
-  0.2328901,  0.7281706, -1.0026075,
- -0.6238820, -0.2584021,  0.8862744,
-  0.4944164,  0.7662080, -1.2993873,
-  0.4674663,  0.7461591, -1.2516524
-)
-PARAM$MU <- matrix(PARAM$MU, nrow = 4)
+#PARAM$MU <- c(
+#  0.2328901,  0.7281706, -1.0026075,
+# -0.6238820, -0.2584021,  0.8862744,
+#  0.4944164,  0.7662080, -1.2993873,
+#  0.4674663,  0.7461591, -1.2516524
+#)
+#PARAM$MU <- matrix(PARAM$MU, nrow = 4)
 
   e.step.dmat(PARAM)
   PARAM <- em.onestep.dmat(PARAM)