Running ‘testthat.R’ [102s/131s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > ##################################################
  > ## Project: pathfindR
  > ## Script purpose: Main test_check script
  > ## Date: Aug 28, 2019
  > ## Author: Ege Ulgen
  > ##################################################
  > 
  > library(testthat)
  > library(pathfindR)
  ##############################################################################
                          Welcome to pathfindR!
  
  Please cite the article below if you use pathfindR in published reseach:
  
  Ulgen E, Ozisik O, Sezerman OU. 2019. pathfindR: An R Package for Comprehensive
  Identification of Enriched Pathways in Omics Data Through Active Subnetworks.
  Front. Genet. doi:10.3389/fgene.2019.00858
  
  ##############################################################################
  > 
  > test_check("pathfindR")
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  pathfindR
   --- call from context --- 
  cluster_graph_vis(clu_obj, kappa_mat, enrichment_res)
   --- call from argument --- 
  if (class(clu_obj) == "matrix") {
      if (!all(rownames(clu_obj) %in% colnames(kappa_mat))) {
          stop("Not all terms in `clu_obj` present in `kappa_mat`!")
      }
      kappa_mat2 <- kappa_mat
      diag(kappa_mat2) <- 0
      kappa_mat2 <- ifelse(kappa_mat2 < kappa_threshold, 0, kappa_mat2)
      missing <- rownames(clu_obj)[!rownames(clu_obj) %in% colnames(kappa_mat2)]
      missing_mat <- matrix(0, nrow = nrow(kappa_mat2), ncol = length(missing), 
          dimnames = list(rownames(kappa_mat2), missing))
      kappa_mat2 <- cbind(kappa_mat2, missing_mat)
      missing <- rownames(clu_obj)[!rownames(clu_obj) %in% rownames(kappa_mat2)]
      missing_mat <- matrix(0, nrow = length(missing), ncol = ncol(kappa_mat2), 
          dimnames = list(missing, colnames(kappa_mat2)))
      kappa_mat2 <- rbind(kappa_mat2, missing_mat)
      values <- apply(clu_obj, 1, function(x) which(x))
      percs <- list()
      for (i in base::seq_len(length(values))) {
          percs[[i]] <- rep(1/length(values[[i]]), length(values[[i]]))
      }
      g <- igraph::graph_from_adjacency_matrix(kappa_mat2, weighted = TRUE)
      if (length(all_cols) < max(as.integer(colnames(clu_obj)))) {
          num_extra <- max(as.integer(colnames(clu_obj))) - length(all_cols)
          extra_colors <- grDevices::rainbow(num_extra)
          all_cols <- c(all_cols, extra_colors)
      }
      igraph::V(g)$shape <- ifelse(vapply(percs, length, 1) > 1, 
          "pie", "circle")
      cols <- lapply(values, function(x) all_cols[x])
      igraph::V(g)$color <- vapply(cols, function(x) x[1], "")
      p_idx <- match(names(igraph::V(g)), enrichment_res[, chosen_id])
      transformed_p <- -log10(enrichment_res$lowest_p[p_idx])
      igraph::V(g)$size <- transformed_p * 2.5
      igraph::plot.igraph(g, vertex.pie = percs, vertex.pie.color = cols, 
          layout = igraph::layout_nicely(g), edge.curved = FALSE, 
          vertex.label.dist = 0, vertex.label.color = "black", 
          asp = 1, vertex.label.cex = 0.7, edge.width = igraph::E(g)$weight, 
          edge.arrow.mode = 0)
  } else if (class(clu_obj) == "integer") {
      if (!all(names(clu_obj) %in% colnames(kappa_mat))) {
          stop("Not all terms in `clu_obj` present in `kappa_mat`!")
      }
      kappa_mat2 <- kappa_mat
      diag(kappa_mat2) <- 0
      kappa_mat2 <- ifelse(kappa_mat2 > kappa_threshold, kappa_mat2, 
          0)
      missing <- names(clu_obj)[!names(clu_obj) %in% colnames(kappa_mat2)]
      missing_mat <- matrix(0, nrow = nrow(kappa_mat2), ncol = length(missing), 
          dimnames = list(rownames(kappa_mat2), missing))
      kappa_mat2 <- cbind(kappa_mat2, missing_mat)
      missing <- names(clu_obj)[!names(clu_obj) %in% rownames(kappa_mat2)]
      missing_mat <- matrix(0, nrow = length(missing), ncol = ncol(kappa_mat2), 
          dimnames = list(missing, colnames(kappa_mat2)))
      kappa_mat2 <- rbind(kappa_mat2, missing_mat)
      g <- igraph::graph_from_adjacency_matrix(kappa_mat2, weighted = TRUE)
      igraph::V(g)$Clu <- clu_obj[match(igraph::V(g)$name, names(clu_obj))]
      if (length(all_cols) < max(as.integer(igraph::V(g)$Clu))) {
          num_extra <- max(clu_obj) - length(all_cols)
          extra_colors <- grDevices::rainbow(num_extra)
          all_cols <- c(all_cols, extra_colors)
      }
      igraph::V(g)$color <- all_cols[as.integer(igraph::V(g)$Clu)]
      p_idx <- match(names(igraph::V(g)), enrichment_res[, chosen_id])
      transformed_p <- -log10(enrichment_res$lowest_p[p_idx])
      igraph::V(g)$size <- transformed_p * 2.5
      igraph::plot.igraph(g, layout = igraph::layout_nicely(g), 
          edge.curved = FALSE, vertex.label.dist = 0, vertex.label.color = "black", 
          asp = 0, vertex.label.cex = 0.7, edge.width = igraph::E(g)$weight, 
          edge.arrow.mode = 0)
  } else {
      stop("Invalid class for `clu_obj`!")
  }
   --- R stacktrace ---
  where 1: cluster_graph_vis(clu_obj, kappa_mat, enrichment_res)
  where 2: eval_bare(quo_get_expr(.quo), quo_get_env(.quo))
  where 3: withVisible(code)
  where 4: withCallingHandlers(withVisible(code), warning = handle_warning, 
      message = handle_message)
  where 5: force(code)
  where 6: withr::with_output_sink(temp, withCallingHandlers(withVisible(code), 
      warning = handle_warning, message = handle_message))
  where 7: .capture(act$val <- eval_bare(quo_get_expr(.quo), quo_get_env(.quo)), 
      ...)
  where 8: quasi_capture(enquo(object), NULL, evaluate_promise)
  where 9 at testthat/test-clustering_functions.R#208: expect_silent(cluster_graph_vis(clu_obj, kappa_mat, enrichment_res))
  where 10: eval(code, test_env)
  where 11: eval(code, test_env)
  where 12: withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error)
  where 13: doTryCatch(return(expr), name, parentenv, handler)
  where 14: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 15: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 16: doTryCatch(return(expr), name, parentenv, handler)
  where 17: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 18: tryCatchList(expr, classes, parentenv, handlers)
  where 19: tryCatch(withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error), error = handle_fatal, 
      skip = function(e) {
      })
  where 20: test_code(desc, code, env = parent.frame())
  where 21 at testthat/test-clustering_functions.R#196: test_that("Graph visualization of clusters via `cluster_graph_vis()` works OK", 
      {
          enrichment_res <- RA_output[1:5, ]
          kappa_mat <- create_kappa_matrix(enrichment_res)
          clu_obj <- hierarchical_term_clustering(kappa_mat, enrichment_res)
          expect_silent(cluster_graph_vis(clu_obj, kappa_mat, enrichment_res))
          clu_obj <- fuzzy_term_clustering(kappa_mat, enrichment_res)
          expect_silent(cluster_graph_vis(clu_obj, kappa_mat, enrichment_res))
          kappa_mat <- create_kappa_matrix(enrichment_res, use_description = TRUE)
          clu_obj <- hierarchical_term_clustering(kappa_mat, enrichment_res, 
              use_description = TRUE)
          expect_silent(cluster_graph_vis(clu_obj, kappa_mat, enrichment_res, 
              use_description = TRUE))
          clu_obj <- fuzzy_term_clustering(kappa_mat, enrichment_res, 
              use_description = TRUE)
          expect_silent(cluster_graph_vis(clu_obj, kappa_mat, enrichment_res, 
              use_description = TRUE))
      })
  where 22: eval(code, test_env)
  where 23: eval(code, test_env)
  where 24: withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error)
  where 25: doTryCatch(return(expr), name, parentenv, handler)
  where 26: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 27: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 28: doTryCatch(return(expr), name, parentenv, handler)
  where 29: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 30: tryCatchList(expr, classes, parentenv, handlers)
  where 31: tryCatch(withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error), error = handle_fatal, 
      skip = function(e) {
      })
  where 32: test_code(NULL, exprs, env)
  where 33: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 34: force(code)
  where 35: doWithOneRestart(return(expr), restart)
  where 36: withOneRestart(expr, restarts[[1L]])
  where 37: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 38: with_reporter(reporter = reporter, start_end_reporter = start_end_reporter, 
      {
          reporter$start_file(basename(path))
          lister$start_file(basename(path))
          source_file(path, new.env(parent = env), chdir = TRUE, 
              wrap = wrap)
          reporter$.end_context()
          reporter$end_file()
      })
  where 39: FUN(X[[i]], ...)
  where 40: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  where 41: force(code)
  where 42: doWithOneRestart(return(expr), restart)
  where 43: withOneRestart(expr, restarts[[1L]])
  where 44: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 45: with_reporter(reporter = current_reporter, results <- lapply(paths, 
      test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE, 
      load_helpers = FALSE, wrap = wrap))
  where 46: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 47: test_dir(path = test_path, reporter = reporter, env = env, filter = filter, 
      ..., stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
      wrap = wrap)
  where 48: test_package_dir(package = package, test_path = test_path, filter = filter, 
      reporter = reporter, ..., stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 49: test_check("pathfindR")
  
   --- value of length: 2 type: logical ---
  [1]  TRUE FALSE
   --- function from context --- 
  function (clu_obj, kappa_mat, enrichment_res, kappa_threshold = 0.35, 
      use_description = FALSE) 
  {
      chosen_id <- ifelse(use_description, which(colnames(enrichment_res) == 
          "Term_Description"), which(colnames(enrichment_res) == 
          "ID"))
      all_cols <- c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", 
          "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999", 
          "#66C2A5", "#FC8D62", "#8DA0CB", "#E78AC3", "#A6D854", 
          "#FFD92F", "#E5C494", "#B3B3B3", "#8DD3C7", "#FFFFB3", 
          "#BEBADA", "#FB8072", "#80B1D3", "#FDB462", "#B3DE69", 
          "#FCCDE5", "#D9D9D9", "#BC80BD", "#CCEBC5", "#FFED6F", 
          "#A6CEE3", "#1F78B4", "#B2DF8A", "#33A02C", "#FB9A99", 
          "#E31A1C", "#FDBF6F", "#FF7F00", "#CAB2D6", "#6A3D9A", 
          "#FFFF99", "#B15928")
      if (class(clu_obj) == "matrix") {
          if (!all(rownames(clu_obj) %in% colnames(kappa_mat))) {
              stop("Not all terms in `clu_obj` present in `kappa_mat`!")
          }
          kappa_mat2 <- kappa_mat
          diag(kappa_mat2) <- 0
          kappa_mat2 <- ifelse(kappa_mat2 < kappa_threshold, 0, 
              kappa_mat2)
          missing <- rownames(clu_obj)[!rownames(clu_obj) %in% 
              colnames(kappa_mat2)]
          missing_mat <- matrix(0, nrow = nrow(kappa_mat2), ncol = length(missing), 
              dimnames = list(rownames(kappa_mat2), missing))
          kappa_mat2 <- cbind(kappa_mat2, missing_mat)
          missing <- rownames(clu_obj)[!rownames(clu_obj) %in% 
              rownames(kappa_mat2)]
          missing_mat <- matrix(0, nrow = length(missing), ncol = ncol(kappa_mat2), 
              dimnames = list(missing, colnames(kappa_mat2)))
          kappa_mat2 <- rbind(kappa_mat2, missing_mat)
          values <- apply(clu_obj, 1, function(x) which(x))
          percs <- list()
          for (i in base::seq_len(length(values))) {
              percs[[i]] <- rep(1/length(values[[i]]), length(values[[i]]))
          }
          g <- igraph::graph_from_adjacency_matrix(kappa_mat2, 
              weighted = TRUE)
          if (length(all_cols) < max(as.integer(colnames(clu_obj)))) {
              num_extra <- max(as.integer(colnames(clu_obj))) - 
                  length(all_cols)
              extra_colors <- grDevices::rainbow(num_extra)
              all_cols <- c(all_cols, extra_colors)
          }
          igraph::V(g)$shape <- ifelse(vapply(percs, length, 1) > 
              1, "pie", "circle")
          cols <- lapply(values, function(x) all_cols[x])
          igraph::V(g)$color <- vapply(cols, function(x) x[1], 
              "")
          p_idx <- match(names(igraph::V(g)), enrichment_res[, 
              chosen_id])
          transformed_p <- -log10(enrichment_res$lowest_p[p_idx])
          igraph::V(g)$size <- transformed_p * 2.5
          igraph::plot.igraph(g, vertex.pie = percs, vertex.pie.color = cols, 
              layout = igraph::layout_nicely(g), edge.curved = FALSE, 
              vertex.label.dist = 0, vertex.label.color = "black", 
              asp = 1, vertex.label.cex = 0.7, edge.width = igraph::E(g)$weight, 
              edge.arrow.mode = 0)
      }
      else if (class(clu_obj) == "integer") {
          if (!all(names(clu_obj) %in% colnames(kappa_mat))) {
              stop("Not all terms in `clu_obj` present in `kappa_mat`!")
          }
          kappa_mat2 <- kappa_mat
          diag(kappa_mat2) <- 0
          kappa_mat2 <- ifelse(kappa_mat2 > kappa_threshold, kappa_mat2, 
              0)
          missing <- names(clu_obj)[!names(clu_obj) %in% colnames(kappa_mat2)]
          missing_mat <- matrix(0, nrow = nrow(kappa_mat2), ncol = length(missing), 
              dimnames = list(rownames(kappa_mat2), missing))
          kappa_mat2 <- cbind(kappa_mat2, missing_mat)
          missing <- names(clu_obj)[!names(clu_obj) %in% rownames(kappa_mat2)]
          missing_mat <- matrix(0, nrow = length(missing), ncol = ncol(kappa_mat2), 
              dimnames = list(missing, colnames(kappa_mat2)))
          kappa_mat2 <- rbind(kappa_mat2, missing_mat)
          g <- igraph::graph_from_adjacency_matrix(kappa_mat2, 
              weighted = TRUE)
          igraph::V(g)$Clu <- clu_obj[match(igraph::V(g)$name, 
              names(clu_obj))]
          if (length(all_cols) < max(as.integer(igraph::V(g)$Clu))) {
              num_extra <- max(clu_obj) - length(all_cols)
              extra_colors <- grDevices::rainbow(num_extra)
              all_cols <- c(all_cols, extra_colors)
          }
          igraph::V(g)$color <- all_cols[as.integer(igraph::V(g)$Clu)]
          p_idx <- match(names(igraph::V(g)), enrichment_res[, 
              chosen_id])
          transformed_p <- -log10(enrichment_res$lowest_p[p_idx])
          igraph::V(g)$size <- transformed_p * 2.5
          igraph::plot.igraph(g, layout = igraph::layout_nicely(g), 
              edge.curved = FALSE, vertex.label.dist = 0, vertex.label.color = "black", 
              asp = 0, vertex.label.cex = 0.7, edge.width = igraph::E(g)$weight, 
              edge.arrow.mode = 0)
      }
      else {
          stop("Invalid class for `clu_obj`!")
      }
  }
  <bytecode: 0x56474b731d18>
  <environment: namespace:pathfindR>
   --- function search by body ---
  Function cluster_graph_vis in namespace pathfindR has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1