Running ‘01-label.R’ [2s/3s]
  Comparing ‘01-label.Rout’ to ‘01-label.Rout.save’ ... OK
  Running ‘01-remap.R’ [1s/3s]
  Comparing ‘01-remap.Rout’ to ‘01-remap.Rout.save’ ... OK
  Running ‘02-thresh.R’ [2s/3s]
  Comparing ‘02-thresh.Rout’ to ‘02-thresh.Rout.save’ ... OK
  Running ‘04-reap.R’ [3s/6s]
Running the tests in ‘tests/04-reap.R’ failed.
Complete output:
  > library(Thresher)
  Loading required package: ClassDiscovery
  Loading required package: cluster
  Loading required package: oompaBase
  Loading required package: PCDimension
  > 
  > # unstructured matrix
  > suppressWarnings( RNGversion("3.5.0") )
  > set.seed(9948489)
  > dumb <- matrix(rnorm(100*12), ncol=12)
  > colnames(dumb) <- paste("G", 1:12, sep='')
  > thresh <- Thresher(dumb)
  > # test 'failure' version of constructor
  > r <- new("Reaper", thresh,
  +          useLoadings=FALSE,
  +          keep=FALSE,
  +          nGroups=NA,
  +          fit=NA,
  +          bic=NA,
  +          allfits=list(),
  +          metric='pearson')
  > r@nGroups
  [1] NA
  > # now construct it for real
  > reap <- Reaper(thresh)
  > reap@nGroups
  [1] 2
  > screeplot(reap)
  > plot(reap)
  > scatter(reap)
  > heat(reap)
  > 
  > # matrices with structure
  > set.seed(250264)
  > load(system.file("Examples/thresh.Rda", package="Thresher"))
  > thresh@nSample # 300
  [1] 300
  > thresh@rho     # 0.5
  [1] 0.5
  > thresh@pcdim   # 2
  [1] 2
  > min(thresh@delta) > 0.5 # TRUE
  [1] TRUE
  > round(det(thresh@covariance), 5) # 0.00117
  [1] 0.00117
  > # create Reaper
  > reap <- Reaper(thresh)
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  Thresher
   --- call from context --- 
  .findSignals(cleaned, fit, ng, linkage = linkage)
   --- call from argument --- 
  if (class(temp) == "numeric") temp <- matrix(temp, nrow = 1)
   --- R stacktrace ---
  where 1: .findSignals(cleaned, fit, ng, linkage = linkage)
  where 2: Reaper(thresh)
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (thresher, fit, nGroups, linkage = "ward.D2") 
  {
      gassign <- predict(fit)
      featureNames <- lapply(1:nGroups, function(idx) {
          colnames(thresher@data)[gassign == idx]
      })
      foo <- as.matrix(as.data.frame(lapply(1:nGroups, function(idx) {
          y <- thresher@loadings[gassign == idx, 1:thresher@pcdim, 
              drop = FALSE]
          apply(y, 2, mean)
      })))
      if (any(is.nan(foo))) {
          cat("Robot FU!!\n", file = stderr())
          for (ii in 1:nrow(foo)) {
              cat(paste(foo[ii, ], collapse = "\t"), "\n", file = stderr())
          }
          cat("gassign:", paste(gassign, collapse = " "), "\n", 
              file = stderr())
          cat("pcdim:", thresher@pcdim, "\n", file = stderr())
          stop("Danger, Will Robinson")
      }
      if (ncol(foo) > 1) {
          temp <- sqrt(apply(foo^2, 2, cumsum))
          if (class(temp) == "numeric") 
              temp <- matrix(temp, nrow = 1)
          cumulative <- apply(temp, 2, sum)
          oc <- rev(order(cumulative))
          featureNames <- featureNames[oc]
          foo <- foo[, oc, drop = FALSE]
      }
      colnames(foo) <- paste("G", 1:nGroups, sep = "")
      u <- unitize(foo)
      mat <- t(u) %*% u
      mat[mat < -1] <- -1
      mat[mat > 1] <- 1
      degrees <- round(acos(mat) * 360/(2 * pi))
      diag(degrees) <- 0
      pcSamples <- thresher@spca@scores[, 1:thresher@pcdim]
      mark <- rep(FALSE, nGroups)
      signals <- list()
      members <- list()
      while (TRUE) {
          if (all(mark)) 
              break
          w <- which(!mark)[1]
          oppose <- (!mark & degrees[w, ] > 135)
          if (any(oppose)) {
              v <- which(oppose)
              if (length(v) > 1) {
                  warning("should not be opposite to two different things")
                  md <- max(degrees[w, ][!mark])
                  v <- which(!mark & degrees[w, ] == md)[1]
              }
              signal <- matrix(foo[, w] - foo[, v], ncol = 1)
              meme <- list(LEFT = featureNames[w], RIGHT = featureNames[v])
              mark[c(v, w)] <- TRUE
          }
          else {
              signal <- matrix(foo[, w], ncol = 1)
              meme <- list(FEAT = featureNames[w])
              mark[w] <- TRUE
          }
          M <- length(signals)
          signals[[1 + M]] <- pcSamples %*% signal
          members[[1 + M]] <- meme
      }
      contSignal <- as.matrix(as.data.frame(signals))
      colnames(contSignal) <- paste("Sig", 1:length(signals), sep = "")
      conClust <- hclust(distanceMatrix(t(contSignal), "euclid"), 
          linkage)
      binSignal <- 1 * (contSignal > 0)
      binClust <- hclust(dist.binary(binSignal, method = 2), linkage)
      new("SignalSet", members = members, continuous = contSignal, 
          binary = binSignal, continuousClusters = conClust, binaryClusters = binClust)
  }
  <bytecode: 0x560c8d498028>
  <environment: namespace:Thresher>
   --- function search by body ---
  Function .findSignals in namespace Thresher has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1