Running ‘testthat.R’ [2s/3s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library(testthat)
  > library(philentropy)
  > 
  > test_check("philentropy")
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  philentropy
   --- call from context --- 
  philentropy::distance(rbind(P, Q), method = "canberra")
   --- call from argument --- 
  if (!is.element(class(x), c("data.frame", "matrix"))) stop("x should be a data.frame or matrix.")
   --- R stacktrace ---
  where 1: philentropy::distance(rbind(P, Q), method = "canberra")
  where 2: as.vector(philentropy::distance(rbind(P, Q), method = "canberra"))
  where 3: eval_bare(expr, quo_get_env(quo))
  where 4: quasi_label(enquo(object), label, arg = "object")
  where 5 at testthat/test-dist-canberra.R#31: expect_equal(as.vector(philentropy::distance(rbind(P, Q), method = "canberra")), 
      test_canberra_dist(P, Q))
  where 6: eval(code, test_env)
  where 7: eval(code, test_env)
  where 8: 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 9: doTryCatch(return(expr), name, parentenv, handler)
  where 10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 11: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 12: doTryCatch(return(expr), name, parentenv, handler)
  where 13: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 14: tryCatchList(expr, classes, parentenv, handlers)
  where 15: 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 16: test_code(desc, code, env = parent.frame())
  where 17 at testthat/test-dist-canberra.R#28: test_that("distance(method = 'canberra') computes the correct distance value.", 
      {
          expect_equal(as.vector(philentropy::distance(rbind(P, 
              Q), method = "canberra")), test_canberra_dist(P, 
              Q))
          expect_equal(as.vector(philentropy::distance(rbind(P, 
              Q), method = "canberra")), as.vector(stats::dist(base::rbind(P, 
              Q), method = "canberra")))
          distMat <- rbind(rep(0.2, 5), rep(0.1, 5), c(5, 1, 7, 
              9, 5))
          dist.vals <- distance(distMat, method = "canberra")
          expect_equal(dist.vals[lower.tri(dist.vals, diag = FALSE)], 
              test_dist_matrix(distMat, FUN = test_canberra_dist))
      })
  where 18: eval(code, test_env)
  where 19: eval(code, test_env)
  where 20: 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 21: doTryCatch(return(expr), name, parentenv, handler)
  where 22: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 23: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 24: doTryCatch(return(expr), name, parentenv, handler)
  where 25: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 26: tryCatchList(expr, classes, parentenv, handlers)
  where 27: 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 28: test_code(NULL, exprs, env)
  where 29: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 30: force(code)
  where 31: doWithOneRestart(return(expr), restart)
  where 32: withOneRestart(expr, restarts[[1L]])
  where 33: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 34: 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 35: FUN(X[[i]], ...)
  where 36: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  where 37: force(code)
  where 38: doWithOneRestart(return(expr), restart)
  where 39: withOneRestart(expr, restarts[[1L]])
  where 40: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 41: 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 42: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 43: 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 44: 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 45: test_check("philentropy")
  
   --- value of length: 2 type: logical ---
  [1] FALSE  TRUE
   --- function from context --- 
  function (x, method = "euclidean", p = NULL, test.na = TRUE, 
      unit = "log", est.prob = NULL) 
  {
      if (!is.element(class(x), c("data.frame", "matrix"))) 
          stop("x should be a data.frame or matrix.")
      if (is.character(x)) 
          stop(paste0("Your input ", class(x), " stores non-numeric values. Non numeric values cannot be used to compute distances.."))
      dist_methods <- vector(mode = "character", length = 46)
      dist_methods <- c("euclidean", "manhattan", "minkowski", 
          "chebyshev", "sorensen", "gower", "soergel", "kulczynski_d", 
          "canberra", "lorentzian", "intersection", "non-intersection", 
          "wavehedges", "czekanowski", "motyka", "kulczynski_s", 
          "tanimoto", "ruzicka", "inner_product", "harmonic_mean", 
          "cosine", "hassebrook", "jaccard", "dice", "fidelity", 
          "bhattacharyya", "hellinger", "matusita", "squared_chord", 
          "squared_euclidean", "pearson", "neyman", "squared_chi", 
          "prob_symm", "divergence", "clark", "additive_symm", 
          "kullback-leibler", "jeffreys", "k_divergence", "topsoe", 
          "jensen-shannon", "jensen_difference", "taneja", "kumar-johnson", 
          "avg")
      x <- t(x)
      ncols <- vector("numeric", 1)
      ncols <- ncol(x)
      if (!is.element(method, dist_methods)) 
          stop("Method '", method, "' is not implemented in this function. Please consult getDistMethods().", 
              call. = FALSE)
      if (!is.null(est.prob)) {
          x <- apply(x, 2, estimate.probability, method = est.prob)
      }
      if (!is.element(unit, c("log", "log2", "log10"))) 
          stop("You can only choose units: log, log2, or log10.", 
              call. = FALSE)
      if (ncols == 2) {
          dist <- vector("numeric", 1)
      }
      else {
          dist <- matrix(NA_real_, ncols, ncols)
      }
      if (method == "euclidean") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- euclidean(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, euclidean, test.na)
      }
      else if (method == "manhattan") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- manhattan(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, manhattan, test.na)
      }
      else if (method == "minkowski") {
          message("Metric: '", method, "'; p = ", p, "; comparing: ", 
              ncols, " vectors.")
          if (!is.null(p)) {
              if (ncols == 2) 
                  dist <- minkowski(x[, 1], x[, 2], as.double(p), 
                    test.na)
              if (ncols > 2) 
                  dist <- DistMatrixMinkowski(x, as.double(p), 
                    test.na)
          }
          else {
              stop("Please specify p for the Minkowski distance.", 
                  call. = FALSE)
          }
      }
      else if (method == "chebyshev") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- chebyshev(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, chebyshev, test.na)
      }
      else if (method == "sorensen") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- sorensen(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, sorensen, test.na)
      }
      else if (method == "gower") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- gower(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, gower, test.na)
      }
      else if (method == "soergel") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- soergel(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, soergel, test.na)
      }
      else if (method == "kulczynski_d") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- kulczynski_d(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, kulczynski_d, test.na)
      }
      else if (method == "canberra") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- canberra(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, canberra, test.na)
      }
      else if (method == "lorentzian") {
          message("Metric: '", method, "' using unit: '", unit, 
              "'; comparing: ", ncols, " vectors.")
          if (ncols == 2) 
              dist <- lorentzian(x[, 1], x[, 2], test.na, unit)
          if (ncols > 2) 
              dist <- DistMatrix(x, lorentzian, test.na, unit)
      }
      else if (method == "intersection") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- intersection_dist(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, intersection_dist, test.na)
      }
      else if (method == "non-intersection") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- 1 - intersection_dist(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- 1 - DistMatrixNoUnit(x, intersection_dist, 
                  test.na)
      }
      else if (method == "wavehedges") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- wave_hedges(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, wave_hedges, test.na)
      }
      else if (method == "czekanowski") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- czekanowski(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, czekanowski, test.na)
      }
      else if (method == "motyka") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- motyka(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, motyka, test.na)
      }
      else if (method == "kulczynski_s") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- 1/kulczynski_d(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- 1/DistMatrixNoUnit(x, kulczynski_d, test.na)
      }
      else if (method == "tanimoto") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- tanimoto(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, tanimoto, test.na)
      }
      else if (method == "ruzicka") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- ruzicka(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, ruzicka, test.na)
      }
      else if (method == "inner_product") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- inner_product(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, inner_product, test.na)
      }
      else if (method == "harmonic_mean") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- harmonic_mean_dist(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, harmonic_mean_dist, test.na)
      }
      else if (method == "cosine") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- cosine_dist(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, cosine_dist, test.na)
      }
      else if (method == "hassebrook") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- kumar_hassebrook(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, kumar_hassebrook, test.na)
      }
      else if (method == "jaccard") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- jaccard(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, jaccard, test.na)
      }
      else if (method == "dice") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- dice_dist(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, dice_dist, test.na)
      }
      else if (method == "fidelity") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- fidelity(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, fidelity, test.na)
      }
      else if (method == "bhattacharyya") {
          message("Metric: '", method, "' using unit: '", unit, 
              "'; comparing: ", ncols, " vectors.")
          if (ncols == 2) 
              dist <- bhattacharyya(x[, 1], x[, 2], test.na, unit)
          if (ncols > 2) 
              dist <- DistMatrix(x, bhattacharyya, test.na, unit)
      }
      else if (method == "hellinger") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- hellinger(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, hellinger, test.na)
      }
      else if (method == "matusita") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (any(colSums(x) > 1.00001)) 
              stop("Please make sure that all vectors sum up to 1.0 ...", 
                  call. = FALSE)
          if (ncols == 2) 
              dist <- matusita(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, matusita, test.na)
      }
      else if (method == "squared_chord") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- squared_chord(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, squared_chord, test.na)
      }
      else if (method == "squared_euclidean") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- squared_euclidean(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, squared_euclidean, test.na)
      }
      else if (method == "pearson") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- pearson_chi_sq(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, pearson_chi_sq, test.na)
      }
      else if (method == "neyman") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- neyman_chi_sq(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, neyman_chi_sq, test.na)
      }
      else if (method == "squared_chi") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- squared_chi_sq(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, squared_chi_sq, test.na)
      }
      else if (method == "prob_symm") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- prob_symm_chi_sq(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, prob_symm_chi_sq, test.na)
      }
      else if (method == "divergence") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- divergence_sq(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, divergence_sq, test.na)
      }
      else if (method == "clark") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- clark_sq(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, clark_sq, test.na)
      }
      else if (method == "additive_symm") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- additive_symm_chi_sq(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, additive_symm_chi_sq, 
                  test.na)
      }
      else if (method == "kullback-leibler") {
          message("Metric: '", method, "' using unit: '", unit, 
              "'; comparing: ", ncols, " vectors.")
          if (any(colSums(x) > 1.00001)) 
              stop("Please make sure that all vectors sum up to 1.0 ...", 
                  call. = FALSE)
          if (ncols == 2) 
              dist <- kullback_leibler_distance(x[, 1], x[, 2], 
                  test.na, unit)
          if (ncols > 2) 
              dist <- DistMatrix(x, kullback_leibler_distance, 
                  test.na, unit)
      }
      else if (method == "jeffreys") {
          message("Metric: '", method, "' using unit: '", unit, 
              "'; comparing: ", ncols, " vectors.")
          if (ncols == 2) 
              dist <- jeffreys(x[, 1], x[, 2], test.na, unit)
          if (ncols > 2) 
              dist <- DistMatrix(x, jeffreys, test.na, unit)
      }
      else if (method == "k_divergence") {
          message("Metric: '", method, "' using unit: '", unit, 
              "'; comparing: ", ncols, " vectors.")
          if (any(colSums(x) > 1.00001)) 
              stop("Please make sure that all vectors sum up to 1.0 ...", 
                  call. = FALSE)
          if (ncols == 2) 
              dist <- k_divergence(x[, 1], x[, 2], test.na, unit)
          if (ncols > 2) 
              dist <- DistMatrix(x, k_divergence, test.na, unit)
      }
      else if (method == "topsoe") {
          message("Metric: '", method, "' using unit: '", unit, 
              "'; comparing: ", ncols, " vectors.")
          if (ncols == 2) 
              dist <- topsoe(x[, 1], x[, 2], test.na, unit)
          if (ncols > 2) 
              dist <- DistMatrix(x, topsoe, test.na, unit)
      }
      else if (method == "jensen-shannon") {
          message("Metric: '", method, "' using unit: '", unit, 
              "'; comparing: ", ncols, " vectors.")
          if (ncols == 2) 
              dist <- jensen_shannon(x[, 1], x[, 2], test.na, unit)
          if (ncols > 2) 
              dist <- DistMatrix(x, jensen_shannon, test.na, unit)
      }
      else if (method == "jensen_difference") {
          message("Metric: '", method, "' using unit: '", unit, 
              "'; comparing: ", ncols, " vectors.")
          if (ncols == 2) 
              dist <- jensen_difference(x[, 1], x[, 2], test.na, 
                  unit)
          if (ncols > 2) 
              dist <- DistMatrix(x, jensen_difference, test.na, 
                  unit)
      }
      else if (method == "taneja") {
          message("Metric: '", method, "' using unit: '", unit, 
              "'; comparing: ", ncols, " vectors.")
          if (ncols == 2) 
              dist <- taneja(x[, 1], x[, 2], test.na, unit)
          if (ncols > 2) 
              dist <- DistMatrix(x, taneja, test.na, unit)
      }
      else if (method == "kumar-johnson") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- kumar_johnson(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, kumar_johnson, test.na)
      }
      else if (method == "avg") {
          message("Metric: '", method, "'; comparing: ", ncols, 
              " vectors.")
          if (ncols == 2) 
              dist <- avg(x[, 1], x[, 2], test.na)
          if (ncols > 2) 
              dist <- DistMatrixNoUnit(x, avg, test.na)
      }
      if (ncols == 2) {
          names(dist) <- method
      }
      else {
          colnames(dist) <- paste0("v", seq_len(ncols))
          rownames(dist) <- paste0("v", seq_len(ncols))
      }
      return(dist)
  }
  <bytecode: 0x55b904842560>
  <environment: namespace:philentropy>
   --- function search by body ---
  Function distance in namespace philentropy has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1