Running ‘testthat.R’ [59s/83s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library("testthat")
  > library("smurf")
  > 
  > test_check("smurf")
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  smurf
   --- call from context --- 
  .pen.mat.ggflasso(adj.matrix = munich_adj_orig, lev.names = 1:25, 
      refcat = 4)
   --- call from argument --- 
  if (!(class(adj.matrix) %in% c("dgCMatrix", "dgTMatrix"))) {
      adj.matrix <- as(adj.matrix, "sparseMatrix")
  }
   --- R stacktrace ---
  where 1 at testthat/test_PO.R#25: .pen.mat.ggflasso(adj.matrix = munich_adj_orig, lev.names = 1:25, 
      refcat = 4)
  where 2: eval(code, test_env)
  where 3: eval(code, test_env)
  where 4: withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error)
  where 5: doTryCatch(return(expr), name, parentenv, handler)
  where 6: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 7: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 8: doTryCatch(return(expr), name, parentenv, handler)
  where 9: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 10: tryCatchList(expr, classes, parentenv, handlers)
  where 11: tryCatch(withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error), error = handle_fatal, 
      skip = function(e) {
      })
  where 12: test_code(desc, code, env = parent.frame())
  where 13 at testthat/test_PO.R#3: test_that("Test ADMM", {
      pen.cov <- c("none", "flasso", "gflasso")
      beta.tilde <- c(runif(1), runif(10), runif(24))
      beta.old <- c(runif(1), runif(10), runif(24))
      n.par.cov <- list(intercept = 1, age = 10, area = 24)
      group.cov <- unlist(list(intercept = 0, age = 0, area = 0))
      lambda <- 10
      lambda1 <- list(intercept = 0, age = 0, area = 0, lambda.orig = 0)
      lambda2 <- list(intercept = 0, age = 0, area = 0, lambda.orig = 0)
      step <- 1e-05
      pen.mat.cov <- list(intercept = as.matrix(0), age = .pen.mat.flasso(n.par.cov[[2]], 
          refcat = 2), area = .pen.mat.ggflasso(adj.matrix = munich_adj_orig, 
          lev.names = 1:25, refcat = 4))
      pen.mat.cov.aux1 <- .pen.mat.eig(pen.cov = pen.cov, pen.mat = pen.mat.cov)
      PO1 <- .PO(beta.tilde = beta.tilde, beta.old = beta.old, 
          pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, 
          pen.mat.cov = pen.mat.cov, pen.mat.cov.aux = pen.mat.cov.aux1, 
          lambda = lambda, lambda1 = lambda1, lambda2 = lambda2, 
          step = step, po.ncores = 1)
      pen.mat.cov.aux2 <- vector("list", length(pen.cov))
      pen.mat.cov.aux2[[2]]$Q <- as.matrix(0)
      pen.mat.cov.aux2[[2]]$eigval <- 0
      pen.mat.cov.aux2[[3]]$Q <- as.matrix(0)
      pen.mat.cov.aux2[[3]]$eigval <- 0
      PO2 <- .PO(beta.tilde = beta.tilde, beta.old = beta.old, 
          pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, 
          pen.mat.cov = pen.mat.cov, pen.mat.cov.aux = pen.mat.cov.aux2, 
          lambda = lambda, lambda1 = lambda1, lambda2 = lambda2, 
          step = step, po.ncores = 1)
      expect_equal(length(PO1), length(PO2))
      expect_true(max(abs(PO1 - PO2)) < 1e-14)
      d <- c(1L, 10L, 24L)
      rho <- sqrt(3)
      for (j in 2:3) {
          Q <- pen.mat.cov.aux1[[j]]$Q
          eigval <- pen.mat.cov.aux1[[j]]$eigval
          ADMM_aux1 <- diag(d[j]) - rho * Q %*% diag(1/(1/eigval + 
              rho)) %*% t(Q)
          ADMM_aux2 <- solve(diag(d[j]) + rho * t(pen.mat.cov[[j]]) %*% 
              pen.mat.cov[[j]])
          expect_equal(dim(ADMM_aux1), dim(ADMM_aux2))
          expect_true(max(abs(ADMM_aux1 - ADMM_aux1)) < 1e-14)
      }
  })
  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("smurf")
  
   --- value of length: 2 type: logical ---
  [1] TRUE TRUE
   --- function from context --- 
  function (adj.matrix, lev.names = NULL, refcat = 1) 
  {
      if (nrow(adj.matrix) != ncol(adj.matrix)) {
          stop("An adjacency matrix needs to be square.")
      }
      if (!isSymmetric(adj.matrix)) {
          stop("An adjacency matrix needs to be symmetric (including row and column names).")
      }
      if (!(class(adj.matrix) %in% c("dgCMatrix", "dgTMatrix"))) {
          adj.matrix <- as(adj.matrix, "sparseMatrix")
      }
      if (any(adj.matrix@x != 1)) {
          stop("All elements of an adjacency matrix need to be zero or one.")
      }
      if (!is.null(lev.names)) {
          if (is.null(colnames(adj.matrix))) {
              stop("An adjacency matrix needs to have column names.")
          }
          if (is.null(rownames(adj.matrix))) {
              stop("An adjacency matrix needs to have row names.")
          }
          if (!all(as.character(lev.names) %in% as.character(colnames(adj.matrix)))) {
              stop("Not all levels are present in the column names of the adjacency matrix.")
          }
      }
      if (refcat > 1) {
          adj.matrix <- adj.matrix[, c(refcat, (1:ncol(adj.matrix))[-refcat])]
          adj.matrix <- adj.matrix[c(refcat, (1:nrow(adj.matrix))[-refcat]), 
              ]
          refcat <- 1
      }
      total <- sum(triu(adj.matrix))
      pen.mat <- matrix(0, total, ncol(adj.matrix) - refcat)
      if (refcat) {
          colnames(pen.mat) <- colnames(adj.matrix)[-1]
      }
      else {
          colnames(pen.mat) <- colnames(adj.matrix)
      }
      ind <- 0L
      for (j in 1:ncol(pen.mat)) {
          total.j <- sum(adj.matrix[1:j, j + refcat])
          ind.j <- which(adj.matrix[1:j, j + refcat] == 1)
          if (total.j > 0) {
              for (l in 1:total.j) {
                  pen.mat[ind + l, j] <- 1
                  if (ind.j[l] > refcat) {
                    pen.mat[ind + l, ind.j[l] - refcat] <- -1
                  }
              }
          }
          ind <- ind + total.j
      }
      return(pen.mat)
  }
  <bytecode: 0x557250e33920>
  <environment: namespace:smurf>
   --- function search by body ---
  Function .pen.mat.ggflasso in namespace smurf has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1