Running 'testthat.R' [104s]
Running the tests in 'tests/testthat.R' failed.
Complete output:
  > Sys.setenv("R_TESTS" = "")
  > library(testthat)
  > library(RxODE)
  Rtools is not set up correctly!
  
  You need a working Rtools installation for RxODE to work.
  You can set up Rtools using the command 'rxWinSetup()'.
  
  > test_check("RxODE")
  -- 1. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  ---
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 2. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  ---
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 3. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  ---
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 4. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  ---
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 5. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  ---
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 6. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  ---
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 7. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  ---
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 8. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  ---
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 9. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  ---
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 10. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  --
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 11. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  --
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  -- 12. Error: diagonal indicator give correct values (@test-omega-chol.R#34)  --
  could not find function ".findInheritedMethods"
  1: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3)) at testthat/test-omega-chol.R:34
  2: do.call(rxSymInvCreateC_, args, envir = envir)
  3: (function (mat, diag.xform = c("sqrt", "log", "identity")) 
     {
         diag.xform <- match.arg(diag.xform)
         mat2 <- mat
         mat2 <- rxInv(mat2)
         mat2 <- try({
             chol(mat2)
         })
         if (inherits(mat2, "try-error")) {
             stop("Initial Omega matrix inverse is non-positive definite.")
         }
         mat3 = mat2
         if (diag.xform == "sqrt") {
             diag(mat3) <- sqrt(diag(mat3))
         }
         else if (diag.xform == "log") {
             diag(mat3) <- log(diag(mat3))
         }
         w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)
         elts <- as.vector(mat3)[w]
         ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]
         th.unscaled <- c()
         for (i in seq_along(elts)) {
             if (elts[i] != 0) {
                 th.unscaled[length(th.unscaled) + 1] <- elts[i]
             }
         }
         mat1 <- (mat != 0) * 1
         if (length(mat1) == 1) {
             mat1 <- matrix(mat1, 1)
         }
         dmat <- dim(mat1)[1] - 1
         block <- list()
         last <- 1
         if (dmat != 0) {
             for (i in 1:dmat) {
                 if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {
                     s <- seq(last, i)
                     cur <- matrix(as.double(mat[s, s]), length(s))
                     last <- i + 1
                     block[[length(block) + 1]] <- cur
                 }
             }
         }
         if (length(block) != 0) {
             s <- seq(last, dmat + 1)
             cur <- matrix(as.double(mat[s, s]), length(s))
             block[[length(block) + 1]] <- cur
         }
         if (length(block) == 0) {
             if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`, 0L, NULL, 
                 NULL)) {
                 fmat <- mat1
                 num <- as.vector(mat1[upper.tri(mat1, TRUE)])
                 i <- 0
                 num <- sapply(num, function(x) {
                     if (x == 1) {
                       i <<- i + 1
                       return(i)
                     }
                     else {
                       return(0)
                     }
                 })
                 fmat[upper.tri(fmat, TRUE)] <- num - 1
                 fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]
                 d <- dim(fmat)[1]
                 fmat <- paste0("t", fmat)
                 fmat[fmat == "t-1"] <- "0"
                 fmat <- matrix(fmat, d)
                 if (diag.xform == "sqrt") {
                     diag(fmat) <- sprintf("%s^2", diag(fmat))
                 }
                 else if (diag.xform == "log") {
                     diag(fmat) <- sprintf("exp(%s)", diag(fmat))
                 }
                 else {
                     diag(fmat) <- sprintf("(%s)", diag(fmat))
                 }
                 w <- which(fmat[upper.tri(fmat, TRUE)] != "0")
                 if (length(w) == 0) {
                     stop("zero matrix.")
                 }
                 fn <- eval(bquote(function(theta, tn) {
                     if (is.null(tn)) {
                       .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))
                       .ret[lower.tri(.ret)] <- FALSE
                       return(.ret[lower.tri(.ret, TRUE)])
                     }
                     else if (is.na(tn)) {
                       new.theta <- rep(0, .((d + 1) * d/2))
                       new.theta[.(w)] <- theta
                       return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                         NA_integer_))
                     }
                     if (tn == -2L) {
                       return(.(length(w)))
                     }
                     new.theta <- rep(0, .((d + 1) * d/2))
                     new.theta[.(w)] <- theta
                     return(.Call(`_rxCholInv`, .(as.integer(d)), as.double(new.theta), 
                       as.integer(tn)))
                 }))
                 ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
             else {
                 ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)
                 th <- th.unscaled
                 ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))
                 class(ret) <- "rxSymInvChol"
                 return(ret)
             }
         }
         else {
             mat <- Matrix::.bdiag(block)
             matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)
             ini <- unlist(lapply(matI, function(x) {
                 x$ini
             }))
             ntheta <- sum(sapply(matI, function(x) {
                 return(x$fn(NULL, -2L))
             }))
             i <- 1
             theta.part <- lapply(matI, function(x) {
                 len <- x$fn(NULL, -2L)
                 ret <- as.integer(seq(i, by = 1, length = len))
                 i <<- max(ret) + 1
                 return(ret)
             })
             fn <- eval(bquote(function(theta, tn) {
                 force(matI)
                 theta.part <- .(theta.part)
                 if (is.null(tn)) {
                     if (is.null(theta)) {
                       return(unlist(lapply(theta.part, function(x) {
                         .j <- .k <- 1
                         .ret <- logical(length(x))
                         for (.i in seq_along(x)) {
                           if (.j == .k) {
                             .ret[.i] <- TRUE
                             .k <- .k + 1
                             .j <- 1
                           } else {
                             .ret[.i] <- FALSE
                             .j <- .j + 1
                           }
                         }
                         return(.ret)
                       })))
                     }
                 }
                 else if (!is.na(tn)) {
                     if (tn == -2L) {
                       return(.(ntheta))
                     }
                 }
                 lst <- lapply(seq_along(theta.part), function(x) {
                     mt <- matI[[x]]
                     w <- theta.part[[x]]
                     new.theta <- theta[w]
                     ctn <- as.integer(tn)
                     if (is.na(ctn)) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else if (ctn == -1L || ctn == 0L) {
                       return(mt$fn(as.double(new.theta), ctn))
                     }
                     else {
                       if (ctn > 0L) {
                         if (ctn > max(w) | ctn < min(w)) {
                           mat <- mt$fn(as.double(new.theta), 0L)
                           d <- dim(mat)[1]
                           return(matrix(rep(0, d * d), d))
                         }
                         else {
                           ctn <- as.integer(ctn - min(w) + 1)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                       else {
                         ctn <- as.integer(-ctn - 2)
                         if (ctn > max(w) | ctn < min(w)) {
                           vec <- mt$fn(as.double(new.theta), -3L)
                           d <- length(vec)
                           return(rep(0, d))
                         }
                         else {
                           ctn <- as.integer(-(ctn - min(w) + 1) - 2L)
                           return(mt$fn(as.double(new.theta), ctn))
                         }
                       }
                     }
                 })
                 if (is.na(tn)) {
                     return(unlist(lst))
                 }
                 else if (tn >= -1) {
                     return(as.matrix(Matrix::.bdiag(lst)))
                 }
                 else {
                     return(unlist(lst))
                 }
             }))
             ret <- list(fmat = mat, ini = ini, fn = fn)
             class(ret) <- "rxSymInvChol"
             return(ret)
         }
     })(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  4: Matrix::.bdiag
  5: getExportedValue(pkg, name)
  6: asNamespace(ns)
  7: getNamespace(ns)
  8: tryCatch(loadNamespace(name), error = function(e) stop(e))
  9: tryCatchList(expr, classes, parentenv, handlers)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: value[[3L]](cond)
  
  [====|====|====|====|====|====|====|====|====|====
  [====|====|====|====|====|====|====|====|====|====Error : Could not find package root.
  == testthat results  ===========================================================
  [ OK: 2325 | SKIPPED: 2 | WARNINGS: 1 | FAILED: 12 ]
  1. Error: diagonal indicator give correct values (@test-omega-chol.R#34) 
  2. Error: diagonal indicator give correct values (@test-omega-chol.R#34) 
  3. Error: diagonal indicator give correct values (@test-omega-chol.R#34) 
  4. Error: diagonal indicator give correct values (@test-omega-chol.R#34) 
  5. Error: diagonal indicator give correct values (@test-omega-chol.R#34) 
  6. Error: diagonal indicator give correct values (@test-omega-chol.R#34) 
  7. Error: diagonal indicator give correct values (@test-omega-chol.R#34) 
  8. Error: diagonal indicator give correct values (@test-omega-chol.R#34) 
  9. Error: diagonal indicator give correct values (@test-omega-chol.R#34) 
  1. ...
  
  Error: testthat unit tests failed
  Execution halted