CRAN Package Check Results for Package netchain

Last updated on 2020-01-27 07:55:05 CET.

Flavor Version Tinstall Tcheck Ttotal Status Flags
r-devel-linux-x86_64-debian-clang 0.1.0 20.27 38.23 58.50 ERROR
r-devel-linux-x86_64-debian-gcc 0.1.0 12.74 76.00 88.74 OK
r-devel-linux-x86_64-fedora-clang 0.1.0 154.40 NOTE
r-devel-linux-x86_64-fedora-gcc 0.1.0 151.56 NOTE
r-devel-windows-ix86+x86_64 0.1.0 56.00 282.00 338.00 OK
r-devel-windows-ix86+x86_64-gcc8 0.1.0 54.00 231.00 285.00 OK
r-patched-linux-x86_64 0.1.0 14.27 95.67 109.94 OK
r-patched-solaris-x86 0.1.0 163.00 NOTE
r-release-linux-x86_64 0.1.0 16.72 96.19 112.91 OK
r-release-windows-ix86+x86_64 0.1.0 42.00 171.00 213.00 OK
r-release-osx-x86_64 0.1.0 NOTE
r-oldrel-windows-ix86+x86_64 0.1.0 31.00 183.00 214.00 OK
r-oldrel-osx-x86_64 0.1.0 NOTE

Check Details

