CRAN Package Check Results for Package kantorovich

Last updated on 2020-01-19 05:47:10 CET.

Flavor Version Tinstall Tcheck Ttotal Status Flags
r-devel-linux-x86_64-debian-clang 2.0.0 2.81 31.99 34.80 ERROR
r-devel-linux-x86_64-debian-gcc 2.0.0 2.15 24.50 26.65 OK
r-devel-linux-x86_64-fedora-clang 2.0.0 41.80 OK
r-devel-linux-x86_64-fedora-gcc 2.0.0 39.37 OK
r-devel-windows-ix86+x86_64 2.0.0 10.00 63.00 73.00 OK
r-devel-windows-ix86+x86_64-gcc8 2.0.0 8.00 66.00 74.00 OK
r-patched-linux-x86_64 2.0.0 2.32 28.16 30.48 OK
r-patched-solaris-x86 2.0.0 56.60 OK
r-release-linux-x86_64 2.0.0 2.27 28.17 30.44 OK
r-release-windows-ix86+x86_64 2.0.0 8.00 56.00 64.00 OK
r-release-osx-x86_64 2.0.0 OK
r-oldrel-windows-ix86+x86_64 2.0.0 5.00 42.00 47.00 OK
r-oldrel-osx-x86_64 2.0.0 OK

Check Details

Version: 2.0.0
Check: tests
Result: ERROR
     Running 'testthat.R' [4s/5s]
    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: 0x1622e00>
     <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: 0x1622e00>
     <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: 0x1622e00>
     <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: 0x1622e00>
     <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: 0x1622e00>
     <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: 0x1622e00>
     <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: 0x1622e00>
     <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
Flavor: r-devel-linux-x86_64-debian-clang

Version: 2.0.0
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
     ...
    --- re-building 'kantorovich.Rmd' using rmarkdown
    
    Attaching package: 'gmp'
    
    The following objects are masked from 'package:base':
    
     %*%, apply, crossprod, matrix, tcrossprod
    
     ----------- 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(expr, envir, enclos)
    where 4: eval(expr, envir, enclos)
    where 5: withVisible(eval(expr, envir, enclos))
    where 6: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 7: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 8: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 9: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
     debug = debug, last = i == length(out), use_try = stop_on_error !=
     2L, keep_warning = keep_warning, keep_message = keep_message,
     output_handler = output_handler, include_timing = include_timing)
    where 10: evaluate::evaluate(...)
    where 11: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
     keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
     options$include) 0L else 2L, output_handler = knit_handlers(options$render,
     options))
    where 12: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
     keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
     stop_on_error = if (options$error && options$include) 0L else 2L,
     output_handler = knit_handlers(options$render, options)))
    where 13: block_exec(params)
    where 14: call_block(x)
    where 15: process_group.block(group)
    where 16: process_group(group)
    where 17: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
     error = function(e) {
     setwd(wd)
     cat(res, sep = "\n", file = output %n% "")
     message("Quitting from lines ", paste(current_lines(i),
     collapse = "-"), " (", knit_concord$get("infile"),
     ") ")
     })
    where 18: process_file(text, output)
    where 19: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet)
    where 20: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(),
     ...)
    where 21: vweave_rmarkdown(...)
    where 22: engine$weave(file, quiet = quiet, encoding = enc)
    where 23: doTryCatch(return(expr), name, parentenv, handler)
    where 24: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 25: tryCatchList(expr, classes, parentenv, handlers)
    where 26: tryCatch({
     engine$weave(file, quiet = quiet, encoding = enc)
     setwd(startdir)
     output <- find_vignette_product(name, by = "weave", engine = engine)
     if (!have.makefile && vignette_is_tex(output)) {
     texi2pdf(file = output, clean = FALSE, quiet = quiet)
     output <- find_vignette_product(name, by = "texi2pdf",
     engine = engine)
     }
     outputs <- c(outputs, output)
    }, error = function(e) {
     thisOK <<- FALSE
     fails <<- c(fails, file)
     message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
     file, conditionMessage(e)))
    })
    where 27: tools:::buildVignettes(dir = "/home/hornik/tmp/R.check/r-devel-clang/Work/PKGS/kantorovich.Rcheck/vign_test/kantorovich",
     ser_elibs = "/tmp/Rtmp4t5Grr/file4f874a928ab1.rds")
    
     --- 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: 0x35b9378>
    <environment: namespace:kantorovich>
     --- function search by body ---
    Function edistances in namespace kantorovich has this body.
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 75-84 (kantorovich.Rmd)
    Error: processing vignette 'kantorovich.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building 'kantorovich.Rmd'
    
    SUMMARY: processing the following file failed:
     'kantorovich.Rmd'
    
    Error: Vignette re-building failed.
    Execution halted
Flavor: r-devel-linux-x86_64-debian-clang