Fixes to address build errors.

.gitignore

@@ -1,5 +1,21 @@
+Meta
+doc
+inst/doc
 .DS_Store
 .project
 .svn
 .gitignore
 .Rproj.user
+src/*.o
+src/*.so
+config.status
+config.log
+*.Rproj
+.Rhistory
+.idea
+.Rbuildignore
+src/gslbuild
+src/gsl-1.13
+src/Makevars
+cmake-build-debug
+tests/testthat/Rplots.pdf

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: flowClust
 Type: Package
 Title: Clustering for Flow Cytometry
-Version: 3.21.1
+Version: 3.21.2
 Author: Raphael Gottardo <[email protected]>, Kenneth Lo <[email protected]>, Greg
     Finak <[email protected]>
 Maintainer: Greg Finak <[email protected]>, Mike Jiang <[email protected]>
@@ -17,12 +17,14 @@ Imports:
     flowCore,
     clue,
     corpcor,
-    mnormt
+    mnormt,
+    parallel
 Suggests:
     testthat,
     flowWorkspace,
-    flowWorkspaceData
-Enhances: 
+    flowWorkspaceData,
+    knitr,
+    rmarkdown
 Description: Robust model-based clustering using a t-mixture model with
     Box-Cox transformation. Note: users should have GSL installed.
     Windows users: 'consult the README file available in the inst
@@ -45,4 +47,6 @@ License: Artistic-2.0
 Packaged: 2012-07-13 20:14:40 UTC; finak
 biocViews: ImmunoOncology, Clustering, Visualization, FlowCytometry
 SystemRequirements: GNU make
-RoxygenNote: 6.1.0
+Encoding: UTF-8
+RoxygenNote: 6.1.1
+VignetteBuilder: knitr

NEWS

@@ -1,3 +1,8 @@
+CHANGES in Version 3.21.2
+-------------------------
+* Fixed some tests and rewrote the vignette with Rmarkdown.
+
+
 CHANGES in VERSION 1.8
 ----------------------
 SIGNIFICANT USER-VISIBLE CHANGES

R/flowClust.R

@@ -438,7 +438,7 @@ flowClust<-function(x, expName="Flow Experiment", varNames=NULL, K
 			if(!all(as.vector(Omega0[,,j])==0)){
 				#message(j)
 				#message(Omega0[,,j])
-				Omega0[,,j]<-try(solve((Omega0[,,j])))
+				Omega0[,,j]<-try(qr.solve((Omega0[,,j])))
 			}else{
 				#message(j);
 				#message(Omega0[,,j])
@@ -456,11 +456,41 @@ flowClust<-function(x, expName="Flow Experiment", varNames=NULL, K
 			for(j in 1:dim(Lambda0)[3]){
 				#cat("Lambda0 value:",(Lambda0[,,j]),"\n")
 				#cat("initprec value:",initprec[,,j],"\n")
-				initprec[,,j]<-try(chol(solve(Lambda0[,,j])),silent=TRUE);
+				cholStatus <- try(u <- chol(Lambda0[,,j]),silent=TRUE);
+				cholError <- inherits(cholStatus,"try-error")
+				newMat <- Lambda0[,,j]
 				#cat("initprec class:",class(initprec[,,]))
 				#cat("solve initprec value:",initprec[,,j],"\n")
-				if(inherits(initprec[,,j],"try-error")){
+				iter<-0
+				while(cholError){
 					##Should do something here to catch the error.
+					iter <- iter + 1
+					cat("iteration ", iter, "\n")
+
+					# replace -ve eigen values with small +ve number
+					newEig <- eigen(newMat)
+					newEig2 <- ifelse(newEig$values < 0, 0.1, newEig$values)
+
+					# create modified matrix eqn 5 from Brissette et al 2007, inv = transp for
+					# eig vectors
+					newMat <- newEig$vectors %*% diag(newEig2) %*% t(newEig$vectors)
+
+					# normalize modified matrix eqn 6 from Brissette et al 2007
+					newMat <- newMat/sqrt(diag(newMat) %*% t(diag(newMat)))
+
+					# try chol again
+					cholStatus <- try(u <- chol(newMat), silent = TRUE)
+					cholError <- ifelse(class(cholStatus) == "try-error", TRUE, FALSE)
+					if(iter>10){
+						break;
+					}					
+				}
+				if(cholError){
+					initprec[,,j] <- qr.solve(Lambda0[,,j])
+					Lambda0[,,j] <- qr.solve(initprec[,,j])
+				}else{
+					initprec[,,j] <- chol2inv(u)
+					Lambda0[,,j] <- chol2inv(chol(initprec[,,j]))
 				}
 			}
 		}else{

R/hist.R

@@ -107,7 +107,7 @@ hist.flowClust <- function(x, data=NULL, subset=1, include=1:(x@K)
       if (is(data, "data.frame")) data <- as.matrix(data[,x@varNames])  else
         if (is(data, "vector")) data <- matrix(data)
 
-        if (is.null(xlab) && x@varNames!="Not Available") xlab <- x@varNames[subset]
+        if (is.null(xlab) && all(x@varNames != "Not Available")) xlab <- x@varNames[subset]
         if (!is.numeric(subset)) subset <- match(subset, x@varNames)
         # look for highest density value
         data <- data[,subset]

R/mkPriors.R

@@ -117,13 +117,9 @@ flowClust2Prior<-function(x,kappa,Nt=NULL,addCluster=NULL){
 #' user consumption.
 #' @author Greg Finak \email{gfinak@@fhcrc.org}
 #' @references \url{http://www.rglab.org}
-#' @keywords ~kwd1 ~kwd2
 #' @examples
 #' 
-#' ##---- Should be DIRECTLY executable !! ----
-#' ##-- ==>  Define data, use random,
-#' ##--	or do  help(data=index)  for the standard data sets.
-#' 
+#
 #' ## The function is currently defined as
 #' @rdname mkPrior
 #' @export 

tests/testthat/test_1d.R

@@ -4,6 +4,7 @@ fr <- GvHD[[1]]
 trans <- estimateLogicle(fr, c("FL1-H", "FL2-H", "FL3-H", "FL4-H", "FL2-A"))
 fr <- flowCore::transform(fr, trans)
 
+Sys.setenv("_R_CHECK_LIMIT_CORES_" = "warn")
 
 
 test_that("flowClust:SSH-H, 1 mode", {
@@ -21,9 +22,10 @@ test_that("flowClust:SSH-H, 1 mode", {
   expect_equal(res@w, c(0.286, 0.713), tol = 0.16)
 
   #fiddle with randomStart to change the fit
+  #order the result due to label switching.
   res <- flowClust(fr, varNames = chnl, tol = 1e-10, K = 2, randomStart = 10)
-  expect_equal(res@mu, matrix(c(5.27, 6.84), nrow = 2), tol = 5e-3)
-  expect_equal(res@w, c(0.286, 0.713), tol = 2e-3)
+  expect_equal(res@mu[order(res@mu), , drop = FALSE], matrix(c(5.27, 6.84), nrow = 2), tol = 5e-3)
+  expect_equal(sort(res@w), c(0.286, 0.713), tol = 2e-3)
 
   #tmixture
   g <- tmixFilter(parameters = chnl, tol = 1e-10, K = 2, randomStart = 10)
@@ -43,7 +45,7 @@ test_that("flowClust:SSH-H, 1 mode", {
   #k = 1 is expected to be the best fit
   scores <- sapply(res, slot, "ICL")
   #ICLs decrease as K increases
-  expect_true(all(diff(scores) <0))
+  expect_true(all(diff(scores) < 0))
 
   # par(mfrow=c(1,4))
   # for(obj in res)
@@ -53,7 +55,7 @@ test_that("flowClust:SSH-H, 1 mode", {
   # because of unable to cal covariance matrix for the edge spike signal
   res <- flowClust(fr, varNames = chnl, tol = 1e-10, K = 4, randomStart = 0, min.count = -1, max.count = -1)
   expect_true(is.na(res@BIC))
-  expect_true(is.na(res@sigma[4])||is.infinite(res@sigma[4]))
+  expect_true(is.na(res@sigma[4]) || is.infinite(res@sigma[4]))
 })
 
 

tests/testthat/test_1d_gated_data.R

@@ -2,7 +2,7 @@ context("1d clustering on gated data")
 library(flowWorkspace)
 dataDir <- system.file("extdata",package="flowWorkspaceData")
 gs <- load_gs(list.files(dataDir, pattern = "gs_manual",full = TRUE))
-
+Sys.setenv("_R_CHECK_LIMIT_CORES_"="warn")
 options("mc.cores" = 4)
 test_that("singlets node:", {
   fr <- getData(gs[[1]], "singlets")
@@ -12,7 +12,7 @@ test_that("singlets node:", {
   fr <- fr[, channels]
 
   chnl <- "<B710-A>"
-  res <- flowClust(fr, varNames = chnl, tol = 1e-5, K = 1:4, randomStart = 0, min.count = -1, max.count = -1, trans = 0)
+  res <- flowClust(fr, varNames = chnl, tol = 1e-5, K = 1:4, randomStart = 0, min.count = -1, max.count = -1, trans = 0,)
 
   #3 mode and expect k = 3 is best
   scores <- sapply(res, slot, "ICL")