Running ‘spelling.R’ [0s/0s]
  Running ‘testthat.R’ [18s/14s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library(testthat)
  > library(sbm)
  > library(aricode)
  > 
  > test_check("sbm")
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
   *** caught segfault ***
  address 0x110, cause 'invalid permissions'
  
   *** caught segfault ***
  address 0x110, cause 'invalid permissions'
  
  Traceback:
   1: FUN(X[[i]], ...)
   2: lapply(X = X, FUN = FUN, ...)
   3: sapply(1:cardE, function(e) {    gr = matE[e, 1]    gc = matE[e, 2]    don = list_Mat[[e]]    maskNA = list_MaskNA[[e]]    if (v_distrib[e] == "bernoulli") {        Unmdon = (1 - don) * maskNA    }    if (v_distrib[e] %in% c("laplace", "poisson", "gaussian",         "ZIgaussian")) {        Unit <- maskNA    }    if (v_distrib[e] == "ZIgaussian") {        NonZerosdon <- (don != 0)        Zerosdon <- (don == 0) * maskNA    }    facteur = 1    if (gc < 1) {        if (gc == 0)             facteur = 1/2        gc = gr    }    if (v_distrib[e] == "bernoulli") {        prov = (tau[[gr]]) %*% log(list_theta[[e]]) %*% t(tau[[gc]])        prov1m = (tau[[gr]]) %*% log(1 - list_theta[[e]]) %*%             t(tau[[gc]])        return((sum(don * prov) + sum((Unmdon) * prov1m)) * facteur)    }    if (v_distrib[e] == "poisson") {        prov = (tau[[gr]]) %*% log(list_theta[[e]]) %*% t(tau[[gc]])        prov2 = (tau[[gr]]) %*% list_theta[[e]] %*% t(tau[[gc]])        return((sum(don * prov) - sum(Unit * prov2)) * facteur)    }    if (v_distrib[e] == "laplace") {        prov = (tau[[gr]]) %*% log(2 * list_theta[[e]]) %*% t(tau[[gc]])        prov2 = (tau[[gr]]) %*% (1/list_theta[[e]]) %*% t(tau[[gc]])        return((-sum(Unit * prov) - sum(don * prov2)) * facteur)    }    if (v_distrib[e] == "gaussian") {        prov = 0.5 * (tau[[gr]]) %*% (log(2 * pi * list_theta[[e]]$var) +             list_theta[[e]]$mean^2/list_theta[[e]]$var) %*% t(tau[[gc]])        prov2 = 0.5 * (tau[[gr]]) %*% (1/list_theta[[e]]$var) %*%             t(tau[[gc]])        prov3 = (tau[[gr]]) %*% (list_theta[[e]]$mean/list_theta[[e]]$var) %*%             t(tau[[gc]])        return((-sum(Unit * prov) - sum(don^2 * prov2) + sum(don *             prov3)) * facteur)    }    if (v_distrib[e] == "ZIgaussian") {        prov = 0.5 * (tau[[gr]]) %*% (log(2 * pi * list_theta[[e]]$var) +             list_theta[[e]]$mean^2/list_theta[[e]]$var) %*% t(tau[[gc]])        prov2 = 0.5 * (tau[[gr]]) %*% (1/list_theta[[e]]$var) %*%             t(tau[[gc]])        prov3 = (tau[[gr]]) %*% (list_theta[[e]]$mean/list_theta[[e]]$var) %*%             t(tau[[gc]])        P1 <- sum((-Unit * prov - don^2 * prov2 + don * prov3) *             (1 - Zerosdon))        prov4 = (tau[[gr]]) %*% log(list_theta[[e]]$p0 + (list_theta[[e]]$p0 ==             0)) %*% t(tau[[gc]])        prov4m = (tau[[gr]]) %*% log(1 - list_theta[[e]]$p0 +             (list_theta[[e]]$p0 == 1)) %*% t(tau[[gc]])        P2 <- sum(Zerosdon * prov4) + sum((1 - Zerosdon) * prov4m)        return((P1 + P2) * facteur)    }})
   4: compLikICLInt(tau, list_theta, list_pi, matE, list_Mat, list_MaskNA,     n_q, v_K, v_distrib)
   5: varEMMBM(self, classif, tau = tau, maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
   6: dataR6$estime(list_classif_init[[l]], maxiterVE = maxiterVE,     maxiterVEM = maxiterVEM)
   7: FUN(X[[i]], ...)
   8: lapply(X = S, FUN = FUN, ...)
   9: doTryCatch(return(expr), name, parentenv, handler)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: tryCatchList(expr, classes, parentenv, handlers)
  12: tryCatch(expr, error = function(e) {    call <- conditionCall(e)    if (!is.null(call)) {        if (identical(call[[1L]], quote(doTryCatch)))             call <- sys.call(-4L)        dcall <- deparse(call, nlines = 1L)        prefix <- paste("Error in", dcall, ": ")        LONG <- 75L        sm <- strsplit(conditionMessage(e), "\n")[[1L]]        w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")        if (is.na(w))             w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L],                 type = "b")        if (w > LONG)             prefix <- paste0(prefix, "\n  ")    }    else prefix <- "Error : "    msg <- paste0(prefix, conditionMessage(e), "\n")    .Internal(seterrmessage(msg[1L]))    if (!silent && isTRUE(getOption("show.error.messages"))) {        cat(msg, file = outFile)        .Internal(printDeferredWarnings())    }    invisible(structure(msg, class = "try-error", condition = e))})
  13: try(lapply(X = S, FUN = FUN, ...), silent = TRUE)
  14: sendMaster(try(lapply(X = S, FUN = FUN, ...), silent = TRUE))
  15: FUN(X[[i]], ...)
  16: lapply(seq_len(cores), inner.do)
  17: mclapply(1:L, function(l) {    estim.c.l <- dataR6$estime(list_classif_init[[l]], maxiterVE = maxiterVE,         maxiterVEM = maxiterVEM)}, mc.cores = nbCores)
  18: searchKQ(dataR6 = self, classifInit = classifInit, pastICL = pastICL,     Kmin = Kmin, Kmax = Kmax, nbCores = nbCores, verbose = verbose,     maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
  19: dataR6$searchNbClusters(classifInit, Kmin = v_Kmin, Kmax = v_Kmax,     pastICL = c(), verbose = verbose, nbCores = nbCores, maxiterVE = maxiterVE,     maxiterVEM = maxiterVEM)
  20: GREMLINS::multipartiteBM(list_Net = listNetG, v_distrib = vdistrib,     namesFG = namesFG, v_Kmin = v_Kmin, v_Kmax = v_Kmax, v_Kinit = NULL,     initBM = initBM, keep = TRUE, verbose = verbose, nbCores = nbCores,     maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
  21: myMBM$optimize(estimOptions)
  22: eval(code, test_env)
  23: eval(code, test_env)
  24: withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt)
  25: doTryCatch(return(expr), name, parentenv, handler)
  26: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  27: tryCatchList(expr, classes, parentenv, handlers)
  28: tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal)
  29: doWithOneRestart(return(expr), restart)
  30: withOneRestart(expr, restarts[[1L]])
  31: withRestarts(tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal),     end_test = function() {    })
  32: test_code(code, parent.frame())
  33: test_that("initializing Multipartite SBM works", {    if (Sys.info()["sysname"] != "Windows") {        set.seed(2)        npc <- 30        Q <- 3        n <- npc * Q        Z <- diag(Q) %x% matrix(1, npc, 1)        P <- matrix(runif(Q * Q), Q, Q)        A <- 1 * (matrix(runif(n * n), n, n) < Z %*% P %*% t(Z))        B <- matrix(rpois(npc * Q * 20, 2), npc * Q, 20)        netA <- defineSBM(A, "bernoulli", type = "simple", directed = TRUE,             dimLabels = c("Actor"))        netB <- defineSBM(B, "poisson", type = "bipartite", dimLabels = c("Actor",             "Stuff"))        myMBM <- MultipartiteSBM_fit$new(list(netA, netB))        expect_true(inherits(myMBM, "SBM"))        expect_true(inherits(myMBM, "MultipartiteSBM"))        expect_true(inherits(myMBM, "MultipartiteSBM_fit"))        expect_equal(myMBM$modelName, c("bernoulli", "poisson"))        expect_true(is.character(myMBM$modelName))        expect_equal(unname(myMBM$nbNodes), c(Q * npc, 20))        expect_equal(myMBM$directed, c(TRUE, NA))        expect_equal(myMBM$nbNetworks, 2)        expect_equal(unname(myMBM$networkData[[1]]$nbNodes),             Q * npc)        expect_equal(unname(myMBM$networkData[[2]]$nbNodes),             c(Q * npc, 20))        expect_equal(unname(myMBM$architecture), matrix(c(1,             1, 1, 2), 2, 2))        if (packageVersion("purrr") >= "1.0.0") {            expect_equal(myMBM$blockProp, list(numeric(0), list(numeric(0),                 numeric(0))))        }        expect_equal(myMBM$connectParam, list(list(mean = matrix(0,             0, 0)), list(mean = matrix(0, 0, 0))))        expect_equal(coef(myMBM, "connectivity"), myMBM$connectParam)        expect_equal(coef(myMBM, "block"), myMBM$blockProp)        estimOptions = list(initBM = FALSE, verbosity = 0, nbCores = 2)        myMBM$optimize(estimOptions)        expect_equal(length(myMBM$networkData[[1]]$memberships),             npc * Q)        expect_equal(is.list(myMBM$networkData[[2]]$memberships),             TRUE)        expect_equal(length(myMBM$networkData[[1]]$blockProp),             length(unique(myMBM$networkData[[1]]$memberships)))        expect_equal(myMBM$networkData[[1]]$blockProp, myMBM$networkData[[2]]$blockProp[[1]])        expect_equal(length(myMBM$networkData[[1]]$blockProp),             nrow(myMBM$networkData[[1]]$connectParam$mean))        expect_equal(ncol(myMBM$networkData[[1]]$connectParam$mean),             nrow(myMBM$networkData[[1]]$connectParam$mean))        muAS <- myMBM$networkData[[2]]$connectParam$mean        expect_equal(ifelse(is.matrix(muAS), nrow(muAS), length(muAS)),             nrow(myMBM$networkData[[1]]$connectParam$mean))        expect_equal(lengths(myMBM$blockProp), myMBM$nbBlocks)        expect_equal(length(myMBM$blockProp), length(myMBM$dimLabels))        expect_equal(length(myMBM$connectParam), myMBM$nbNetworks)        expect_equal(lengths(myMBM$memberships), myMBM$nbNodes)        expect_lt(myMBM$loglik, 0)        expect_lt(myMBM$ICL, 0)        expect_lt(myMBM$ICL, myMBM$loglik)        expect_silent(plot(myMBM, type = "data"))        expect_silent(plot(myMBM, type = "meso"))        expect_silent(plot(myMBM, type = "expected"))        expect_equal(coef(myMBM, "connectivity"), myMBM$connectParam)        expect_equal(coef(myMBM, "block"), myMBM$blockProp)        expect_lt(rmse(myMBM$connectParam[[1]]$mean, netA$connectParam$mean),             0.01)        expect_lt(rmse(myMBM$connectParam[[2]]$mean, netB$connectParam$mean),             0.01)        expect_lt(1 - aricode::ARI(myMBM$memberships$Actor, netA$memberships),             0.05)    }})
  34: eval(code, test_env)
  35: eval(code, test_env)
  36: withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt)
  37: doTryCatch(return(expr), name, parentenv, handler)
  38: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  39: tryCatchList(expr, classes, parentenv, handlers)
  40: tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal)
  41: doWithOneRestart(return(expr), restart)
  42: withOneRestart(expr, restarts[[1L]])
  43: withRestarts(tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal),     end_test = function() {    })
  44: test_code(code = exprs, env = env, reporter = get_reporter() %||%     StopReporter$new())
  45: source_file(path, env = env(env), desc = desc, shuffle = shuffle,     error_call = error_call)
  46: FUN(X[[i]], ...)
  47: lapply(test_paths, test_one_file, env = env, desc = desc, shuffle = shuffle,     error_call = error_call)
  48: doTryCatch(return(expr), name, parentenv, handler)
  49: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  50: tryCatchList(expr, classes, parentenv, handlers)
  51: tryCatch(code, testthat_abort_reporter = function(cnd) {    cat(conditionMessage(cnd), "\n")    NULL
  Traceback:
   1: FUN(X[[i]], ...)
   2: lapply(X = X, FUN = FUN, ...)
   3: sapply(1:cardE, function(e) {    gr = matE[e, 1]    gc = matE[e, 2]    don = list_Mat[[e]]    maskNA = list_MaskNA[[e]]    if (v_distrib[e] == "bernoulli") {        Unmdon = (1 - don) * maskNA    }    if (v_distrib[e] %in% c("laplace", "poisson", "gaussian", })
  52: with_reporter(reporters$multi, lapply(test_paths, test_one_file,     env = env, desc = desc, shuffle = shuffle, error_call = error_call))
  53: test_files_serial(test_dir = test_dir, test_package = test_package,     test_paths = test_paths, load_helpers = load_helpers, reporter = reporter,     env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     desc = desc, load_package = load_package, shuffle = shuffle,     error_call = error_call)
  54: test_files(test_dir = path, test_paths = test_paths, test_package = package,     reporter = reporter, load_helpers = load_helpers, env = env,         "ZIgaussian")) {        Unit <- maskNA    }    if (v_distrib[e] == "ZIgaussian") {        NonZerosdon <- (don != 0)        Zerosdon <- (don == 0) * maskNA    }    facteur = 1    if (gc < 1) {        if (gc == 0)             facteur = 1/2        gc = gr    }    stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     load_package = load_package, parallel = parallel, shuffle = shuffle)
  55: test_dir("testthat", package = package, reporter = reporter,     ..., load_package = "installed")
  56: test_check("sbm")
  An irrecoverable exception occurred. R is aborting now ...
      if (v_distrib[e] == "bernoulli") {        prov = (tau[[gr]]) %*% log(list_theta[[e]]) %*% t(tau[[gc]])        prov1m = (tau[[gr]]) %*% log(1 - list_theta[[e]]) %*%             t(tau[[gc]])        return((sum(don * prov) + sum((Unmdon) * prov1m)) * facteur)    }    if (v_distrib[e] == "poisson") {        prov = (tau[[gr]]) %*% log(list_theta[[e]]) %*% t(tau[[gc]])        prov2 = (tau[[gr]]) %*% list_theta[[e]] %*% t(tau[[gc]])        return((sum(don * prov) - sum(Unit * prov2)) * facteur)    }    if (v_distrib[e] == "laplace") {        prov = (tau[[gr]]) %*% log(2 * list_theta[[e]]) %*% t(tau[[gc]])        prov2 = (tau[[gr]]) %*% (1/list_theta[[e]]) %*% t(tau[[gc]])        return((-sum(Unit * prov) - sum(don * prov2)) * facteur)    }    if (v_distrib[e] == "gaussian") {        prov = 0.5 * (tau[[gr]]) %*% (log(2 * pi * list_theta[[e]]$var) +             list_theta[[e]]$mean^2/list_theta[[e]]$var) %*% t(tau[[gc]])        prov2 = 0.5 * (tau[[gr]]) %*% (1/list_theta[[e]]$var) %*%             t(tau[[gc]])        prov3 = (tau[[gr]]) %*% (list_theta[[e]]$mean/list_theta[[e]]$var) %*%             t(tau[[gc]])        return((-sum(Unit * prov) - sum(don^2 * prov2) + sum(don *             prov3)) * facteur)    }    if (v_distrib[e] == "ZIgaussian") {        prov = 0.5 * (tau[[gr]]) %*% (log(2 * pi * list_theta[[e]]$var) +             list_theta[[e]]$mean^2/list_theta[[e]]$var) %*% t(tau[[gc]])        prov2 = 0.5 * (tau[[gr]]) %*% (1/list_theta[[e]]$var) %*%             t(tau[[gc]])        prov3 = (tau[[gr]]) %*% (list_theta[[e]]$mean/list_theta[[e]]$var) %*%             t(tau[[gc]])        P1 <- sum((-Unit * prov - don^2 * prov2 + don * prov3) *             (1 - Zerosdon))        prov4 = (tau[[gr]]) %*% log(list_theta[[e]]$p0 + (list_theta[[e]]$p0 ==             0)) %*% t(tau[[gc]])        prov4m = (tau[[gr]]) %*% log(1 - list_theta[[e]]$p0 +             (list_theta[[e]]$p0 == 1)) %*% t(tau[[gc]])        P2 <- sum(Zerosdon * prov4) + sum((1 - Zerosdon) * prov4m)        return((P1 + P2) * facteur)    }})
   4: compLikICLInt(tau, list_theta, list_pi, matE, list_Mat, list_MaskNA,     n_q, v_K, v_distrib)
   5: varEMMBM(self, classif, tau = tau, maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
   6: dataR6$estime(list_classif_init[[l]], maxiterVE = maxiterVE,     maxiterVEM = maxiterVEM)
   7: FUN(X[[i]], ...)
   8: lapply(X = S, FUN = FUN, ...)
   9: doTryCatch(return(expr), name, parentenv, handler)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: tryCatchList(expr, classes, parentenv, handlers)
  12: tryCatch(expr, error = function(e) {    call <- conditionCall(e)    if (!is.null(call)) {        if (identical(call[[1L]], quote(doTryCatch)))             call <- sys.call(-4L)        dcall <- deparse(call, nlines = 1L)        prefix <- paste("Error in", dcall, ": ")        LONG <- 75L        sm <- strsplit(conditionMessage(e), "\n")[[1L]]        w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")        if (is.na(w))             w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L],                 type = "b")        if (w > LONG)             prefix <- paste0(prefix, "\n  ")    }    else prefix <- "Error : "    msg <- paste0(prefix, conditionMessage(e), "\n")    .Internal(seterrmessage(msg[1L]))    if (!silent && isTRUE(getOption("show.error.messages"))) {        cat(msg, file = outFile)        .Internal(printDeferredWarnings())    }    invisible(structure(msg, class = "try-error", condition = e))})
  13: try(lapply(X = S, FUN = FUN, ...), silent = TRUE)
  14: sendMaster(try(lapply(X = S, FUN = FUN, ...), silent = TRUE))
  15: FUN(X[[i]], ...)
  16: lapply(seq_len(cores), inner.do)
  17: mclapply(1:L, function(l) {    estim.c.l <- dataR6$estime(list_classif_init[[l]], maxiterVE = maxiterVE,         maxiterVEM = maxiterVEM)}, mc.cores = nbCores)
  18: searchKQ(dataR6 = self, classifInit = classifInit, pastICL = pastICL,     Kmin = Kmin, Kmax = Kmax, nbCores = nbCores, verbose = verbose,     maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
  19: dataR6$searchNbClusters(classifInit, Kmin = v_Kmin, Kmax = v_Kmax,     pastICL = c(), verbose = verbose, nbCores = nbCores, maxiterVE = maxiterVE,     maxiterVEM = maxiterVEM)
  20: GREMLINS::multipartiteBM(list_Net = listNetG, v_distrib = vdistrib,     namesFG = namesFG, v_Kmin = v_Kmin, v_Kmax = v_Kmax, v_Kinit = NULL,     initBM = initBM, keep = TRUE, verbose = verbose, nbCores = nbCores,     maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
  21: myMBM$optimize(estimOptions)
  22: eval(code, test_env)
  23: eval(code, test_env)
  24: withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt)
  25: doTryCatch(return(expr), name, parentenv, handler)
  26: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  27: tryCatchList(expr, classes, parentenv, handlers)
  28: tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal)
  29: doWithOneRestart(return(expr), restart)
  30: withOneRestart(expr, restarts[[1L]])
  31: withRestarts(tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal),     end_test = function() {    })
  32: test_code(code, parent.frame())
  33: test_that("initializing Multipartite SBM works", {    if (Sys.info()["sysname"] != "Windows") {        set.seed(2)        npc <- 30        Q <- 3        n <- npc * Q        Z <- diag(Q) %x% matrix(1, npc, 1)        P <- matrix(runif(Q * Q), Q, Q)        A <- 1 * (matrix(runif(n * n), n, n) < Z %*% P %*% t(Z))        B <- matrix(rpois(npc * Q * 20, 2), npc * Q, 20)        netA <- defineSBM(A, "bernoulli", type = "simple", directed = TRUE,             dimLabels = c("Actor"))        netB <- defineSBM(B, "poisson", type = "bipartite", dimLabels = c("Actor",             "Stuff"))        myMBM <- MultipartiteSBM_fit$new(list(netA, netB))        expect_true(inherits(myMBM, "SBM"))        expect_true(inherits(myMBM, "MultipartiteSBM"))        expect_true(inherits(myMBM, "MultipartiteSBM_fit"))        expect_equal(myMBM$modelName, c("bernoulli", "poisson"))        expect_true(is.character(myMBM$modelName))        expect_equal(unname(myMBM$nbNodes), c(Q * npc, 20))        expect_equal(myMBM$directed, c(TRUE, NA))        expect_equal(myMBM$nbNetworks, 2)        expect_equal(unname(myMBM$networkData[[1]]$nbNodes),             Q * npc)        expect_equal(unname(myMBM$networkData[[2]]$nbNodes),             c(Q * npc, 20))        expect_equal(unname(myMBM$architecture), matrix(c(1,             1, 1, 2), 2, 2))        if (packageVersion("purrr") >= "1.0.0") {            expect_equal(myMBM$blockProp, list(numeric(0), list(numeric(0),                 numeric(0))))        }        expect_equal(myMBM$connectParam, list(list(mean = matrix(0,             0, 0)), list(mean = matrix(0, 0, 0))))        expect_equal(coef(myMBM, "connectivity"), myMBM$connectParam)        expect_equal(coef(myMBM, "block"), myMBM$blockProp)        estimOptions = list(initBM = FALSE, verbosity = 0, nbCores = 2)        myMBM$optimize(estimOptions)        expect_equal(length(myMBM$networkData[[1]]$memberships),             npc * Q)        expect_equal(is.list(myMBM$networkData[[2]]$memberships),             TRUE)        expect_equal(length(myMBM$networkData[[1]]$blockProp),             length(unique(myMBM$networkData[[1]]$memberships)))        expect_equal(myMBM$networkData[[1]]$blockProp, myMBM$networkData[[2]]$blockProp[[1]])        expect_equal(length(myMBM$networkData[[1]]$blockProp),             nrow(myMBM$networkData[[1]]$connectParam$mean))        expect_equal(ncol(myMBM$networkData[[1]]$connectParam$mean),             nrow(myMBM$networkData[[1]]$connectParam$mean))        muAS <- myMBM$networkData[[2]]$connectParam$mean        expect_equal(ifelse(is.matrix(muAS), nrow(muAS), length(muAS)),             nrow(myMBM$networkData[[1]]$connectParam$mean))        expect_equal(lengths(myMBM$blockProp), myMBM$nbBlocks)        expect_equal(length(myMBM$blockProp), length(myMBM$dimLabels))        expect_equal(length(myMBM$connectParam), myMBM$nbNetworks)        expect_equal(lengths(myMBM$memberships), myMBM$nbNodes)        expect_lt(myMBM$loglik, 0)        expect_lt(myMBM$ICL, 0)        expect_lt(myMBM$ICL, myMBM$loglik)        expect_silent(plot(myMBM, type = "data"))        expect_silent(plot(myMBM, type = "meso"))        expect_silent(plot(myMBM, type = "expected"))        expect_equal(coef(myMBM, "connectivity"), myMBM$connectParam)        expect_equal(coef(myMBM, "block"), myMBM$blockProp)        expect_lt(rmse(myMBM$connectParam[[1]]$mean, netA$connectParam$mean),             0.01)        expect_lt(rmse(myMBM$connectParam[[2]]$mean, netB$connectParam$mean),             0.01)        expect_lt(1 - aricode::ARI(myMBM$memberships$Actor, netA$memberships),             0.05)    }})
  34: eval(code, test_env)
  35: eval(code, test_env)
  36: withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt)
  37: doTryCatch(return(expr), name, parentenv, handler)
  38: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  39: tryCatchList(expr, classes, parentenv, handlers)
  40: tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal)
  41: doWithOneRestart(return(expr), restart)
  42: withOneRestart(expr, restarts[[1L]])
  43: withRestarts(tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal),     end_test = function() {    })
  44: test_code(code = exprs, env = env, reporter = get_reporter() %||%     StopReporter$new())
  45: source_file(path, env = env(env), desc = desc, shuffle = shuffle,     error_call = error_call)
  46: FUN(X[[i]], ...)
  47: lapply(test_paths, test_one_file, env = env, desc = desc, shuffle = shuffle,     error_call = error_call)
  48: doTryCatch(return(expr), name, parentenv, handler)
  49: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  50: tryCatchList(expr, classes, parentenv, handlers)
  51: tryCatch(code, testthat_abort_reporter = function(cnd) {    cat(conditionMessage(cnd), "\n")    NULL})
  52: with_reporter(reporters$multi, lapply(test_paths, test_one_file,     env = env, desc = desc, shuffle = shuffle, error_call = error_call))
  53: test_files_serial(test_dir = test_dir, test_package = test_package,     test_paths = test_paths, load_helpers = load_helpers, reporter = reporter,     env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     desc = desc, load_package = load_package, shuffle = shuffle,     error_call = error_call)
  54: test_files(test_dir = path, test_paths = test_paths, test_package = package,     reporter = reporter, load_helpers = load_helpers, env = env,     stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     load_package = load_package, parallel = parallel, shuffle = shuffle)
  55: test_dir("testthat", package = package, reporter = reporter,     ..., load_package = "installed")
  56: test_check("sbm")
  An irrecoverable exception occurred. R is aborting now ...
  Saving _problems/test-MultipartiteSBM-47.R
  [1] "------------Nb of entities in each functional group--------------"
  Actor 
     90 
  [1] "------------Probability distributions on each network--------------"
  [1] "bernoulli" "bernoulli" "poisson"  
  [1] "-------------------------------------------------------------------"
  [1] " ------ Searching the numbers of blocks starting from [ 1 ] blocks"
  [1] "ICL : -18262.1 . Nb of blocks: [ 1 ]"
  [1] "ICL : -14768.26 . Nb of blocks: [ 2 ]"
  
   *** caught segfault ***
  address 0x110, cause 'invalid permissions'
  
  Traceback:
   1: FUN(X[[i]], ...)
   2: lapply(X = X, FUN = FUN, ...)
   3: sapply(1:cardE, function(e) {    gr = matE[e, 1]    gc = matE[e, 2]    don = list_Mat[[e]]    maskNA = list_MaskNA[[e]]    if (v_distrib[e] == "bernoulli") {        Unmdon = (1 - don) * maskNA    }    if (v_distrib[e] %in% c("laplace", "poisson", "gaussian",         "ZIgaussian")) {        Unit <- maskNA    }    if (v_distrib[e] == "ZIgaussian") {        NonZerosdon <- (don != 0)        Zerosdon <- (don == 0) * maskNA    }    facteur = 1    if (gc < 1) {        if (gc == 0)             facteur = 1/2        gc = gr    }    if (v_distrib[e] == "bernoulli") {        prov = (tau[[gr]]) %*% log(list_theta[[e]]) %*% t(tau[[gc]])        prov1m = (tau[[gr]]) %*% log(1 - list_theta[[e]]) %*%             t(tau[[gc]])        return((sum(don * prov) + sum((Unmdon) * prov1m)) * facteur)    }    if (v_distrib[e] == "poisson") {        prov = (tau[[gr]]) %*% log(list_theta[[e]]) %*% t(tau[[gc]])        prov2 = (tau[[gr]]) %*% list_theta[[e]] %*% t(tau[[gc]])        return((sum(don * prov) - sum(Unit * prov2)) * facteur)    }    if (v_distrib[e] == "laplace") {        prov = (tau[[gr]]) %*% log(2 * list_theta[[e]]) %*% t(tau[[gc]])        prov2 = (tau[[gr]]) %*% (1/list_theta[[e]]) %*% t(tau[[gc]])        return((-sum(Unit * prov) - sum(don * prov2)) * facteur)    }    if (v_distrib[e] == "gaussian") {        prov = 0.5 * (tau[[gr]]) %*% (log(2 * pi * list_theta[[e]]$var) +             list_theta[[e]]$mean^2/list_theta[[e]]$var) %*% t(tau[[gc]])        prov2 = 0.5 * (tau[[gr]]) %*% (1/list_theta[[e]]$var) %*%             t(tau[[gc]])        prov3 = (tau[[gr]]) %*% (list_theta[[e]]$mean/list_theta[[e]]$var) %*%             t(tau[[gc]])        return((-sum(Unit * prov) - sum(don^2 * prov2) + sum(don *             prov3)) * facteur)    }    if (v_distrib[e] == "ZIgaussian") {        prov = 0.5 * (tau[[gr]]) %*% (log(2 * pi * list_theta[[e]]$var) +             list_theta[[e]]$mean^2/list_theta[[e]]$var) %*% t(tau[[gc]])        prov2 = 0.5 * (tau[[gr]]) %*% (1/list_theta[[e]]$var) %*%             t(tau[[gc]])        prov3 = (tau[[gr]]) %*% (list_theta[[e]]$mean/list_theta[[e]]$var) %*%             t(tau[[gc]])        P1 <- sum((-Unit * prov - don^2 * prov2 + don * prov3) *             (1 - Zerosdon))        prov4 = (tau[[gr]]) %*% log(list_theta[[e]]$p0 + (list_theta[[e]]$p0 ==             0)) %*% t(tau[[gc]])        prov4m = (tau[[gr]]) %*% log(1 - list_theta[[e]]$p0 +             (list_theta[[e]]$p0 == 1)) %*% t(tau[[gc]])        P2 <- sum(Zerosdon * prov4) + sum((1 - Zerosdon) * prov4m)        return((P1 + P2) * facteur)    }})
   4: compLikICLInt(tau, list_theta, list_pi, matE, list_Mat, list_MaskNA,     n_q, v_K, v_distrib)
   5: varEMMBM(self, classif, tau = tau, maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
   6: dataR6$estime(list_classif_init[[l]], maxiterVE = maxiterVE,     maxiterVEM = maxiterVEM)
   7: FUN(X[[i]], ...)
   8: lapply(X = S, FUN = FUN, ...)
   9: doTryCatch(return(expr), name, parentenv, handler)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: tryCatchList(expr, classes, parentenv, handlers)
  12: tryCatch(expr, error = function(e) {    call <- conditionCall(e)    if (!is.null(call)) {        if (identical(call[[1L]], quote(doTryCatch)))             call <- sys.call(-4L)        dcall <- deparse(call, nlines = 1L)        prefix <- paste("Error in", dcall, ": ")        LONG <- 75L        sm <- strsplit(conditionMessage(e), "\n")[[1L]]        w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")        if (is.na(w))             w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L],                 type = "b")        if (w > LONG)             prefix <- paste0(prefix, "\n  ")    }    else prefix <- "Error : "    msg <- paste0(prefix, conditionMessage(e), "\n")    .Internal(seterrmessage(msg[1L]))    if (!silent && isTRUE(getOption("show.error.messages"))) {        cat(msg, file = outFile)        .Internal(printDeferredWarnings())    }    invisible(structure(msg, class = "try-error", condition = e))})
  13: try(lapply(X = S, FUN = FUN, ...), silent = TRUE)
  14: sendMaster(try(lapply(X = S, FUN = FUN, ...), silent = TRUE))
  15: FUN(X[[i]], ...)
  16: lapply(seq_len(cores), inner.do)
  17: mclapply(X, FUN, ..., mc.cores = mc.cores, mc.preschedule = mc.preschedule,     mc.set.seed = mc.set.seed, mc.cleanup = mc.cleanup, mc.allow.recursive = mc.allow.recursive)
  18: pbmcapply::pbmclapply(1:L, function(l) {    estim.c.l <- dataR6$estime(list_classif_init[[l]], maxiterVE = maxiterVE,         maxiterVEM = maxiterVEM)}, mc.cores = nbCores)
  19: searchKQ(dataR6 = self, classifInit = classifInit, pastICL = pastICL,     Kmin = Kmin, Kmax = Kmax, nbCores = nbCores, verbose = verbose,     maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
  20: dataR6$searchNbClusters(classifInit, Kmin = v_Kmin, Kmax = v_Kmax,     pastICL = c(), verbose = verbose, nbCores = nbCores, maxiterVE = maxiterVE,     maxiterVEM = maxiterVEM)
  21: GREMLINS::multipartiteBM(list_Net = listNetG, v_distrib = vdistrib,     namesFG = namesFG, v_Kmin = v_Kmin, v_Kmax = v_Kmax, v_Kinit = NULL,     initBM = initBM, keep = TRUE, verbose = verbose, nbCores = nbCores,     maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
  22: super$optimize(estimOptions)
  23: myMultiplexFitindep$optimize(estimOptions = currentOptions)
  24: eval(code, test_env)
  25: eval(code, test_env)
  26: withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt)
  27: doTryCatch(return(expr), name, parentenv, handler)
  28: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  29: tryCatchList(expr, classes, parentenv, handlers)
  30: tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal)
  31: doWithOneRestart(return(expr), restart)
  32: withOneRestart(expr, restarts[[1L]])
  33: withRestarts(tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal),     end_test = function() {    })
  34: test_code(code, parent.frame())
  35: test_that("Inference for Multiplex networks", {    if (Sys.info()["sysname"] != "Windows") {        set.seed(2)        npc <- 30        Q <- 3        n <- npc * Q        Z <- diag(Q) %x% matrix(1, npc, 1)        P <- matrix(runif(Q * Q), Q, Q)        A <- 1 * (matrix(runif(n * n), n, n) < Z %*% P %*% t(Z))        type <- "simple"        netA <- defineSBM(A, "bernoulli", type = "simple", directed = TRUE,             dimLabels = c("Actor"))        B <- 1 * (matrix(runif(n * n), n, n) < Z %*% P %*% t(Z))        netB <- defineSBM(B, "bernoulli", type = "simple", dimLabels = c("Actor"))        myMultiplex <- MultiplexSBM_fit$new(list(netA, netB))        netC <- defineSBM(B, "poisson", type = "simple", dimLabels = c("Actor"))        expect_equal(myMultiplex$directed, c(TRUE, TRUE))        expect_equal(myMultiplex$nbNetworks, 2)        expect_equal(myMultiplex$dependentNetwork, FALSE)        expect_equal(MultiplexSBM_fit$new(list(netA, netB), TRUE)$dependentNetwork,             TRUE)        expect_error(MultiplexSBM_fit$new(list(netA, netC), TRUE))        expect_error(MultiplexSBM_fit$new(list(netA, netB, netB),             TRUE))        currentOptions <- list(verbosity = 1, nbBlocksRange = list(c(1,             10)), nbCores = 2, maxiterVE = 100, maxiterVEM = 100,             initBM = TRUE)        myMultiplexFitindep <- MultiplexSBM_fit$new(list(netA,             netB, netC))        myMultiplexFitindep$optimize(estimOptions = currentOptions)        expect_equal(length(myMultiplexFitindep$connectParam),             3)        myMultiplexFitdep <- MultiplexSBM_fit$new(list(netA,             netB), dependentNet = TRUE)        currentOptions <- list(verbosity = 3, plot = TRUE, explorFactor = 1.5,             nbBlocksRange = c(4, Inf), nbCores = 2, fast = TRUE)        myMultiplexFitdep$optimize(estimOptions = currentOptions)        myMultiplexFitdep$probMemberships        expect_equal(class(myMultiplexFitdep$memberships), "list")        expect_equal(length(myMultiplexFitdep$connectParam),             4)        expect_equal(myMultiplexFitdep$dependentNetwork, TRUE)        set.seed(2)        npc1 <- 30        npc2 <- 20        Q1 <- 2        Q2 <- 3        n1 <- npc1 * Q1        n2 <- npc2 * Q2        Z1 <- diag(Q1) %x% matrix(1, npc1, 1)        Z2 <- diag(Q2) %x% matrix(1, npc2, 1)        P <- matrix(runif(Q1 * Q2), Q1, Q2)        A <- 1 * (matrix(runif(n1 * n2), n1, n2) < Z1 %*% P %*%             t(Z2))        netA <- defineSBM(A, "bernoulli", type = "bipartite",             directed = TRUE, dimLabels = c("Actor", "Object"))        B <- 1 * (matrix(runif(n1 * n2), n1, n2) < Z1 %*% P %*%             t(Z2))        netB <- defineSBM(B, "bernoulli", type = "bipartite",             dimLabels = c("Actor", "Object"))        myMultiplexFitindep <- MultiplexSBM_fit$new(list(netA,             netB))        currentOptions <- list(verbosity = 1, nbBlocksRange = list(c(1,             10), c(1, 10)), nbCores = 2, maxiterVE = 100, maxiterVEM = 100,             initBM = FALSE)        names(currentOptions$nbBlocksRange) = c("Actor", "Object")        myMultiplexFitindep$optimize(currentOptions)        expect_equal(length(myMultiplexFitindep$connectParam),             2)    }})
  36: eval(code, test_env)
  37: eval(code, test_env)
  38: withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt)
  39: doTryCatch(return(expr), name, parentenv, handler)
  40: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  41: tryCatchList(expr, classes, parentenv, handlers)
  42: tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal)
  43: doWithOneRestart(return(expr), restart)
  44: withOneRestart(expr, restarts[[1L]])
  45: withRestarts(tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal),     end_test = function() {    })
  46: test_code(code = exprs, env = env, reporter = get_reporter() %||%     StopReporter$new())
  47: source_file(path, env = env(env), desc = desc, shuffle = shuffle,     error_call = error_call)
  48: FUN(X[[i]], ...)
  49: lapply(test_paths, test_one_file, env = env, desc = desc, shuffle = shuffle,     error_call = error_call)
  50: doTryCatch(return(expr), name, parentenv, handler)
  51: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  52: tryCatchList(expr, classes, parentenv, handlers)
  53: tryCatch(code, testthat_abort_reporter = function(cnd) {    cat(conditionMessage(cnd), "\n")    NULL})
  54: with_reporter(reporters$multi, lapply(test_paths, test_one_file,     env = env, desc = desc, shuffle = shuffle, error_call = error_call))
  55: test_files_serial(test_dir = test_dir, test_package = test_package,     test_paths = test_paths, load_helpers = load_helpers, reporter = reporter,     env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     desc = desc, load_package = load_package, shuffle = shuffle,     error_call = error_call)
  56: test_files(test_dir = path, test_paths = test_paths, test_package = package,     reporter = reporter, load_helpers = load_helpers, env = env,     stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     load_package = load_package, parallel = parallel, shuffle = shuffle)
  57: test_dir("testthat", package = package, reporter = reporter,     ..., load_package = "installed")
  58: test_check("sbm")
  An irrecoverable exception occurred. R is aborting now ...
  
   *** caught segfault ***
  address 0x110, cause 'invalid permissions'
  
  Traceback:
   1: FUN(X[[i]], ...)
   2: lapply(X = X, FUN = FUN, ...)
   3: sapply(1:cardE, function(e) {    gr = matE[e, 1]    gc = matE[e, 2]    don = list_Mat[[e]]    maskNA = list_MaskNA[[e]]    if (v_distrib[e] == "bernoulli") {        Unmdon = (1 - don) * maskNA    }    if (v_distrib[e] %in% c("laplace", "poisson", "gaussian",         "ZIgaussian")) {        Unit <- maskNA    }    if (v_distrib[e] == "ZIgaussian") {        NonZerosdon <- (don != 0)        Zerosdon <- (don == 0) * maskNA    }    facteur = 1    if (gc < 1) {        if (gc == 0)             facteur = 1/2        gc = gr    }    if (v_distrib[e] == "bernoulli") {        prov = (tau[[gr]]) %*% log(list_theta[[e]]) %*% t(tau[[gc]])        prov1m = (tau[[gr]]) %*% log(1 - list_theta[[e]]) %*%             t(tau[[gc]])        return((sum(don * prov) + sum((Unmdon) * prov1m)) * facteur)    }    if (v_distrib[e] == "poisson") {        prov = (tau[[gr]]) %*% log(list_theta[[e]]) %*% t(tau[[gc]])        prov2 = (tau[[gr]]) %*% list_theta[[e]] %*% t(tau[[gc]])        return((sum(don * prov) - sum(Unit * prov2)) * facteur)    }    if (v_distrib[e] == "laplace") {        prov = (tau[[gr]]) %*% log(2 * list_theta[[e]]) %*% t(tau[[gc]])        prov2 = (tau[[gr]]) %*% (1/list_theta[[e]]) %*% t(tau[[gc]])        return((-sum(Unit * prov) - sum(don * prov2)) * facteur)    }    if (v_distrib[e] == "gaussian") {        prov = 0.5 * (tau[[gr]]) %*% (log(2 * pi * list_theta[[e]]$var) +             list_theta[[e]]$mean^2/list_theta[[e]]$var) %*% t(tau[[gc]])        prov2 = 0.5 * (tau[[gr]]) %*% (1/list_theta[[e]]$var) %*%             t(tau[[gc]])        prov3 = (tau[[gr]]) %*% (list_theta[[e]]$mean/list_theta[[e]]$var) %*%             t(tau[[gc]])        return((-sum(Unit * prov) - sum(don^2 * prov2) + sum(don *             prov3)) * facteur)    }    if (v_distrib[e] == "ZIgaussian") {        prov = 0.5 * (tau[[gr]]) %*% (log(2 * pi * list_theta[[e]]$var) +             list_theta[[e]]$mean^2/list_theta[[e]]$var) %*% t(tau[[gc]])        prov2 = 0.5 * (tau[[gr]]) %*% (1/list_theta[[e]]$var) %*%             t(tau[[gc]])        prov3 = (tau[[gr]]) %*% (list_theta[[e]]$mean/list_theta[[e]]$var) %*%             t(tau[[gc]])        P1 <- sum((-Unit * prov - don^2 * prov2 + don * prov3) *             (1 - Zerosdon))        prov4 = (tau[[gr]]) %*% log(list_theta[[e]]$p0 + (list_theta[[e]]$p0 ==             0)) %*% t(tau[[gc]])        prov4m = (tau[[gr]]) %*% log(1 - list_theta[[e]]$p0 +             (list_theta[[e]]$p0 == 1)) %*% t(tau[[gc]])        P2 <- sum(Zerosdon * prov4) + sum((1 - Zerosdon) * prov4m)        return((P1 + P2) * facteur)    }})
   4: compLikICLInt(tau, list_theta, list_pi, matE, list_Mat, list_MaskNA,     n_q, v_K, v_distrib)
   5: varEMMBM(self, classif, tau = tau, maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
   6: dataR6$estime(list_classif_init[[l]], maxiterVE = maxiterVE,     maxiterVEM = maxiterVEM)
   7: FUN(X[[i]], ...)
   8: lapply(X = S, FUN = FUN, ...)
   9: doTryCatch(return(expr), name, parentenv, handler)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: tryCatchList(expr, classes, parentenv, handlers)
  12: tryCatch(expr, error = function(e) {    call <- conditionCall(e)    if (!is.null(call)) {        if (identical(call[[1L]], quote(doTryCatch)))             call <- sys.call(-4L)        dcall <- deparse(call, nlines = 1L)        prefix <- paste("Error in", dcall, ": ")        LONG <- 75L        sm <- strsplit(conditionMessage(e), "\n")[[1L]]        w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")        if (is.na(w))             w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L],                 type = "b")        if (w > LONG)             prefix <- paste0(prefix, "\n  ")    }    else prefix <- "Error : "    msg <- paste0(prefix, conditionMessage(e), "\n")    .Internal(seterrmessage(msg[1L]))    if (!silent && isTRUE(getOption("show.error.messages"))) {        cat(msg, file = outFile)        .Internal(printDeferredWarnings())    }    invisible(structure(msg, class = "try-error", condition = e))})
  13: try(lapply(X = S, FUN = FUN, ...), silent = TRUE)
  14: sendMaster(try(lapply(X = S, FUN = FUN, ...), silent = TRUE))
  15: FUN(X[[i]], ...)
  16: lapply(seq_len(cores), inner.do)
  17: mclapply(X, FUN, ..., mc.cores = mc.cores, mc.preschedule = mc.preschedule,     mc.set.seed = mc.set.seed, mc.cleanup = mc.cleanup, mc.allow.recursive = mc.allow.recursive)
  18: pbmcapply::pbmclapply(1:L, function(l) {    estim.c.l <- dataR6$estime(list_classif_init[[l]], maxiterVE = maxiterVE,         maxiterVEM = maxiterVEM)}, mc.cores = nbCores)
  19: searchKQ(dataR6 = self, classifInit = classifInit, pastICL = pastICL,     Kmin = Kmin, Kmax = Kmax, nbCores = nbCores, verbose = verbose,     maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
  20: dataR6$searchNbClusters(classifInit, Kmin = v_Kmin, Kmax = v_Kmax,     pastICL = c(), verbose = verbose, nbCores = nbCores, maxiterVE = maxiterVE,     maxiterVEM = maxiterVEM)
  21: GREMLINS::multipartiteBM(list_Net = listNetG, v_distrib = vdistrib,     namesFG = namesFG, v_Kmin = v_Kmin, v_Kmax = v_Kmax, v_Kinit = NULL,     initBM = initBM, keep = TRUE, verbose = verbose, nbCores = nbCores,     maxiterVE = maxiterVE, maxiterVEM = maxiterVEM)
  22: super$optimize(estimOptions)
  23: myMultiplexFitindep$optimize(estimOptions = currentOptions)
  24: eval(code, test_env)
  25: eval(code, test_env)
  26: withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt)
  27: doTryCatch(return(expr), name, parentenv, handler)
  28: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  29: tryCatchList(expr, classes, parentenv, handlers)
  30: tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal)
  31: doWithOneRestart(return(expr), restart)
  32: withOneRestart(expr, restarts[[1L]])
  33: withRestarts(tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal),     end_test = function() {    })
  34: test_code(code, parent.frame())
  35: test_that("Inference for Multiplex networks", {    if (Sys.info()["sysname"] != "Windows") {        set.seed(2)        npc <- 30        Q <- 3        n <- npc * Q        Z <- diag(Q) %x% matrix(1, npc, 1)        P <- matrix(runif(Q * Q), Q, Q)        A <- 1 * (matrix(runif(n * n), n, n) < Z %*% P %*% t(Z))        type <- "simple"        netA <- defineSBM(A, "bernoulli", type = "simple", directed = TRUE,             dimLabels = c("Actor"))        B <- 1 * (matrix(runif(n * n), n, n) < Z %*% P %*% t(Z))        netB <- defineSBM(B, "bernoulli", type = "simple", dimLabels = c("Actor"))        myMultiplex <- MultiplexSBM_fit$new(list(netA, netB))        netC <- defineSBM(B, "poisson", type = "simple", dimLabels = c("Actor"))        expect_equal(myMultiplex$directed, c(TRUE, TRUE))        expect_equal(myMultiplex$nbNetworks, 2)        expect_equal(myMultiplex$dependentNetwork, FALSE)        expect_equal(MultiplexSBM_fit$new(list(netA, netB), TRUE)$dependentNetwork,             TRUE)        expect_error(MultiplexSBM_fit$new(list(netA, netC), TRUE))        expect_error(MultiplexSBM_fit$new(list(netA, netB, netB),             TRUE))        currentOptions <- list(verbosity = 1, nbBlocksRange = list(c(1,             10)), nbCores = 2, maxiterVE = 100, maxiterVEM = 100,             initBM = TRUE)        myMultiplexFitindep <- MultiplexSBM_fit$new(list(netA,             netB, netC))        myMultiplexFitindep$optimize(estimOptions = currentOptions)        expect_equal(length(myMultiplexFitindep$connectParam),             3)        myMultiplexFitdep <- MultiplexSBM_fit$new(list(netA,             netB), dependentNet = TRUE)        currentOptions <- list(verbosity = 3, plot = TRUE, explorFactor = 1.5,             nbBlocksRange = c(4, Inf), nbCores = 2, fast = TRUE)        myMultiplexFitdep$optimize(estimOptions = currentOptions)        myMultiplexFitdep$probMemberships        expect_equal(class(myMultiplexFitdep$memberships), "list")        expect_equal(length(myMultiplexFitdep$connectParam),             4)        expect_equal(myMultiplexFitdep$dependentNetwork, TRUE)        set.seed(2)        npc1 <- 30        npc2 <- 20        Q1 <- 2        Q2 <- 3        n1 <- npc1 * Q1        n2 <- npc2 * Q2        Z1 <- diag(Q1) %x% matrix(1, npc1, 1)        Z2 <- diag(Q2) %x% matrix(1, npc2, 1)        P <- matrix(runif(Q1 * Q2), Q1, Q2)        A <- 1 * (matrix(runif(n1 * n2), n1, n2) < Z1 %*% P %*%             t(Z2))        netA <- defineSBM(A, "bernoulli", type = "bipartite",             directed = TRUE, dimLabels = c("Actor", "Object"))        B <- 1 * (matrix(runif(n1 * n2), n1, n2) < Z1 %*% P %*%             t(Z2))        netB <- defineSBM(B, "bernoulli", type = "bipartite",             dimLabels = c("Actor", "Object"))        myMultiplexFitindep <- MultiplexSBM_fit$new(list(netA,             netB))        currentOptions <- list(verbosity = 1, nbBlocksRange = list(c(1,             10), c(1, 10)), nbCores = 2, maxiterVE = 100, maxiterVEM = 100,             initBM = FALSE)        names(currentOptions$nbBlocksRange) = c("Actor", "Object")        myMultiplexFitindep$optimize(currentOptions)        expect_equal(length(myMultiplexFitindep$connectParam),             2)    }})
  36: eval(code, test_env)
  37: eval(code, test_env)
  38: withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt)
  39: doTryCatch(return(expr), name, parentenv, handler)
  40: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  41: tryCatchList(expr, classes, parentenv, handlers)
  42: tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal)
  43: doWithOneRestart(return(expr), restart)
  44: withOneRestart(expr, restarts[[1L]])
  45: withRestarts(tryCatch(withCallingHandlers({    eval(code, test_env)    new_expectations <- the$test_expectations > starting_expectations    if (snapshot_skipped) {        skip("On CRAN")    }    else if (!new_expectations && skip_on_empty) {        skip_empty()    }}, expectation = handle_expectation, packageNotFoundError = function(e) {    if (on_cran()) {        skip(paste0("{", e$package, "} is not installed."))    }}, snapshot_on_cran = function(cnd) {    snapshot_skipped <<- TRUE    invokeRestart("muffle_cran_snapshot")}, skip = handle_skip, warning = handle_warning, message = handle_message,     error = handle_error, interrupt = handle_interrupt), error = handle_fatal),     end_test = function() {    })
  46: test_code(code = exprs, env = env, reporter = get_reporter() %||%     StopReporter$new())
  47: source_file(path, env = env(env), desc = desc, shuffle = shuffle,     error_call = error_call)
  48: FUN(X[[i]], ...)
  49: lapply(test_paths, test_one_file, env = env, desc = desc, shuffle = shuffle,     error_call = error_call)
  50: doTryCatch(return(expr), name, parentenv, handler)
  51: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  52: tryCatchList(expr, classes, parentenv, handlers)
  53: tryCatch(code, testthat_abort_reporter = function(cnd) {    cat(conditionMessage(cnd), "\n")    NULL})
  54: with_reporter(reporters$multi, lapply(test_paths, test_one_file,     env = env, desc = desc, shuffle = shuffle, error_call = error_call))
  55: test_files_serial(test_dir = test_dir, test_package = test_package,     test_paths = test_paths, load_helpers = load_helpers, reporter = reporter,     env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     desc = desc, load_package = load_package, shuffle = shuffle,     error_call = error_call)
  56: test_files(test_dir = path, test_paths = test_paths, test_package = package,     reporter = reporter, load_helpers = load_helpers, env = env,     stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     load_package = load_package, parallel = parallel, shuffle = shuffle)
  57: test_dir("testthat", package = package, reporter = reporter,     ..., load_package = "installed")
  58: test_check("sbm")
  An irrecoverable exception occurred. R is aborting now ...
  Saving _problems/test-MultiplexSBM_fit-36.R
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  [1] "use of sampleMultipartite"
  [1] "use of sampleMultipartite"
  [ FAIL 2 | WARN 2 | SKIP 0 | PASS 1026 ]
  
  ══ Failed tests ════════════════════════════════════════════════════════════════
  ── Error ('test-MultipartiteSBM.R:47:5'): initializing Multipartite SBM works ──
  Error in `which(sapply(R, function(u) {     u$convergence }))`: argument to 'which' is not logical
  Backtrace:
      ▆
   1. └─myMBM$optimize(estimOptions) at test-MultipartiteSBM.R:47:5
   2.   └─GREMLINS::multipartiteBM(...)
   3.     └─dataR6$searchNbClusters(...)
   4.       └─GREMLINS:::searchKQ(...)
   5.         └─dataR6$cleanResults(allEstim)
   6.           └─GREMLINS:::cleanEstim(self, R)
   7.             └─base::which(...)
  ── Error ('test-MultiplexSBM_fit.R:36:5'): Inference for Multiplex networks ────
  Error in `which(sapply(R, function(u) {     u$convergence }))`: argument to 'which' is not logical
  Backtrace:
      ▆
   1. └─myMultiplexFitindep$optimize(estimOptions = currentOptions) at test-MultiplexSBM_fit.R:36:5
   2.   └─super$optimize(estimOptions)
   3.     └─GREMLINS::multipartiteBM(...)
   4.       └─dataR6$searchNbClusters(...)
   5.         └─GREMLINS:::searchKQ(...)
   6.           └─dataR6$cleanResults(allEstim)
   7.             └─GREMLINS:::cleanEstim(self, R)
   8.               └─base::which(...)
  
  [ FAIL 2 | WARN 2 | SKIP 0 | PASS 1026 ]
  Error:
  ! Test failures.
  Execution halted