updates

Author: snoweye

R/00_pmclust_reduceK.r

@@ -13,11 +13,16 @@ pmclust.reduceK <- function(X = NULL, K = 2, MU = NULL,
   ### Repeat if error occurs.
   repeat{
     if(ret$check$convergence == 99 && K > 1){
-      ### Drop the smallest class or
+      ### Drop specific i.k if available or
+      ### drop the smallest class or
       ### drop the class with the smallest eta among all small classes or
       ### drop all classes with 0 elements.
       PARAM.new <- ret$param
-      i.k <- which(ret$n.class == min(ret$n.class))
+      if(.pmclustEnv$CONTROL$stop.at.fail && .pmclustEnv$FAIL.i.k > 0){
+        i.k <- .pmclustEnv$FAIL.i.k
+      } else{
+        i.k <- which(ret$n.class == min(ret$n.class))
+      }
       if(i.k > 1 && min(ret$n.class) > 0){
         i.k <- i.k[which.min(PARAM.new$ETA[i.k])]
       }

R/dmat_em_base.r

@@ -227,6 +227,11 @@ m.step.dmat <- function(PARAM){
         if(.pmclustEnv$CONTROL$debug > 2){
           comm.cat("  SIGMA[[", i.k, "]] has NaN. Updating is skipped.\n", sep = "", quiet = TRUE)
         }
+
+        .pmclustEnv$FAIL.i.k <- i.k    # i.k is failed to update.
+        if(.pmclustEnv$CONTROL$stop.at.fail){
+          stop(paste("NaN occurs at", i.k))
+        }
       }
     } else{
       if(.pmclustEnv$CONTROL$debug > 2){
@@ -270,6 +275,11 @@ em.step.dmat <- function(PARAM.org){
       time.start <- proc.time()
     }
 
+    ### This is used to record which i.k may be failed to update.
+    .pmclustEnv$FAIL.i.k <- 0
+
+    ### Start EM next in DMAT format.
+
     ### WCC: original
     PARAM.new <- try(em.onestep.dmat(PARAM.org))
     ### WCC: temp

R/pm_aecm_base.r

@@ -55,6 +55,11 @@ cm.step.spmd.SIGMA <- function(PARAM){
         if(.pmclustEnv$CONTROL$debug > 2){
           comm.cat("  SIGMA[[", i.k, "]] has NaN. Updating is skipped\n", sep = "", quiet = TRUE)
         }
+
+        .pmclustEnv$FAIL.i.k <- i.k    # i.k is failed to update.
+        if(.pmclustEnv$CONTROL$stop.at.fail){
+          stop(paste("NaN occurs at", i.k))
+        }
       }
     } else{
       if(.pmclustEnv$CONTROL$debug > 2){
@@ -92,6 +97,10 @@ aecm.step.spmd <- function(PARAM.org){
       time.start <- proc.time()
     }
 
+    ### This is used to record which i.k may be failed to update.
+    .pmclustEnv$FAIL.i.k <- 0
+
+    ### Start AECM here.
     PARAM.new <- try(aecm.onestep.spmd(PARAM.org))
     if(comm.any(class(PARAM.new) == "try-error")){
       comm.cat("Results of previous iterations are returned.\n", quiet = TRUE)

R/pm_apecm_base.r

@@ -133,6 +133,10 @@ apecm.step.spmd <- function(PARAM.org){
       time.start <- proc.time()
     }
 
+    ### This is used to record which i.k may be failed to update.
+    .pmclustEnv$FAIL.i.k <- 0
+
+    ### Start APECM here.
     PARAM.new <- try(apecm.onestep.spmd(PARAM.org))
     if(comm.any(class(PARAM.new) == "try-error")){
       comm.cat("Results of previous iterations are returned.\n", quiet = TRUE)

R/pm_apecma_base.r

@@ -52,6 +52,11 @@ cm.step.spmd.MU.SIGMA.k <- function(PARAM, i.k){
       if(.pmclustEnv$CONTROL$debug > 2){
         comm.cat("  SIGMA[[", i.k, "]] has NaN. Updating is skipped.\n", sep = "", quiet = TRUE)
       }
+
+      .pmclustEnv$FAIL.i.k <- i.k    # i.k is failed to update.
+      if(.pmclustEnv$CONTROL$stop.at.fail){
+        stop(paste("NaN occurs at", i.k))
+      }
     }
   } else{
     if(.pmclustEnv$CONTROL$debug > 2){
@@ -87,6 +92,10 @@ apecma.step.spmd <- function(PARAM.org){
       time.start <- proc.time()
     }
 
+    ### This is used to record which i.k may be failed to update.
+    .pmclustEnv$FAIL.i.k <- 0
+
+    ### Start APECMA here.
     PARAM.new <- try(apecma.onestep.spmd(PARAM.org))
     if(comm.any(class(PARAM.new) == "try-error")){
       comm.cat("Results of previous iterations are returned.\n", quiet =TRUE)

R/pm_em_base.r

@@ -102,6 +102,11 @@ m.step.spmd <- function(PARAM){
         if(.pmclustEnv$CONTROL$debug > 2){
           comm.cat("  SIGMA[[", i.k, "]] has NaN. Updating is skipped.\n", sep = "", quiet = TRUE)
         }
+
+        .pmclustEnv$FAIL.i.k <- i.k    # i.k is failed to update.
+        if(.pmclustEnv$CONTROL$stop.at.fail){
+          stop(paste("NaN occurs at", i.k))
+        }
       }
     } else{
       if(.pmclustEnv$CONTROL$debug > 2){
@@ -175,6 +180,10 @@ em.step.spmd <- function(PARAM.org){
       time.start <- proc.time()
     }
 
+    ### This is used to record which i.k may be failed to update.
+    .pmclustEnv$FAIL.i.k <- 0
+
+    ### Start EM here.
     PARAM.new <- try(em.onestep.spmd(PARAM.org))
     if(comm.any(class(PARAM.new) == "try-error")){
       comm.cat("Results of previous iterations are returned.\n", quiet = TRUE)

data/control.r

@@ -15,7 +15,8 @@
               exp.min = log(.Machine$double.xmin),
               exp.max = log(.Machine$double.xmax),
               U.max = 1e+4,
-              U.min = 1e-6
+              U.min = 1e-6,
+              stop.at.fail = TRUE
             )
 )
 

man/13_d.control.Rd

@@ -30,6 +30,7 @@
              \code{exp.max}    \tab maximum exponent (\code{log(.Machine$double.xmax)}) \cr
              \code{U.min}      \tab minimum of diagonal of \code{\link[base]{chol}} \cr
              \code{U.max}      \tab maximum of diagonal of \code{\link[base]{chol}} \cr
+             \code{stop.at.fail} \tab stop iterations when fails such as NaN \cr
 }
   These elements govern the computing including number of iterations,
   convergent criteria, ill conditions, and numerical issues.