Running 'testthat.R' [4s/6s]
Running the tests in 'tests/testthat.R' failed.
Complete output:
  > library(testthat)
  > library(kantorovich)
  > 
  > test_check("kantorovich")
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  kantorovich
   --- call from context --- 
  edistances(mu = mu, nu = nu, dist = dist, ...)
   --- call from argument --- 
  if (class(dist) == "function") {
      rho <- function(x, y) dist(x, y, ...)
  } else if (class(dist) == "matrix") {
      if (!use_gmp && mode(dist) != "numeric") 
          stop("The dist matrix must be numeric if mu and nu are numeric")
      if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
          stop("Invalid dimension of the dist matrix")
      if (is.null(rownames(dist))) 
          rownames(dist) <- 1:nrow(dist)
      if (is.null(colnames(dist))) 
          colnames(dist) <- 1:ncol(dist)
      if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
          colnames(dist))) 
          stop("Invalid dimension names of the dist matrix")
  } else {
      if (!use_gmp) 
          stop("dist must be a function or a numeric matrix")
      if (use_gmp) 
          stop("dist must be a function or a numeric/character matrix")
  }
   --- R stacktrace ---
  where 1: edistances(mu = mu, nu = nu, dist = dist, ...)
  where 2 at testthat/test-Pascal.R#61: kantorovich(as.bigq(kernel[i, ]), as.bigq(kernel[j, ]), dist = RHO[[k]])
  where 3: eval(code, test_env)
  where 4: eval(code, test_env)
  where 5: 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 6: doTryCatch(return(expr), name, parentenv, handler)
  where 7: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 8: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 9: doTryCatch(return(expr), name, parentenv, handler)
  where 10: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 11: tryCatchList(expr, classes, parentenv, handlers)
  where 12: 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 13: test_code(desc, code, env = parent.frame())
  where 14 at testthat/test-Pascal.R#13: test_that("Pascal", {
      library(gmp)
      Pascal_Mn <- function(n) {
          M <- matrix(0, nrow = n + 1, ncol = n + 2)
          for (i in 1:(n + 1)) {
              M[i, ][c(i, i + 1)] <- 1
          }
          return(M)
      }
      centralKernels <- function(Mn.fun, N) {
          L <- Kernels <- vector("list", N)
          k <- 0
          M <- Mn.fun(k)
          m <- nrow(M)
          n <- ncol(M)
          if (m != 1) 
              stop("M0 must have only one row")
          dims0 <- as.vector(as.bigz(M))
          Kernels[[k + 1]] <- matrix(as.character(dims0), dimnames = list(1:n, 
              1:m))
          for (k in 1:N) {
              M <- Mn.fun(k)
              m <- nrow(M)
              n <- ncol(M)
              S <- apply(M, 2, function(x) which(x != 0))
              dims <- as.vector(dims0 %*% M)
              P <- lapply(1:n, function(i) {
                  as.character(dims0[S[[i]]] * M[S[[i]], i]/dims[i])
              })
              Kernels[[k + 1]] <- matrix("0", nrow = n, ncol = m, 
                  dimnames = list(1:n, 1:m))
              for (i in 1:n) {
                  Kernels[[k + 1]][i, ][S[[i]]] <- P[[i]]
              }
              dims0 <- dims
          }
          return(Kernels)
      }
      N <- 3
      ckernels <- centralKernels(Pascal_Mn, N)
      RHO <- lapply(ckernels, function(kernel) matrix("", nrow = nrow(kernel), 
          ncol = nrow(kernel)))
      RHO[[1]] <- (diag(2) + 1)%%2
      for (k in 1:N) {
          diag(RHO[[k + 1]]) <- "0"
          K <- nrow(RHO[[k + 1]])
          kernel <- ckernels[[k + 1]]
          for (i in 1:(K - 1)) {
              for (j in (i + 1):K) {
                  RHO[[k + 1]][i, j] <- RHO[[k + 1]][j, i] <- as.character(kantorovich(as.bigq(kernel[i, 
                    ]), as.bigq(kernel[j, ]), dist = RHO[[k]]))
              }
          }
      }
      expect_identical(RHO[[4]], structure(c("0", "1/4", "1/2", 
          "3/4", "1", "1/4", "0", "1/4", "1/2", "3/4", "1/2", "1/4", 
          "0", "1/4", "1/2", "3/4", "1/2", "1/4", "0", "1/4", "1", 
          "3/4", "1/2", "1/4", "0"), .Dim = c(5L, 5L)))
  })
  where 15: eval(code, test_env)
  where 16: eval(code, test_env)
  where 17: 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 18: doTryCatch(return(expr), name, parentenv, handler)
  where 19: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 20: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 21: doTryCatch(return(expr), name, parentenv, handler)
  where 22: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 23: tryCatchList(expr, classes, parentenv, handlers)
  where 24: 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 25: test_code(NULL, exprs, env)
  where 26: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 27: force(code)
  where 28: doWithOneRestart(return(expr), restart)
  where 29: withOneRestart(expr, restarts[[1L]])
  where 30: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 31: 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 32: FUN(X[[i]], ...)
  where 33: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, 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 = current_reporter, results <- lapply(paths, 
      test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE, 
      load_helpers = FALSE, wrap = wrap))
  where 39: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 40: 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 41: 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 42: test_check("kantorovich")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (mu, nu, dist = NULL, ...) 
  {
      joinings <- ejoinings(mu, nu, zeros = TRUE)
      n.joinings <- length(joinings)
      j1 <- joinings[[1]]
      use_gmp <- class(mu) %in% c("bigq", "character")
      if (is.null(dist)) {
          rho <- function(x, y) discrete(x, y, gmp = use_gmp)
      }
      else if (class(dist) == "function") {
          rho <- function(x, y) dist(x, y, ...)
      }
      else if (class(dist) == "matrix") {
          if (!use_gmp && mode(dist) != "numeric") 
              stop("The dist matrix must be numeric if mu and nu are numeric")
          if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
              stop("Invalid dimension of the dist matrix")
          if (is.null(rownames(dist))) 
              rownames(dist) <- 1:nrow(dist)
          if (is.null(colnames(dist))) 
              colnames(dist) <- 1:ncol(dist)
          if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
              colnames(dist))) 
              stop("Invalid dimension names of the dist matrix")
      }
      else {
          if (!use_gmp) 
              stop("dist must be a function or a numeric matrix")
          if (use_gmp) 
              stop("dist must be a function or a numeric/character matrix")
      }
      if (class(dist) == "matrix") {
          Rho <- dist[rownames(j1), colnames(j1)]
      }
      else {
          if (use_gmp) {
              Rho <- outer(rownames(j1), colnames(j1), FUN = Vectorize_bigq(rho))
          }
          else {
              Rho <- outer(rownames(j1), colnames(j1), FUN = rho)
          }
      }
      distances <- if (use_gmp) 
          gmp::as.bigq(numeric(n.joinings))
      else numeric(n.joinings)
      for (k in 1:n.joinings) {
          joining <- joinings[[k]]
          if (use_gmp) {
              distances[k] <- sum(Rho * as.bigq(joining))
          }
          else {
              distances[k] <- sum(Rho * joining)
          }
      }
      out <- list(joinings = joinings, distances = distances)
      return(out)
  }
  <bytecode: 0x197ec80>
  <environment: namespace:kantorovich>
   --- function search by body ---
  Function edistances in namespace kantorovich has this body.
   ----------- END OF FAILURE REPORT -------------- 
  -- 1. Error: Pascal (@test-Pascal.R#61)  ---------------------------------------
  the condition has length > 1
  Backtrace:
   1. kantorovich::kantorovich(...)
   2. kantorovich::edistances(mu = mu, nu = nu, dist = dist, ...)
  
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  kantorovich
   --- call from context --- 
  edistances(mu, nu, dist = M)
   --- call from argument --- 
  if (class(dist) == "function") {
      rho <- function(x, y) dist(x, y, ...)
  } else if (class(dist) == "matrix") {
      if (!use_gmp && mode(dist) != "numeric") 
          stop("The dist matrix must be numeric if mu and nu are numeric")
      if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
          stop("Invalid dimension of the dist matrix")
      if (is.null(rownames(dist))) 
          rownames(dist) <- 1:nrow(dist)
      if (is.null(colnames(dist))) 
          colnames(dist) <- 1:ncol(dist)
      if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
          colnames(dist))) 
          stop("Invalid dimension names of the dist matrix")
  } else {
      if (!use_gmp) 
          stop("dist must be a function or a numeric matrix")
      if (use_gmp) 
          stop("dist must be a function or a numeric/character matrix")
  }
   --- R stacktrace ---
  where 1 at testthat/test-edistances.R#16: edistances(mu, nu, dist = M)
  where 2: eval(code, test_env)
  where 3: eval(code, test_env)
  where 4: 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 5: doTryCatch(return(expr), name, parentenv, handler)
  where 6: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 7: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 8: doTryCatch(return(expr), name, parentenv, handler)
  where 9: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 10: tryCatchList(expr, classes, parentenv, handlers)
  where 11: 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 12: test_code(desc, code, env = parent.frame())
  where 13 at testthat/test-edistances.R#3: test_that("Main example - numeric", {
      mu <- c(1/7, 2/7, 4/7)
      nu <- c(1/4, 1/4, 1/2)
      x <- edistances(mu, nu)
      expect_true(length(x[[1]]) == 15 && length(x[[2]]) == 15)
      expect_equal(x$joinings[[1]], structure(c(0.142857142857143, 
          0, 0.107142857142857, 0, 0, 0.25, 0, 0.285714285714286, 
          0.214285714285714), .Dim = c(3L, 3L), .Dimnames = list(c("1", 
          "2", "3"), c("1", "2", "3"))))
      expect_equal(x$distances[[1]], 0.642857142857143)
      M <- matrix(1, nrow = 3, ncol = 3) - diag(3)
      rownames(M) <- colnames(M) <- 1:3
      x <- edistances(mu, nu, dist = M)
      expect_true(length(x[[1]]) == 15 && length(x[[2]]) == 15)
      expect_equal(x$joinings[[1]], structure(c(0.142857142857143, 
          0, 0.107142857142857, 0, 0, 0.25, 0, 0.285714285714286, 
          0.214285714285714), .Dim = c(3L, 3L), .Dimnames = list(c("1", 
          "2", "3"), c("1", "2", "3"))))
      expect_equal(x$distances[[1]], 0.642857142857143)
      M <- matrix(1, nrow = 3, ncol = 3) - diag(3)
      x <- edistances(mu, nu, dist = M)
      expect_true(length(x[[1]]) == 15 && length(x[[2]]) == 15)
      expect_equal(x$joinings[[1]], structure(c(0.142857142857143, 
          0, 0.107142857142857, 0, 0, 0.25, 0, 0.285714285714286, 
          0.214285714285714), .Dim = c(3L, 3L), .Dimnames = list(c("1", 
          "2", "3"), c("1", "2", "3"))))
      expect_equal(x$distances[[1]], 0.642857142857143)
      M <- matrix(1, nrow = 3, ncol = 3) - diag(3)
      rownames(M) <- colnames(M) <- c("a", "b", "c")
      expect_error(edistances(mu, nu, dist = M))
      M <- matrix("1", nrow = 3, ncol = 3)
      diag(M) <- "0"
      expect_error(edistances(mu, nu, dist = M))
  })
  where 14: eval(code, test_env)
  where 15: eval(code, test_env)
  where 16: 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 17: doTryCatch(return(expr), name, parentenv, handler)
  where 18: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 19: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 20: doTryCatch(return(expr), name, parentenv, handler)
  where 21: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 22: tryCatchList(expr, classes, parentenv, handlers)
  where 23: 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 24: test_code(NULL, exprs, env)
  where 25: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 26: force(code)
  where 27: doWithOneRestart(return(expr), restart)
  where 28: withOneRestart(expr, restarts[[1L]])
  where 29: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 30: 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 31: FUN(X[[i]], ...)
  where 32: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  where 33: force(code)
  where 34: doWithOneRestart(return(expr), restart)
  where 35: withOneRestart(expr, restarts[[1L]])
  where 36: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 37: 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 38: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 39: 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 40: 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 41: test_check("kantorovich")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (mu, nu, dist = NULL, ...) 
  {
      joinings <- ejoinings(mu, nu, zeros = TRUE)
      n.joinings <- length(joinings)
      j1 <- joinings[[1]]
      use_gmp <- class(mu) %in% c("bigq", "character")
      if (is.null(dist)) {
          rho <- function(x, y) discrete(x, y, gmp = use_gmp)
      }
      else if (class(dist) == "function") {
          rho <- function(x, y) dist(x, y, ...)
      }
      else if (class(dist) == "matrix") {
          if (!use_gmp && mode(dist) != "numeric") 
              stop("The dist matrix must be numeric if mu and nu are numeric")
          if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
              stop("Invalid dimension of the dist matrix")
          if (is.null(rownames(dist))) 
              rownames(dist) <- 1:nrow(dist)
          if (is.null(colnames(dist))) 
              colnames(dist) <- 1:ncol(dist)
          if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
              colnames(dist))) 
              stop("Invalid dimension names of the dist matrix")
      }
      else {
          if (!use_gmp) 
              stop("dist must be a function or a numeric matrix")
          if (use_gmp) 
              stop("dist must be a function or a numeric/character matrix")
      }
      if (class(dist) == "matrix") {
          Rho <- dist[rownames(j1), colnames(j1)]
      }
      else {
          if (use_gmp) {
              Rho <- outer(rownames(j1), colnames(j1), FUN = Vectorize_bigq(rho))
          }
          else {
              Rho <- outer(rownames(j1), colnames(j1), FUN = rho)
          }
      }
      distances <- if (use_gmp) 
          gmp::as.bigq(numeric(n.joinings))
      else numeric(n.joinings)
      for (k in 1:n.joinings) {
          joining <- joinings[[k]]
          if (use_gmp) {
              distances[k] <- sum(Rho * as.bigq(joining))
          }
          else {
              distances[k] <- sum(Rho * joining)
          }
      }
      out <- list(joinings = joinings, distances = distances)
      return(out)
  }
  <bytecode: 0x197ec80>
  <environment: namespace:kantorovich>
   --- function search by body ---
  Function edistances in namespace kantorovich has this body.
   ----------- END OF FAILURE REPORT -------------- 
  -- 2. Error: Main example - numeric (@test-edistances.R#16)  -------------------
  the condition has length > 1
  Backtrace:
   1. kantorovich::edistances(mu, nu, dist = M)
  
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  kantorovich
   --- call from context --- 
  edistances(mu, nu, dist = M)
   --- call from argument --- 
  if (class(dist) == "function") {
      rho <- function(x, y) dist(x, y, ...)
  } else if (class(dist) == "matrix") {
      if (!use_gmp && mode(dist) != "numeric") 
          stop("The dist matrix must be numeric if mu and nu are numeric")
      if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
          stop("Invalid dimension of the dist matrix")
      if (is.null(rownames(dist))) 
          rownames(dist) <- 1:nrow(dist)
      if (is.null(colnames(dist))) 
          colnames(dist) <- 1:ncol(dist)
      if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
          colnames(dist))) 
          stop("Invalid dimension names of the dist matrix")
  } else {
      if (!use_gmp) 
          stop("dist must be a function or a numeric matrix")
      if (use_gmp) 
          stop("dist must be a function or a numeric/character matrix")
  }
   --- R stacktrace ---
  where 1 at testthat/test-edistances.R#53: edistances(mu, nu, dist = M)
  where 2: eval(code, test_env)
  where 3: eval(code, test_env)
  where 4: 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 5: doTryCatch(return(expr), name, parentenv, handler)
  where 6: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 7: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 8: doTryCatch(return(expr), name, parentenv, handler)
  where 9: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 10: tryCatchList(expr, classes, parentenv, handlers)
  where 11: 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 12: test_code(desc, code, env = parent.frame())
  where 13 at testthat/test-edistances.R#40: test_that("Main example - bigq", {
      mu <- as.bigq(c(1, 2, 4), 7)
      nu <- as.bigq(c(1, 1, 1), c(4, 4, 2))
      x <- edistances(mu, nu)
      expect_true(length(x[[1]]) == 15 && length(x[[2]]) == 15)
      expect_equal(x$joinings[[1]], structure(c("1/7", "0", "3/28", 
          "0", "0", "1/4", "0", "2/7", "3/14"), .Dim = c(3L, 3L), 
          .Dimnames = list(c("1", "2", "3"), c("1", "2", "3"))))
      expect_equal(x$distances[[1]], as.bigq(9, 14))
      M <- matrix(1, nrow = 3, ncol = 3) - diag(3)
      x <- edistances(mu, nu, dist = M)
      expect_true(length(x[[1]]) == 15 && length(x[[2]]) == 15)
      expect_equal(x$joinings[[1]], structure(c("1/7", "0", "3/28", 
          "0", "0", "1/4", "0", "2/7", "3/14"), .Dim = c(3L, 3L), 
          .Dimnames = list(c("1", "2", "3"), c("1", "2", "3"))))
      M <- matrix("1", nrow = 3, ncol = 3)
      diag(M) <- "0"
      x <- edistances(mu, nu, dist = M)
      expect_true(length(x[[1]]) == 15 && length(x[[2]]) == 15)
      expect_equal(x$joinings[[1]], structure(c("1/7", "0", "3/28", 
          "0", "0", "1/4", "0", "2/7", "3/14"), .Dim = c(3L, 3L), 
          .Dimnames = list(c("1", "2", "3"), c("1", "2", "3"))))
      M <- as.bigq(M)
      expect_error(edistances(mu, nu, dist = M))
  })
  where 14: eval(code, test_env)
  where 15: eval(code, test_env)
  where 16: 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 17: doTryCatch(return(expr), name, parentenv, handler)
  where 18: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 19: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 20: doTryCatch(return(expr), name, parentenv, handler)
  where 21: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 22: tryCatchList(expr, classes, parentenv, handlers)
  where 23: 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 24: test_code(NULL, exprs, env)
  where 25: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 26: force(code)
  where 27: doWithOneRestart(return(expr), restart)
  where 28: withOneRestart(expr, restarts[[1L]])
  where 29: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 30: 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 31: FUN(X[[i]], ...)
  where 32: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  where 33: force(code)
  where 34: doWithOneRestart(return(expr), restart)
  where 35: withOneRestart(expr, restarts[[1L]])
  where 36: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 37: 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 38: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 39: 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 40: 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 41: test_check("kantorovich")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (mu, nu, dist = NULL, ...) 
  {
      joinings <- ejoinings(mu, nu, zeros = TRUE)
      n.joinings <- length(joinings)
      j1 <- joinings[[1]]
      use_gmp <- class(mu) %in% c("bigq", "character")
      if (is.null(dist)) {
          rho <- function(x, y) discrete(x, y, gmp = use_gmp)
      }
      else if (class(dist) == "function") {
          rho <- function(x, y) dist(x, y, ...)
      }
      else if (class(dist) == "matrix") {
          if (!use_gmp && mode(dist) != "numeric") 
              stop("The dist matrix must be numeric if mu and nu are numeric")
          if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
              stop("Invalid dimension of the dist matrix")
          if (is.null(rownames(dist))) 
              rownames(dist) <- 1:nrow(dist)
          if (is.null(colnames(dist))) 
              colnames(dist) <- 1:ncol(dist)
          if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
              colnames(dist))) 
              stop("Invalid dimension names of the dist matrix")
      }
      else {
          if (!use_gmp) 
              stop("dist must be a function or a numeric matrix")
          if (use_gmp) 
              stop("dist must be a function or a numeric/character matrix")
      }
      if (class(dist) == "matrix") {
          Rho <- dist[rownames(j1), colnames(j1)]
      }
      else {
          if (use_gmp) {
              Rho <- outer(rownames(j1), colnames(j1), FUN = Vectorize_bigq(rho))
          }
          else {
              Rho <- outer(rownames(j1), colnames(j1), FUN = rho)
          }
      }
      distances <- if (use_gmp) 
          gmp::as.bigq(numeric(n.joinings))
      else numeric(n.joinings)
      for (k in 1:n.joinings) {
          joining <- joinings[[k]]
          if (use_gmp) {
              distances[k] <- sum(Rho * as.bigq(joining))
          }
          else {
              distances[k] <- sum(Rho * joining)
          }
      }
      out <- list(joinings = joinings, distances = distances)
      return(out)
  }
  <bytecode: 0x197ec80>
  <environment: namespace:kantorovich>
   --- function search by body ---
  Function edistances in namespace kantorovich has this body.
   ----------- END OF FAILURE REPORT -------------- 
  -- 3. Error: Main example - bigq (@test-edistances.R#53)  ----------------------
  the condition has length > 1
  Backtrace:
   1. kantorovich::edistances(mu, nu, dist = M)
  
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  kantorovich
   --- call from context --- 
  edistances(mu = mu, nu = nu, dist = dist, ...)
   --- call from argument --- 
  if (class(dist) == "function") {
      rho <- function(x, y) dist(x, y, ...)
  } else if (class(dist) == "matrix") {
      if (!use_gmp && mode(dist) != "numeric") 
          stop("The dist matrix must be numeric if mu and nu are numeric")
      if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
          stop("Invalid dimension of the dist matrix")
      if (is.null(rownames(dist))) 
          rownames(dist) <- 1:nrow(dist)
      if (is.null(colnames(dist))) 
          colnames(dist) <- 1:ncol(dist)
      if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
          colnames(dist))) 
          stop("Invalid dimension names of the dist matrix")
  } else {
      if (!use_gmp) 
          stop("dist must be a function or a numeric matrix")
      if (use_gmp) 
          stop("dist must be a function or a numeric/character matrix")
  }
   --- R stacktrace ---
  where 1: edistances(mu = mu, nu = nu, dist = dist, ...)
  where 2 at testthat/test-glpk.R#40: kantorovich(mu, nu, dist = D, details = TRUE)
  where 3: eval(code, test_env)
  where 4: eval(code, test_env)
  where 5: 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 6: doTryCatch(return(expr), name, parentenv, handler)
  where 7: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 8: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 9: doTryCatch(return(expr), name, parentenv, handler)
  where 10: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 11: tryCatchList(expr, classes, parentenv, handlers)
  where 12: 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 13: test_code(desc, code, env = parent.frame())
  where 14 at testthat/test-glpk.R#27: test_that("kantorovich_glpk - nonsymmetric dist", {
      mu <- c(1, 2, 4)/7
      nu <- c(3, 1, 5)/9
      D <- matrix(c(c(0, 1, 3), c(1, 0, 4), c(2, 4, 0)), byrow = TRUE, 
          nrow = 3)
      x <- kantorovich_glpk(mu, nu, dist = D)
      expect_equal(x, 13/63)
      x1 <- kantorovich_glpk(mu, nu, dist = D, solution = TRUE)
      x2 <- kantorovich(mu, nu, dist = D, details = TRUE)
      expect_true(all.equal(attr(x1, "solution"), attr(x2, "joinings")[[1]], 
          tolerance = 1e-15, check.attributes = FALSE))
  })
  where 15: eval(code, test_env)
  where 16: eval(code, test_env)
  where 17: 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 18: doTryCatch(return(expr), name, parentenv, handler)
  where 19: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 20: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 21: doTryCatch(return(expr), name, parentenv, handler)
  where 22: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 23: tryCatchList(expr, classes, parentenv, handlers)
  where 24: 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 25: test_code(NULL, exprs, env)
  where 26: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 27: force(code)
  where 28: doWithOneRestart(return(expr), restart)
  where 29: withOneRestart(expr, restarts[[1L]])
  where 30: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 31: 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 32: FUN(X[[i]], ...)
  where 33: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, 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 = current_reporter, results <- lapply(paths, 
      test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE, 
      load_helpers = FALSE, wrap = wrap))
  where 39: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 40: 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 41: 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 42: test_check("kantorovich")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (mu, nu, dist = NULL, ...) 
  {
      joinings <- ejoinings(mu, nu, zeros = TRUE)
      n.joinings <- length(joinings)
      j1 <- joinings[[1]]
      use_gmp <- class(mu) %in% c("bigq", "character")
      if (is.null(dist)) {
          rho <- function(x, y) discrete(x, y, gmp = use_gmp)
      }
      else if (class(dist) == "function") {
          rho <- function(x, y) dist(x, y, ...)
      }
      else if (class(dist) == "matrix") {
          if (!use_gmp && mode(dist) != "numeric") 
              stop("The dist matrix must be numeric if mu and nu are numeric")
          if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
              stop("Invalid dimension of the dist matrix")
          if (is.null(rownames(dist))) 
              rownames(dist) <- 1:nrow(dist)
          if (is.null(colnames(dist))) 
              colnames(dist) <- 1:ncol(dist)
          if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
              colnames(dist))) 
              stop("Invalid dimension names of the dist matrix")
      }
      else {
          if (!use_gmp) 
              stop("dist must be a function or a numeric matrix")
          if (use_gmp) 
              stop("dist must be a function or a numeric/character matrix")
      }
      if (class(dist) == "matrix") {
          Rho <- dist[rownames(j1), colnames(j1)]
      }
      else {
          if (use_gmp) {
              Rho <- outer(rownames(j1), colnames(j1), FUN = Vectorize_bigq(rho))
          }
          else {
              Rho <- outer(rownames(j1), colnames(j1), FUN = rho)
          }
      }
      distances <- if (use_gmp) 
          gmp::as.bigq(numeric(n.joinings))
      else numeric(n.joinings)
      for (k in 1:n.joinings) {
          joining <- joinings[[k]]
          if (use_gmp) {
              distances[k] <- sum(Rho * as.bigq(joining))
          }
          else {
              distances[k] <- sum(Rho * joining)
          }
      }
      out <- list(joinings = joinings, distances = distances)
      return(out)
  }
  <bytecode: 0x197ec80>
  <environment: namespace:kantorovich>
   --- function search by body ---
  Function edistances in namespace kantorovich has this body.
   ----------- END OF FAILURE REPORT -------------- 
  -- 4. Error: kantorovich_glpk - nonsymmetric dist (@test-glpk.R#40)  -----------
  the condition has length > 1
  Backtrace:
   1. kantorovich::kantorovich(mu, nu, dist = D, details = TRUE)
   2. kantorovich::edistances(mu = mu, nu = nu, dist = dist, ...)
  
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  kantorovich
   --- call from context --- 
  edistances(mu = mu, nu = nu, dist = dist, ...)
   --- call from argument --- 
  if (class(dist) == "function") {
      rho <- function(x, y) dist(x, y, ...)
  } else if (class(dist) == "matrix") {
      if (!use_gmp && mode(dist) != "numeric") 
          stop("The dist matrix must be numeric if mu and nu are numeric")
      if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
          stop("Invalid dimension of the dist matrix")
      if (is.null(rownames(dist))) 
          rownames(dist) <- 1:nrow(dist)
      if (is.null(colnames(dist))) 
          colnames(dist) <- 1:ncol(dist)
      if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
          colnames(dist))) 
          stop("Invalid dimension names of the dist matrix")
  } else {
      if (!use_gmp) 
          stop("dist must be a function or a numeric matrix")
      if (use_gmp) 
          stop("dist must be a function or a numeric/character matrix")
  }
   --- R stacktrace ---
  where 1: edistances(mu = mu, nu = nu, dist = dist, ...)
  where 2: kantorovich(mu, nu, dist = M)
  where 3: eval_bare(quo_get_expr(.quo), quo_get_env(.quo))
  where 4: withCallingHandlers({
      code
      NULL
  }, error = function(cnd) {
      if (can_entrace(cnd)) {
          cnd <- cnd_entrace(cnd)
      }
      return_from(env, cnd)
  })
  where 5: .capture(act$val <- eval_bare(quo_get_expr(.quo), quo_get_env(.quo)), 
      ...)
  where 6: quasi_capture(enquo(object), label, capture_error, entrace = TRUE)
  where 7 at testthat/test-kantorovich.R#23: expect_error(kantorovich(mu, nu, dist = M))
  where 8: eval(code, test_env)
  where 9: eval(code, test_env)
  where 10: 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 11: doTryCatch(return(expr), name, parentenv, handler)
  where 12: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 13: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 14: doTryCatch(return(expr), name, parentenv, handler)
  where 15: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 16: tryCatchList(expr, classes, parentenv, handlers)
  where 17: 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 18: test_code(desc, code, env = parent.frame())
  where 19 at testthat/test-kantorovich.R#3: test_that("Main example - numeric mode", {
      mu <- c(1/7, 2/7, 4/7)
      nu <- c(1/4, 1/4, 1/2)
      x <- kantorovich(mu, nu)
      expect_equal(x, 0.107142857142857)
      mu <- setNames(mu, c("a", "b", "c"))
      nu <- setNames(nu, c("a", "b", "c"))
      x <- kantorovich(mu, nu)
      expect_equal(x, 0.107142857142857)
      mu <- setNames(mu, c("a", "b", "c"))
      nu <- c(c = 1/2, a = 1/4, b = 1/4)
      x <- kantorovich(mu, nu)
      expect_equal(x, 0.107142857142857)
      mu <- setNames(c(1/7, 2/7, 4/7), c("a", "b", "c"))
      nu <- setNames(c(1/4, 1/4, 1/2), c("a", "b", "c"))
      M <- matrix(1, nrow = 3, ncol = 3) - diag(3)
      expect_error(kantorovich(mu, nu, dist = M))
      rownames(M) <- colnames(M) <- c("a", "b", "c")
      x <- kantorovich(mu, nu, dist = M)
      expect_equal(x, 0.107142857142857)
      mu <- c(1/7, 2/7, 4/7)
      nu <- c(1/4, 1/4, 1/2)
      x <- kantorovich(mu, nu, details = TRUE)
      bestj <- attr(x, "joinings")
      expect_equal(length(bestj), 1)
      expect_equal(bestj[[1]], structure(c(0.142857142857143, 0.0357142857142857, 
          0.0714285714285714, 0, 0.25, 0, 0, 0, 0.5), .Dim = c(3L, 
          3L), .Dimnames = list(c("1", "2", "3"), c("1", "2", "3"))))
  })
  where 20: eval(code, test_env)
  where 21: eval(code, test_env)
  where 22: 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 23: doTryCatch(return(expr), name, parentenv, handler)
  where 24: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 25: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 26: doTryCatch(return(expr), name, parentenv, handler)
  where 27: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 28: tryCatchList(expr, classes, parentenv, handlers)
  where 29: 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 30: test_code(NULL, exprs, env)
  where 31: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 32: force(code)
  where 33: doWithOneRestart(return(expr), restart)
  where 34: withOneRestart(expr, restarts[[1L]])
  where 35: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 36: 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 37: FUN(X[[i]], ...)
  where 38: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  where 39: force(code)
  where 40: doWithOneRestart(return(expr), restart)
  where 41: withOneRestart(expr, restarts[[1L]])
  where 42: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 43: 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 44: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 45: 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 46: 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 47: test_check("kantorovich")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (mu, nu, dist = NULL, ...) 
  {
      joinings <- ejoinings(mu, nu, zeros = TRUE)
      n.joinings <- length(joinings)
      j1 <- joinings[[1]]
      use_gmp <- class(mu) %in% c("bigq", "character")
      if (is.null(dist)) {
          rho <- function(x, y) discrete(x, y, gmp = use_gmp)
      }
      else if (class(dist) == "function") {
          rho <- function(x, y) dist(x, y, ...)
      }
      else if (class(dist) == "matrix") {
          if (!use_gmp && mode(dist) != "numeric") 
              stop("The dist matrix must be numeric if mu and nu are numeric")
          if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
              stop("Invalid dimension of the dist matrix")
          if (is.null(rownames(dist))) 
              rownames(dist) <- 1:nrow(dist)
          if (is.null(colnames(dist))) 
              colnames(dist) <- 1:ncol(dist)
          if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
              colnames(dist))) 
              stop("Invalid dimension names of the dist matrix")
      }
      else {
          if (!use_gmp) 
              stop("dist must be a function or a numeric matrix")
          if (use_gmp) 
              stop("dist must be a function or a numeric/character matrix")
      }
      if (class(dist) == "matrix") {
          Rho <- dist[rownames(j1), colnames(j1)]
      }
      else {
          if (use_gmp) {
              Rho <- outer(rownames(j1), colnames(j1), FUN = Vectorize_bigq(rho))
          }
          else {
              Rho <- outer(rownames(j1), colnames(j1), FUN = rho)
          }
      }
      distances <- if (use_gmp) 
          gmp::as.bigq(numeric(n.joinings))
      else numeric(n.joinings)
      for (k in 1:n.joinings) {
          joining <- joinings[[k]]
          if (use_gmp) {
              distances[k] <- sum(Rho * as.bigq(joining))
          }
          else {
              distances[k] <- sum(Rho * joining)
          }
      }
      out <- list(joinings = joinings, distances = distances)
      return(out)
  }
  <bytecode: 0x197ec80>
  <environment: namespace:kantorovich>
   --- function search by body ---
  Function edistances in namespace kantorovich has this body.
   ----------- END OF FAILURE REPORT -------------- 
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  kantorovich
   --- call from context --- 
  edistances(mu = mu, nu = nu, dist = dist, ...)
   --- call from argument --- 
  if (class(dist) == "function") {
      rho <- function(x, y) dist(x, y, ...)
  } else if (class(dist) == "matrix") {
      if (!use_gmp && mode(dist) != "numeric") 
          stop("The dist matrix must be numeric if mu and nu are numeric")
      if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
          stop("Invalid dimension of the dist matrix")
      if (is.null(rownames(dist))) 
          rownames(dist) <- 1:nrow(dist)
      if (is.null(colnames(dist))) 
          colnames(dist) <- 1:ncol(dist)
      if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
          colnames(dist))) 
          stop("Invalid dimension names of the dist matrix")
  } else {
      if (!use_gmp) 
          stop("dist must be a function or a numeric matrix")
      if (use_gmp) 
          stop("dist must be a function or a numeric/character matrix")
  }
   --- R stacktrace ---
  where 1: edistances(mu = mu, nu = nu, dist = dist, ...)
  where 2 at testthat/test-kantorovich.R#26: kantorovich(mu, nu, dist = M)
  where 3: eval(code, test_env)
  where 4: eval(code, test_env)
  where 5: 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 6: doTryCatch(return(expr), name, parentenv, handler)
  where 7: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 8: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 9: doTryCatch(return(expr), name, parentenv, handler)
  where 10: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 11: tryCatchList(expr, classes, parentenv, handlers)
  where 12: 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 13: test_code(desc, code, env = parent.frame())
  where 14 at testthat/test-kantorovich.R#3: test_that("Main example - numeric mode", {
      mu <- c(1/7, 2/7, 4/7)
      nu <- c(1/4, 1/4, 1/2)
      x <- kantorovich(mu, nu)
      expect_equal(x, 0.107142857142857)
      mu <- setNames(mu, c("a", "b", "c"))
      nu <- setNames(nu, c("a", "b", "c"))
      x <- kantorovich(mu, nu)
      expect_equal(x, 0.107142857142857)
      mu <- setNames(mu, c("a", "b", "c"))
      nu <- c(c = 1/2, a = 1/4, b = 1/4)
      x <- kantorovich(mu, nu)
      expect_equal(x, 0.107142857142857)
      mu <- setNames(c(1/7, 2/7, 4/7), c("a", "b", "c"))
      nu <- setNames(c(1/4, 1/4, 1/2), c("a", "b", "c"))
      M <- matrix(1, nrow = 3, ncol = 3) - diag(3)
      expect_error(kantorovich(mu, nu, dist = M))
      rownames(M) <- colnames(M) <- c("a", "b", "c")
      x <- kantorovich(mu, nu, dist = M)
      expect_equal(x, 0.107142857142857)
      mu <- c(1/7, 2/7, 4/7)
      nu <- c(1/4, 1/4, 1/2)
      x <- kantorovich(mu, nu, details = TRUE)
      bestj <- attr(x, "joinings")
      expect_equal(length(bestj), 1)
      expect_equal(bestj[[1]], structure(c(0.142857142857143, 0.0357142857142857, 
          0.0714285714285714, 0, 0.25, 0, 0, 0, 0.5), .Dim = c(3L, 
          3L), .Dimnames = list(c("1", "2", "3"), c("1", "2", "3"))))
  })
  where 15: eval(code, test_env)
  where 16: eval(code, test_env)
  where 17: 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 18: doTryCatch(return(expr), name, parentenv, handler)
  where 19: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 20: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 21: doTryCatch(return(expr), name, parentenv, handler)
  where 22: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 23: tryCatchList(expr, classes, parentenv, handlers)
  where 24: 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 25: test_code(NULL, exprs, env)
  where 26: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 27: force(code)
  where 28: doWithOneRestart(return(expr), restart)
  where 29: withOneRestart(expr, restarts[[1L]])
  where 30: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 31: 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 32: FUN(X[[i]], ...)
  where 33: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, 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 = current_reporter, results <- lapply(paths, 
      test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE, 
      load_helpers = FALSE, wrap = wrap))
  where 39: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 40: 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 41: 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 42: test_check("kantorovich")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (mu, nu, dist = NULL, ...) 
  {
      joinings <- ejoinings(mu, nu, zeros = TRUE)
      n.joinings <- length(joinings)
      j1 <- joinings[[1]]
      use_gmp <- class(mu) %in% c("bigq", "character")
      if (is.null(dist)) {
          rho <- function(x, y) discrete(x, y, gmp = use_gmp)
      }
      else if (class(dist) == "function") {
          rho <- function(x, y) dist(x, y, ...)
      }
      else if (class(dist) == "matrix") {
          if (!use_gmp && mode(dist) != "numeric") 
              stop("The dist matrix must be numeric if mu and nu are numeric")
          if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
              stop("Invalid dimension of the dist matrix")
          if (is.null(rownames(dist))) 
              rownames(dist) <- 1:nrow(dist)
          if (is.null(colnames(dist))) 
              colnames(dist) <- 1:ncol(dist)
          if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
              colnames(dist))) 
              stop("Invalid dimension names of the dist matrix")
      }
      else {
          if (!use_gmp) 
              stop("dist must be a function or a numeric matrix")
          if (use_gmp) 
              stop("dist must be a function or a numeric/character matrix")
      }
      if (class(dist) == "matrix") {
          Rho <- dist[rownames(j1), colnames(j1)]
      }
      else {
          if (use_gmp) {
              Rho <- outer(rownames(j1), colnames(j1), FUN = Vectorize_bigq(rho))
          }
          else {
              Rho <- outer(rownames(j1), colnames(j1), FUN = rho)
          }
      }
      distances <- if (use_gmp) 
          gmp::as.bigq(numeric(n.joinings))
      else numeric(n.joinings)
      for (k in 1:n.joinings) {
          joining <- joinings[[k]]
          if (use_gmp) {
              distances[k] <- sum(Rho * as.bigq(joining))
          }
          else {
              distances[k] <- sum(Rho * joining)
          }
      }
      out <- list(joinings = joinings, distances = distances)
      return(out)
  }
  <bytecode: 0x197ec80>
  <environment: namespace:kantorovich>
   --- function search by body ---
  Function edistances in namespace kantorovich has this body.
   ----------- END OF FAILURE REPORT -------------- 
  -- 5. Error: Main example - numeric mode (@test-kantorovich.R#26)  -------------
  the condition has length > 1
  Backtrace:
   1. kantorovich::kantorovich(mu, nu, dist = M)
   2. kantorovich::edistances(mu = mu, nu = nu, dist = dist, ...)
  
  The Kantorovich distance is achieved for 1 joining(s) among the 15 extreme joining(s), given in the 'joinings' attribute of the output.
  The Kantorovich distance is achieved for 1 joining(s) among the 15 extreme joining(s), given in the 'joinings' attribute of the output.
  The Kantorovich distance is achieved for 1 joining(s) among the 15 extreme joining(s), given in the 'joinings' attribute of the output.
  The Kantorovich distance is achieved for 1 joining(s) among the 15 extreme joining(s), given in the 'joinings' attribute of the output.
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  kantorovich
   --- call from context --- 
  edistances(mu = mu, nu = nu, dist = dist, ...)
   --- call from argument --- 
  if (class(dist) == "function") {
      rho <- function(x, y) dist(x, y, ...)
  } else if (class(dist) == "matrix") {
      if (!use_gmp && mode(dist) != "numeric") 
          stop("The dist matrix must be numeric if mu and nu are numeric")
      if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
          stop("Invalid dimension of the dist matrix")
      if (is.null(rownames(dist))) 
          rownames(dist) <- 1:nrow(dist)
      if (is.null(colnames(dist))) 
          colnames(dist) <- 1:ncol(dist)
      if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
          colnames(dist))) 
          stop("Invalid dimension names of the dist matrix")
  } else {
      if (!use_gmp) 
          stop("dist must be a function or a numeric matrix")
      if (use_gmp) 
          stop("dist must be a function or a numeric/character matrix")
  }
   --- R stacktrace ---
  where 1: edistances(mu = mu, nu = nu, dist = dist, ...)
  where 2 at testthat/test-lpSolve.R#44: kantorovich(mu, nu, dist = D, details = TRUE)
  where 3: eval(code, test_env)
  where 4: eval(code, test_env)
  where 5: 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 6: doTryCatch(return(expr), name, parentenv, handler)
  where 7: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 8: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 9: doTryCatch(return(expr), name, parentenv, handler)
  where 10: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 11: tryCatchList(expr, classes, parentenv, handlers)
  where 12: 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 13: test_code(desc, code, env = parent.frame())
  where 14 at testthat/test-lpSolve.R#31: test_that("kantorovich_lp - nonsymmetric dist", {
      mu <- c(1, 2, 4)/7
      nu <- c(3, 1, 5)/9
      D <- matrix(c(c(0, 1, 3), c(1, 0, 4), c(2, 4, 0)), byrow = TRUE, 
          nrow = 3)
      x <- kantorovich_lp(mu, nu, dist = D)
      expect_equal(x, 13/63)
      x1 <- kantorovich_lp(mu, nu, dist = D, solution = TRUE)
      x2 <- kantorovich(mu, nu, dist = D, details = TRUE)
      expect_true(all.equal(attr(x1, "solution"), attr(x2, "joinings")[[1]], 
          tolerance = 1e-15, check.attributes = FALSE))
  })
  where 15: eval(code, test_env)
  where 16: eval(code, test_env)
  where 17: 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 18: doTryCatch(return(expr), name, parentenv, handler)
  where 19: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 20: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 21: doTryCatch(return(expr), name, parentenv, handler)
  where 22: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 23: tryCatchList(expr, classes, parentenv, handlers)
  where 24: 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 25: test_code(NULL, exprs, env)
  where 26: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 27: force(code)
  where 28: doWithOneRestart(return(expr), restart)
  where 29: withOneRestart(expr, restarts[[1L]])
  where 30: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 31: 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 32: FUN(X[[i]], ...)
  where 33: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, 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 = current_reporter, results <- lapply(paths, 
      test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE, 
      load_helpers = FALSE, wrap = wrap))
  where 39: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 40: 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 41: 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 42: test_check("kantorovich")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (mu, nu, dist = NULL, ...) 
  {
      joinings <- ejoinings(mu, nu, zeros = TRUE)
      n.joinings <- length(joinings)
      j1 <- joinings[[1]]
      use_gmp <- class(mu) %in% c("bigq", "character")
      if (is.null(dist)) {
          rho <- function(x, y) discrete(x, y, gmp = use_gmp)
      }
      else if (class(dist) == "function") {
          rho <- function(x, y) dist(x, y, ...)
      }
      else if (class(dist) == "matrix") {
          if (!use_gmp && mode(dist) != "numeric") 
              stop("The dist matrix must be numeric if mu and nu are numeric")
          if (nrow(dist) != length(mu) || ncol(dist) != length(nu)) 
              stop("Invalid dimension of the dist matrix")
          if (is.null(rownames(dist))) 
              rownames(dist) <- 1:nrow(dist)
          if (is.null(colnames(dist))) 
              colnames(dist) <- 1:ncol(dist)
          if (!setequal(rownames(j1), rownames(dist)) || !setequal(colnames(j1), 
              colnames(dist))) 
              stop("Invalid dimension names of the dist matrix")
      }
      else {
          if (!use_gmp) 
              stop("dist must be a function or a numeric matrix")
          if (use_gmp) 
              stop("dist must be a function or a numeric/character matrix")
      }
      if (class(dist) == "matrix") {
          Rho <- dist[rownames(j1), colnames(j1)]
      }
      else {
          if (use_gmp) {
              Rho <- outer(rownames(j1), colnames(j1), FUN = Vectorize_bigq(rho))
          }
          else {
              Rho <- outer(rownames(j1), colnames(j1), FUN = rho)
          }
      }
      distances <- if (use_gmp) 
          gmp::as.bigq(numeric(n.joinings))
      else numeric(n.joinings)
      for (k in 1:n.joinings) {
          joining <- joinings[[k]]
          if (use_gmp) {
              distances[k] <- sum(Rho * as.bigq(joining))
          }
          else {
              distances[k] <- sum(Rho * joining)
          }
      }
      out <- list(joinings = joinings, distances = distances)
      return(out)
  }
  <bytecode: 0x197ec80>
  <environment: namespace:kantorovich>
   --- function search by body ---
  Function edistances in namespace kantorovich has this body.
   ----------- END OF FAILURE REPORT -------------- 
  -- 6. Error: kantorovich_lp - nonsymmetric dist (@test-lpSolve.R#44)  ----------
  the condition has length > 1
  Backtrace:
   1. kantorovich::kantorovich(mu, nu, dist = D, details = TRUE)
   2. kantorovich::edistances(mu = mu, nu = nu, dist = dist, ...)
  
  == testthat results  ===========================================================
  [ OK: 108 | SKIPPED: 0 | WARNINGS: 0 | FAILED: 6 ]
  1. Error: Pascal (@test-Pascal.R#61) 
  2. Error: Main example - numeric (@test-edistances.R#16) 
  3. Error: Main example - bigq (@test-edistances.R#53) 
  4. Error: kantorovich_glpk - nonsymmetric dist (@test-glpk.R#40) 
  5. Error: Main example - numeric mode (@test-kantorovich.R#26) 
  6. Error: kantorovich_lp - nonsymmetric dist (@test-lpSolve.R#44) 
  
  Error: testthat unit tests failed
  Execution halted