Version: 0.1.0
Check: tests
Result: ERROR
     Running 'testthat.R' [4s/4s]
    Running the tests in 'tests/testthat.R' failed.
    Complete output:
     > library(testthat)
     > library(netchain)
     >
     > test_check("netchain")
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
     :
     --- package (from environment) ---
     netchain
     --- call from context ---
     chain.causal.multi(targetoutcome = "mean", treatment = c(1, 0,
     0), inputY, inputA, listC = NULL, R.matrix = R.matrix, E.matrix = diag(3),
     n.obs = 2, n.burn = 1)
     --- call from argument ---
     if (class(edgeY) == "numeric") edgeY = t(as.matrix(edgeY))
     --- R stacktrace ---
     where 1 at testthat/testchain.R#27: chain.causal.multi(targetoutcome = "mean", treatment = c(1, 0,
     0), inputY, inputA, listC = NULL, R.matrix = R.matrix, E.matrix = diag(3),
     n.obs = 2, n.burn = 1)
     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/testchain.R#16: test_that("Test that causal probability on collective outcomes is estimated",
     {
     weight.matrix = matrix(c(0.5, 1, 0, 1, 0.3, 0.5, 0, 0.5,
     -0.5), 3, 3)
     simobs = simGibbs(n.unit = 3, n.gibbs = 10, n.sample = 10,
     weight.matrix, treat.matrix = 0.5 * diag(3), cov.matrix = 0 *
     diag(3))
     inputY = simobs$inputY
     inputA = simobs$inputA
     R.matrix = ifelse(weight.matrix == 0, 0, 1)
     diag(R.matrix) = 0
     result = chain.causal.multi(targetoutcome = "mean", treatment = c(1,
     0, 0), inputY, inputA, listC = NULL, R.matrix = R.matrix,
     E.matrix = diag(3), n.obs = 2, n.burn = 1)
     expect_true(result$causalprob > 0 & result$causalprob <
     1)
     expect_equal(result$n.par, 8)
     expect_equal(length(result$par.est), 8)
     })
     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("netchain")
    
     --- value of length: 2 type: logical ---
     [1] FALSE FALSE
     --- function from context ---
     function (targetoutcome = "mean", treatment, inputY, inputA,
     listC, R.matrix, E.matrix, edgeinfo = NULL, n.obs = 1000,
     n.burn = 100, optim.method = "L-BFGS-B")
     {
     allobservations = list()
     for (i in 1:nrow(inputY)) {
     allobservations[[i]] = rbind(inputY[i, ], inputA[i, ])
     if (class(listC) == "list") {
     for (r in 1:length(listC)) {
     allobservations[[i]] = rbind(allobservations[[i]],
     listC[[r]][i, ])
     }
     }
     else if (class(listC) == "matrix") {
     allobservations[[i]] = rbind(allobservations[[i]],
     listC[i, ])
     }
     }
     yvalues = unique(as.numeric(inputY))
     if (!is.null(edgeinfo)) {
     edgeExtra = list()
     for (k in 1:length(edgeinfo)) {
     tmpname = ifelse(edgeinfo[[k]][, 1] == "Y", 1, 0)
     tmpname = ifelse(edgeinfo[[k]][, 1] == "A", 2, tmpname)
     if (sum(str_extract(edgeinfo[[k]][, 1], "[aA-zZ]+") ==
     "C") != 0) {
     var.order = which(str_extract(edgeinfo[[k]][,
     1], "[aA-zZ]+") == "C")
     confounder.num = str_extract(edgeinfo[[k]][var.order,
     1], "[0-9]+")
     if (is.na(confounder.num))
     confounder.num = 1
     tmpname[var.order] = 2 + as.integer(confounder.num)
     }
     edgeExtra[[k]] = cbind(as.integer(tmpname), as.integer(edgeinfo[[k]][,
     2]))
     }
     }
     else {
     edgeExtra = NULL
     }
     edgeY = cbind(which(R.matrix == 1)%/%nrow(R.matrix) + 1,
     which(R.matrix == 1)%%nrow(R.matrix))
     edgeY[which(edgeY[, 2] == 0), 1] = edgeY[which(edgeY[, 2] ==
     0), 1] - 1
     edgeY[which(edgeY[, 2] == 0), 2] = nrow(R.matrix)
     edgeY = edgeY[which(edgeY[, 1] < edgeY[, 2]), ]
     if (class(edgeY) == "numeric")
     edgeY = t(as.matrix(edgeY))
     colnames(edgeY) = c("Y", "Y")
     edgeAY = cbind(which(E.matrix == 1)%%nrow(E.matrix), which(E.matrix ==
     1)%/%nrow(E.matrix) + 1)
     edgeAY[which(edgeAY[, 1] == 0), 2] = edgeAY[which(edgeAY[,
     1] == 0), 2] - 1
     edgeAY[which(edgeAY[, 1] == 0), 1] = nrow(E.matrix)
     if (class(edgeAY) == "numeric")
     edgeAY = t(as.matrix(edgeAY))
     colnames(edgeAY) = c("A", "Y")
     n.par = ncol(inputY) + nrow(edgeY) + nrow(edgeAY) + length(edgeExtra)
     permutetab = permutations(n = length(unique(as.numeric(inputY))),
     r = ncol(inputY), unique(as.numeric(inputY)), repeats.allowed = T)
     par.est = try(optim(par = rep(0, n.par), multiloglikechain,
     listobservations = allobservations, permutetab = permutetab,
     edgeY = edgeY, edgeAY = edgeAY, edgeExtra = edgeExtra,
     control = list(fnscale = -1), method = optim.method)$par,
     silent = TRUE)
     if (class(par.est) == "try-error")
     return("noconvergence")
     Neighborind = Neighborpar = list()
     for (i in 1:ncol(inputY)) {
     Neighborind[[i]] = list()
     Neighborpar[[i]] = list()
     Neighborind[[i]][[1]] = t(as.matrix(c(1, i)))
     Neighborpar[[i]][[1]] = i
     whichnb = which(rowSums(edgeY == i) != 0)
     if (length(whichnb) > 0) {
     for (j in 1:length(whichnb)) {
     Neighborind[[i]][[1 + j]] = rbind(c(1, i), cbind(1,
     edgeY[whichnb[j], ][edgeY[whichnb[j], ] !=
     i]))
     Neighborpar[[i]][[1 + j]] = ncol(inputY) + whichnb[j]
     }
     }
     whicheffect = which(edgeAY[, 2] == i)
     if (length(whicheffect) > 0) {
     for (l in 1:length(whicheffect)) {
     Neighborind[[i]][[1 + length(whichnb) + l]] = rbind(c(1,
     i), cbind(2, edgeAY[whicheffect[l], 1]))
     Neighborpar[[i]][[1 + length(whichnb) + l]] = ncol(inputY) +
     nrow(edgeY) + whicheffect[l]
     }
     }
     count = 0
     for (k in 1:length(edgeExtra)) {
     if (sum(edgeExtra[[k]][, 1] == 1 & edgeExtra[[k]][,
     2] == i) > 0) {
     count = count + 1
     mynode = which(edgeExtra[[k]][, 1] == 1 & edgeExtra[[k]][,
     2] == i)
     Neighborind[[i]][[1 + length(whichnb) + length(whicheffect) +
     count]] = rbind(c(1, i), cbind(edgeExtra[[k]][-mynode,
     1], edgeExtra[[k]][-mynode, 2]))
     Neighborpar[[i]][[1 + length(whichnb) + length(whicheffect) +
     count]] = ncol(inputY) + nrow(edgeY) + nrow(edgeAY) +
     k
     }
     }
     }
     targets = 0
     for (i in 1:length(allobservations)) {
     if (nrow(allobservations[[1]]) > 2) {
     covariates = allobservations[[i]][3:nrow(allobservations[[i]]),
     ]
     }
     else {
     covariates = NULL
     }
     outcomes = chaingibbs(pars = par.est, n.obs = n.obs,
     treatment, covariates, initprob = 0.5, yvalues = c(0,
     1), Neighborind, Neighborpar, n.burn = n.burn)
     if (class(targetoutcome) == "numeric" & length(targetoutcome) ==
     ncol(inputY)) {
     targets = targets + mean(rowMeans(outcomes == targetoutcome) ==
     1)/length(allobservations)
     }
     else if (class(targetoutcome) == "matrix") {
     for (jj in 1:nrow(targetoutcome)) {
     targets = targets + mean(apply(outcomes, 1, function(x) identical(x,
     targetoutcome[jj, ])))/length(allobservations)
     }
     }
     else if (class(targetoutcome) == "numeric" & length(targetoutcome) ==
     1) {
     targets = targets + mean(rowSums(outcomes == max(yvalues)) ==
     targetoutcome)/length(allobservations)
     }
     else {
     targets = targets + mean(rowMeans(outcomes == max(yvalues)))/length(allobservations)
     }
     }
     return(list(causalprob = targets, n.par = n.par, par.est = par.est))
     }
     <bytecode: 0x3cb6860>
     <environment: namespace:netchain>
     --- function search by body ---
     Function chain.causal.multi in namespace netchain has this body.
     ----------- END OF FAILURE REPORT --------------
     -- 1. Error: Test that causal probability on collective outcomes is estimated (@
     the condition has length > 1
     Backtrace:
     1. netchain::chain.causal.multi(...)
    
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
     :
     --- package (from environment) ---
     netchain
     --- call from context ---
     causal.influence(targetoutcome = c(1, 1, 1), Avalues = c(1, 0),
     inputY, inputA, listC = NULL, R.matrix, E.matrix = diag(3),
     n.obs = 2, n.burn = 1)
     --- call from argument ---
     if (class(edgeY) == "numeric") edgeY <- t(as.matrix(edgeY))
     --- R stacktrace ---
     where 1 at testthat/testchain.R#49: causal.influence(targetoutcome = c(1, 1, 1), Avalues = c(1, 0),
     inputY, inputA, listC = NULL, R.matrix, E.matrix = diag(3),
     n.obs = 2, n.burn = 1)
     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/testchain.R#38: test_that("Test that chain graph model can be used to identify causally influential units on social network",
     {
     weight.matrix = matrix(c(0.5, 1, 0, 1, 0.3, 0.5, 0, 0.5,
     -0.5), 3, 3)
     simobs = simGibbs(n.unit = 3, n.gibbs = 10, n.sample = 10,
     weight.matrix, treat.matrix = 0.5 * diag(3), cov.matrix = 0 *
     diag(3))
     inputY = simobs$inputY
     inputA = simobs$inputA
     R.matrix = ifelse(weight.matrix == 0, 0, 1)
     diag(R.matrix) = 0
     influence = causal.influence(targetoutcome = c(1, 1,
     1), Avalues = c(1, 0), inputY, inputA, listC = NULL,
     R.matrix, E.matrix = diag(3), n.obs = 2, n.burn = 1)
     expect_true(sum(influence$influence > 0 & influence$influence <
     1) == 3)
     expect_equal(influence$n.par, 8)
     expect_equal(length(influence$par.est), 8)
     })
     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("netchain")
    
     --- value of length: 2 type: logical ---
     [1] FALSE FALSE
     --- function from context ---
     function (targetoutcome = "mean", Avalues, inputY, inputA, listC,
     R.matrix, E.matrix, edgeinfo = NULL, n.obs = 1000, n.burn = 100,
     optim.method = "L-BFGS-B")
     {
     allobservations = list()
     for (i in 1:nrow(inputY)) {
     allobservations[[i]] <- rbind(inputY[i, ], inputA[i,
     ])
     if (class(listC) == "list") {
     for (r in 1:length(listC)) {
     allobservations[[i]] <- rbind(allobservations[[i]],
     listC[[r]][i, ])
     }
     }
     else if (class(listC) == "matrix") {
     allobservations[[i]] <- rbind(allobservations[[i]],
     listC[i, ])
     }
     }
     yvalues <- unique(as.numeric(inputY))
     if (!is.null(edgeinfo)) {
     edgeExtra <- list()
     for (k in 1:length(edgeinfo)) {
     tmpname <- ifelse(edgeinfo[[k]][, 1] == "Y", 1, 0)
     tmpname <- ifelse(edgeinfo[[k]][, 1] == "A", 2, tmpname)
     if (sum(str_extract(edgeinfo[[k]][, 1], "[aA-zZ]+") ==
     "C") != 0) {
     var.order <- which(str_extract(edgeinfo[[k]][,
     1], "[aA-zZ]+") == "C")
     confounder.num <- str_extract(edgeinfo[[k]][var.order,
     1], "[0-9]+")
     if (is.na(confounder.num))
     confounder.num <- 1
     tmpname[var.order] <- 2 + as.integer(confounder.num)
     }
     edgeExtra[[k]] <- cbind(as.integer(tmpname), as.integer(edgeinfo[[k]][,
     2]))
     }
     }
     else {
     edgeExtra <- NULL
     }
     edgeY <- cbind(which(R.matrix == 1)%/%nrow(R.matrix) + 1,
     which(R.matrix == 1)%%nrow(R.matrix))
     edgeY[which(edgeY[, 2] == 0), 1] <- edgeY[which(edgeY[, 2] ==
     0), 1] - 1
     edgeY[which(edgeY[, 2] == 0), 2] <- nrow(R.matrix)
     edgeY <- edgeY[which(edgeY[, 1] < edgeY[, 2]), ]
     if (class(edgeY) == "numeric")
     edgeY <- t(as.matrix(edgeY))
     colnames(edgeY) <- c("Y", "Y")
     edgeAY <- cbind(which(E.matrix == 1)%%nrow(E.matrix), which(E.matrix ==
     1)%/%nrow(E.matrix) + 1)
     edgeAY[which(edgeAY[, 1] == 0), 2] <- edgeAY[which(edgeAY[,
     1] == 0), 2] - 1
     edgeAY[which(edgeAY[, 1] == 0), 1] <- nrow(E.matrix)
     if (class(edgeAY) == "numeric")
     edgeAY <- t(as.matrix(edgeAY))
     colnames(edgeAY) <- c("A", "Y")
     n.par <- ncol(inputY) + nrow(edgeY) + nrow(edgeAY) + length(edgeExtra)
     permutetab <- permutations(n = length(unique(as.numeric(inputY))),
     r = ncol(inputY), unique(as.numeric(inputY)), repeats.allowed = T)
     par.est <- try(optim(par = rep(0, n.par), multiloglikechain,
     listobservations = allobservations, permutetab = permutetab,
     edgeY = edgeY, edgeAY = edgeAY, edgeExtra = edgeExtra,
     control = list(fnscale = -1), method = optim.method)$par,
     silent = TRUE)
     if (class(par.est) == "try-error")
     return("noconvergence")
     Neighborind = Neighborpar <- list()
     for (i in 1:ncol(inputY)) {
     Neighborind[[i]] <- list()
     Neighborpar[[i]] <- list()
     Neighborind[[i]][[1]] <- t(as.matrix(c(1, i)))
     Neighborpar[[i]][[1]] <- i
     whichnb = which(rowSums(edgeY == i) != 0)
     if (length(whichnb) > 0) {
     for (j in 1:length(whichnb)) {
     Neighborind[[i]][[1 + j]] <- rbind(c(1, i), cbind(1,
     edgeY[whichnb[j], ][edgeY[whichnb[j], ] !=
     i]))
     Neighborpar[[i]][[1 + j]] <- ncol(inputY) + whichnb[j]
     }
     }
     whicheffect = which(edgeAY[, 2] == i)
     if (length(whicheffect) > 0) {
     for (l in 1:length(whicheffect)) {
     Neighborind[[i]][[1 + length(whichnb) + l]] <- rbind(c(1,
     i), cbind(2, edgeAY[whicheffect[l], 1]))
     Neighborpar[[i]][[1 + length(whichnb) + l]] <- ncol(inputY) +
     nrow(edgeY) + whicheffect[l]
     }
     }
     count <- 0
     for (k in 1:length(edgeExtra)) {
     if (sum(edgeExtra[[k]][, 1] == 1 & edgeExtra[[k]][,
     2] == i) > 0) {
     count <- count + 1
     mynode <- which(edgeExtra[[k]][, 1] == 1 & edgeExtra[[k]][,
     2] == i)
     Neighborind[[i]][[1 + length(whichnb) + length(whicheffect) +
     count]] <- rbind(c(1, i), cbind(edgeExtra[[k]][-mynode,
     1], edgeExtra[[k]][-mynode, 2]))
     Neighborpar[[i]][[1 + length(whichnb) + length(whicheffect) +
     count]] <- ncol(inputY) + nrow(edgeY) + nrow(edgeAY) +
     k
     }
     }
     }
     treatments <- matrix(min(Avalues), nrow = ncol(inputY), ncol = ncol(inputY))
     diag(treatments) <- max(Avalues)
     targets <- rep(0, nrow(treatments))
     for (k in 1:length(targets)) {
     for (i in 1:length(allobservations)) {
     if (nrow(allobservations[[1]]) > 2) {
     covariates <- allobservations[[i]][3:nrow(allobservations[[i]]),
     ]
     }
     else {
     covariates <- NULL
     }
     outcomes <- chaingibbs(pars = par.est, n.obs = 500,
     treatment = treatments[k, ], covariates, initprob = 0.5,
     yvalues, Neighborind, Neighborpar, n.burn = 100)
     if (class(targetoutcome) == "numeric" & length(targetoutcome) ==
     ncol(inputY)) {
     targets[k] <- targets[k] + mean(rowMeans(outcomes ==
     targetoutcome) == 1)/length(allobservations)
     }
     else if (class(targetoutcome) == "matrix") {
     for (jj in 1:nrow(targetoutcome)) {
     targets[k] <- targets[k] + mean(rowMeans(outcomes ==
     targetoutcome[jj, ]) == 1)/length(allobservations)
     }
     }
     else if (class(targetoutcome) == "numeric" & length(targetoutcome) ==
     1) {
     targets[k] <- targets[k] + mean(rowSums(outcomes ==
     max(yvalues)) == targetoutcome)/length(allobservations)
     }
     else {
     targets[k] <- targets[k] + mean(rowMeans(outcomes ==
     max(yvalues)))/length(allobservations)
     }
     }
     }
     return(list(influence = targets, n.par = n.par, par.est = par.est))
     }
     <bytecode: 0x3c937b0>
     <environment: namespace:netchain>
     --- function search by body ---
     Function causal.influence in namespace netchain has this body.
     ----------- END OF FAILURE REPORT --------------
     -- 2. Error: Test that chain graph model can be used to identify causally influe
     the condition has length > 1
     Backtrace:
     1. netchain::causal.influence(...)
    
     == testthat results ===========================================================
     [ OK: 1 | SKIPPED: 0 | WARNINGS: 0 | FAILED: 2 ]
     1. Error: Test that causal probability on collective outcomes is estimated (@testchain.R#27)
     2. Error: Test that chain graph model can be used to identify causally influential units on social network (@testchain.R#49)
    
     Error: testthat unit tests failed
     Execution halted
Flavor: r-devel-linux-x86_64-debian-clang

Version: 0.1.0
Check: dependencies in R code
Result: NOTE
    Namespaces in Imports field not imported from:
     ‘Matrix’ ‘igraph’
     All declared Imports should be used.
Flavors: r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc, r-patched-solaris-x86, r-release-osx-x86_64, r-oldrel-osx-x86_64