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: 0x3fa0f20>
  <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: 0x3f76778>
  <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