CRAN Package Check Results for Package ratematrix

Last updated on 2020-02-19 06:48:35 CET.

Flavor Version Tinstall Tcheck Ttotal Status Flags
r-devel-linux-x86_64-debian-clang 1.2.1 68.04 148.22 216.26 WARN
r-devel-linux-x86_64-debian-gcc 1.2.1 47.74 114.17 161.91 WARN
r-devel-linux-x86_64-fedora-clang 1.2.1 268.20 WARN
r-devel-linux-x86_64-fedora-gcc 1.2.1 253.08 WARN
r-devel-windows-ix86+x86_64 1.2.1 90.00 192.00 282.00 OK
r-devel-windows-ix86+x86_64-gcc8 1.2.1 149.00 209.00 358.00 OK
r-patched-linux-x86_64 1.2.1 47.31 128.10 175.41 OK
r-patched-solaris-x86 1.2.1 325.00 OK
r-release-linux-x86_64 1.2.1 55.22 128.35 183.57 OK
r-release-windows-ix86+x86_64 1.2.1 98.00 187.00 285.00 OK
r-release-osx-x86_64 1.2.1 NOTE
r-oldrel-windows-ix86+x86_64 1.2.1 94.00 162.00 256.00 OK
r-oldrel-osx-x86_64 1.2.1 NOTE

Check Details

Version: 1.2.1
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
     ...
    --- re-building 'Intro_on_the_package.Rmd' using knitr
    --- finished re-building 'Intro_on_the_package.Rmd'
    
    --- re-building 'Making_prior_on_ratematrix.Rmd' using knitr
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    ratematrix
     --- call from context ---
    plotRatematrix(chain = post.unif.root, set.leg = c("trait_1",
     "trait_2"), point.matrix = list(R), point.color = "red",
     point.wd = 1.5)
     --- call from argument ---
    if (!class(point.matrix[[1]]) == "matrix") stop(" point.matrix need to be a list of matrices.")
     --- R stacktrace ---
    where 1: plotRatematrix(chain = post.unif.root, set.leg = c("trait_1",
     "trait_2"), point.matrix = list(R), point.color = "red",
     point.wd = 1.5)
    where 2: eval(expr, envir, enclos)
    where 3: eval(expr, envir, enclos)
    where 4: withVisible(eval(expr, envir, enclos))
    where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
     debug = debug, last = i == length(out), use_try = stop_on_error !=
     2L, keep_warning = keep_warning, keep_message = keep_message,
     output_handler = output_handler, include_timing = include_timing)
    where 9: evaluate::evaluate(...)
    where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
     keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
     options$include) 0L else 2L, output_handler = knit_handlers(options$render,
     options))
    where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
     keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
     stop_on_error = if (options$error && options$include) 0L else 2L,
     output_handler = knit_handlers(options$render, options)))
    where 12: block_exec(params)
    where 13: call_block(x)
    where 14: process_group.block(group)
    where 15: process_group(group)
    where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
     error = function(e) {
     setwd(wd)
     cat(res, sep = "\n", file = output %n% "")
     message("Quitting from lines ", paste(current_lines(i),
     collapse = "-"), " (", knit_concord$get("infile"),
     ") ")
     })
    where 17: process_file(text, output)
    where 18: knit(input, text = text, envir = envir, quiet = quiet)
    where 19: knit2html(..., force_v1 = TRUE)
    where 20: (if (grepl("\\.[Rr]md$", file)) knit2html_v1 else if (grepl("\\.[Rr]rst$",
     file)) knit2pandoc else knit)(file, encoding = encoding,
     quiet = quiet, envir = globalenv(), ...)
    where 21: engine$weave(file, quiet = quiet, encoding = enc)
    where 22: doTryCatch(return(expr), name, parentenv, handler)
    where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 24: tryCatchList(expr, classes, parentenv, handlers)
    where 25: tryCatch({
     engine$weave(file, quiet = quiet, encoding = enc)
     setwd(startdir)
     output <- find_vignette_product(name, by = "weave", engine = engine)
     if (!have.makefile && vignette_is_tex(output)) {
     texi2pdf(file = output, clean = FALSE, quiet = quiet)
     output <- find_vignette_product(name, by = "texi2pdf",
     engine = engine)
     }
    }, error = function(e) {
     OK <<- FALSE
     message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
     file, conditionMessage(e)))
    })
    where 26: tools:::.buildOneVignette("Making_prior_on_ratematrix.Rmd", "/home/hornik/tmp/R.check/r-devel-clang/Work/PKGS/ratematrix.Rcheck/vign_test/ratematrix",
     TRUE, FALSE, "Making_prior_on_ratematrix", "UTF-8", "/tmp/RtmpfdJq1Y/file6c002b231bb8.rds")
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (chain, p = NULL, colors = NULL, set.xlim = NULL, set.leg = NULL,
     l.cex = 0.7, ell.wd = 0.5, alphaOff = 1, alphaDiag = 1, alphaEll = 1,
     hpd = 100, show.zero = FALSE, n.lines = 50, n.points = 200,
     point.matrix = NULL, point.color = NULL, point.wd = 0.5)
    {
     ll_class <- length(class(chain))
     if (ll_class == 1) {
     correct_class <- grepl(pattern = "ratematrix", x = class(chain))
     }
     else {
     correct_class <- any(sapply(class(chain), function(x) grepl(pattern = "ratematrix",
     x = x)))
     }
     if (!correct_class)
     stop("chain argument need to be a single MCMC chain. See 'mergePosterior' function to merge multiple MCMC chains together.")
     if (is.null(chain$n_post_samples)) {
     if (n.lines > nrow(chain[[1]])) {
     n.lines <- nrow(chain[[1]])
     }
     }
     else {
     if (n.lines > chain$n_post_samples) {
     n.lines <- chain$n_post_samples
     }
     }
     if (is.null(p)) {
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[1]][[1]])) {
     np <- length(chain$matrix)
     p <- 1:np
     }
     else {
     p <- 1
     }
     }
     if (is.null(colors)) {
     np <- length(p)
     if (np > 9)
     stop("Unable to generate colors for more than 9 regimes. Please define color vector using 'colors' argument.")
     if (np == 1) {
     colors <- "black"
     }
     else {
     check <- c(np < 4, 3 < np && np < 6, np > 5)
     cols <- list(c("#002244", "#69BE28", "#A5ACAF"),
     c("#7fc97f", "#beaed4", "#fdc086", "#386cb0",
     "#ffff99"), c("#bc80bd", "#d9d9d9", "#fccde5",
     "#b3de69", "#fdb462", "#b3de69", "#fccde5",
     "#d9d9d9", "#bc80bd"))
     colors <- unlist(cols[check])[1:np]
     }
     }
     if (is.null(set.leg)) {
     if (is.null(chain$trait_names)) {
     set.leg <- colnames(chain$root)
     }
     else {
     set.leg <- chain$trait_names
     }
     }
     if (length(p) == 1) {
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[p]][[1]])) {
     cat("Plotting a single regime.", "\n")
     dd <- ncol(chain$matrix[[p]][[1]])
     ll <- length(chain$matrix[[p]])
     if (class(chain) == "ratematrix_prior_sample") {
     corr <- lapply(chain$matrix[[p]], decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[[p]][x, ]^2))
     chain$matrix[[p]] <- rb.matrix
     }
     }
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[1]])) {
     if (!p == 1)
     stop("There is only one regime in the chain, then p need to be equal to 1.")
     cat("Plotting a single regime.", "\n")
     dd <- ncol(chain$matrix[[1]])
     ll <- length(chain$matrix)
     if (class(chain) == "ratematrix_prior_sample") {
     corr <- lapply(chain$matrix, decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[x, ]^2))
     chain$matrix <- rb.matrix
     }
     temp <- chain$matrix
     rm(chain)
     chain <- list()
     chain$matrix <- list()
     chain$matrix[[1]] <- temp
     }
     }
     if (length(p) > 1) {
     cat("Plotting multiple regimes.", "\n")
     name.table <- rbind(names(chain$matrix)[p], colors)
     cat("Table with regimes and colors (names or HEX):\n")
     utils::write.table(format(name.table, justify = "right"),
     row.names = F, col.names = F, quote = F)
     check.mat <- vector()
     check.length <- vector()
     for (i in 1:length(p)) {
     check.mat[i] <- ncol(chain$matrix[[p[i]]][[1]])
     check.length[i] <- length(chain$matrix[[p[i]]])
     }
     equal.size <- sapply(2:length(p), function(x) check.mat[1] ==
     check.mat[x])
     equal.length <- sapply(2:length(p), function(x) check.length[1] ==
     check.length[x])
     if (!sum(equal.size) == (length(p) - 1))
     stop("Matrix regimes do not have the same number of traits.")
     if (!sum(equal.length) == (length(p) - 1))
     stop("Chain for regimes do not have the same length.")
     ll <- check.length[1]
     dd <- check.mat[1]
     if (class(chain) == "ratematrix_prior_sample") {
     for (i in p) {
     corr <- lapply(chain$matrix[[i]], decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[[i]][x, ]^2))
     chain$matrix[[i]] <- rb.matrix
     }
     }
     }
     if (hpd < 100) {
     frac <- (1 - (hpd/100))/2
     prob <- c(frac, 1 - frac)
     LL <- lapply(p, function(x) lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[x]],
     function(x) x[y, ])))))
     qq.list <- list()
     for (w in 1:length(LL)) {
     qq.list[[w]] <- list()
     qq.count <- 1
     for (i in 1:dd) {
     for (j in i:dd) {
     qq.list[[w]][[qq.count]] <- stats::quantile(x = LL[[w]][[i]][,
     j], probs = prob)
     qq.count <- qq.count + 1
     }
     }
     }
     if (ll < n.lines)
     stop(" n.lines is larger than number of matrices in the chain.")
     if (n.lines < 1)
     stop(" n.lines need to be > 1.")
     ss.list <- list()
     sampled.LL <- list()
     for (i in 1:length(p)) {
     count <- 1
     ss.list[[i]] <- vector()
     while (count < n.lines) {
     ss <- sample(1:ll, size = 1)
     if (ss %in% ss.list[[i]])
     next
     if (checkHPD(chain$matrix[[p[i]]][[ss]], qq.list[[i]],
     dd))
     next
     ss.list[[i]][count] <- ss
     count <- count + 1
     }
     sampled.LL[[i]] <- lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[p[i]]][ss.list[[i]]],
     function(x) x[y, ]))))
     }
     ell.data <- list()
     for (w in 1:length(p)) {
     ell.data.count <- 1
     ell.data[[w]] <- list()
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.data[[w]][[ell.data.count]] <- getEllipseMatrix(mat = chain$matrix[[p[w]]][ss.list[[w]]],
     traits = c(i, j), n.points = n.points)
     ell.data.count <- ell.data.count + 1
     }
     }
     }
     if (!is.null(point.matrix)) {
     if (!class(point.matrix) == "list")
     stop(" point.matrix need to be a list of matrices.")
     if (!length(point.matrix) == length(p))
     stop("Lenght of point.matrix need to be equal to the number of regimes fitted to the tree.")
     if (!class(point.matrix[[1]]) == "matrix")
     stop(" point.matrix need to be a list of matrices.")
     ell.point <- list()
     for (w in 1:length(p)) {
     ell.point[[w]] <- list()
     ell.point.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.point[[w]][[ell.point.count]] <- getEllipseMatrix(mat = point.matrix[[w]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.point.count <- ell.point.count + 1
     }
     }
     }
     }
     y.hist <- vector()
     x.hist <- vector()
     for (w in 1:length(p)) {
     for (i in 1:dd) {
     for (j in i:dd) {
     x.hist <- c(min(x.hist[1], LL[[w]][[i]][, j],
     na.rm = TRUE), max(x.hist[2], LL[[w]][[i]][,
     j], na.rm = TRUE))
     }
     }
     }
     if (is.null(set.xlim)) {
     wd <- (x.hist[2] - mean(x.hist))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- x.hist
     }
     else {
     wd <- (set.xlim[2] - mean(set.xlim))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- set.xlim
     }
     hists <- list()
     ccat <- list()
     for (w in 1:length(p)) {
     hists[[w]] <- list()
     ccat[[w]] <- list()
     hist.count <- 1
     for (i in 1:dd[1]) {
     for (j in i:dd[1]) {
     if (i == j) {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk.var)
     ccat[[w]][[hist.count]] <- cut(hists[[w]][[hist.count]]$breaks,
     c(-Inf, qq.list[[w]][[hist.count]][1],
     qq.list[[w]][[hist.count]][2], Inf))
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     else {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk)
     ccat[[w]][[hist.count]] <- cut(hists[[w]][[hist.count]]$breaks,
     c(-Inf, qq.list[[w]][[hist.count]][1],
     qq.list[[w]][[hist.count]][2], Inf))
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     }
     }
     }
     ylim.hist <- c(0, y.hist)
     ell.lim <- lapply(do.call(c, ell.data), function(x) x[[1]])
     ell.lim <- do.call(rbind, ell.lim)
     ell.lim <- apply(ell.lim, 2, range)
     ell.lim.iso <- c(min(ell.lim[1, ]), max(ell.lim[2, ]))
     old.par <- graphics::par(no.readonly = TRUE)
     graphics::par(mfrow = c(dd, dd))
     graphics::par(cex = 0.6)
     graphics::par(mar = c(0, 0, 0, 0), oma = c(2, 2, 2, 2))
     graphics::par(tcl = -0.25)
     graphics::par(mgp = c(2, 0.6, 0))
     colOff <- grDevices::adjustcolor(col = colors, alpha.f = alphaOff)
     colDiag <- grDevices::adjustcolor(col = colors, alpha.f = alphaDiag)
     colEll <- grDevices::adjustcolor(col = colors, alpha.f = alphaEll)
     if (is.null(point.color)) {
     point.color <- colors
     }
     ell.plot.count <- 1
     hist.plot.count <- 1
     for (i in 1:dd) {
     for (j in 1:dd) {
     if (j >= i) {
     graphics::plot(1, xlim = xlim.hist, ylim = ylim.hist,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     mid <- mean(xlim.hist)
     first.quart <- xlim.hist[1] + (mid - xlim.hist[1])/2
     second.quart <- mid + (xlim.hist[2] - mid)/2
     graphics::lines(x = c(mid, mid), y = ylim.hist,
     type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(first.quart, first.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(second.quart, second.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     if (show.zero == TRUE) {
     graphics::lines(x = c(0, 0), y = ylim.hist,
     type = "l", lty = 3, col = "blue")
     }
     graphics::box(col = "grey")
     if (j != i) {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, border = "gray",
     col = c("white", colOff[w], "white")[ccat[[w]][[hist.plot.count]]])
     }
     }
     else {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, border = "black",
     col = c("white", colDiag[w], "white")[ccat[[w]][[hist.plot.count]]])
     }
     if (i == dd[1]) {
     graphics::axis(1, at = round(c(xlim.hist[1],
     mean(xlim.hist), xlim.hist[2]), digits = 2))
     }
     }
     if (i == 1) {
     graphics::mtext(text = set.leg[j], side = 3,
     cex = l.cex)
     }
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     graphics::lines(x = c(point.matrix[[w]][i,
     j], point.matrix[[w]][i, j]), y = ylim.hist,
     type = "l", col = point.color[w], lwd = point.wd)
     }
     }
     hist.plot.count <- hist.plot.count + 1
     }
     else {
     graphics::plot(1, xlim = ell.lim.iso, ylim = ell.lim.iso,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     graphics::box(col = "grey")
     for (w in 1:length(p)) {
     invisible(lapply(ell.data[[w]][[ell.plot.count]][[2]],
     function(x) graphics::points(x, col = colEll[w],
     type = "l", lwd = ell.wd)))
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     invisible(graphics::points(ell.point[[w]][[ell.plot.count]],
     col = point.color[w], type = "l", lwd = point.wd))
     }
     }
     ell.plot.count <- ell.plot.count + 1
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     }
     }
     }
     graphics::par(old.par)
     }
     else {
     LL <- lapply(p, function(x) lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[x]],
     function(x) x[y, ])))))
     ell.data <- list()
     for (w in 1:length(p)) {
     ell.data[[w]] <- list()
     ell.data.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.data[[w]][[ell.data.count]] <- getEllipseMatrix(mat = chain$matrix[[p[w]]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.data.count <- ell.data.count + 1
     }
     }
     }
     if (!is.null(point.matrix)) {
     if (!class(point.matrix) == "list")
     stop(" point.matrix need to be a list of matrices.")
     if (!length(point.matrix) == length(p))
     stop("Lenght of point.matrix need to be equal to the number of regimes fitted to the tree.")
     if (!class(point.matrix[[1]]) == "matrix")
     stop(" point.matrix need to be a list of matrices.")
     ell.point <- list()
     for (w in 1:length(p)) {
     ell.point[[w]] <- list()
     ell.point.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.point[[w]][[ell.point.count]] <- getEllipseMatrix(mat = point.matrix[[w]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.point.count <- ell.point.count + 1
     }
     }
     }
     }
     y.hist <- vector()
     x.hist <- vector()
     for (w in 1:length(p)) {
     for (i in 1:dd) {
     for (j in i:dd) {
     x.hist <- c(min(x.hist[1], LL[[w]][[i]][, j],
     na.rm = TRUE), max(x.hist[2], LL[[w]][[i]][,
     j], na.rm = TRUE))
     }
     }
     }
     if (is.null(set.xlim)) {
     wd <- (x.hist[2] - mean(x.hist))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- x.hist
     }
     else {
     wd <- (set.xlim[2] - mean(set.xlim))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- set.xlim
     }
     hists <- list()
     for (w in 1:length(p)) {
     hists[[w]] <- list()
     hist.count <- 1
     for (i in 1:dd) {
     for (j in i:dd) {
     if (i == j) {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk.var)
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     else {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk)
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     }
     }
     }
     ylim.hist <- c(0, y.hist)
     ell.lim <- lapply(do.call(c, ell.data), function(x) x[[1]])
     ell.lim <- do.call(rbind, ell.lim)
     ell.lim <- apply(ell.lim, 2, range)
     ell.lim.iso <- c(min(ell.lim[1, ]), max(ell.lim[2, ]))
     old.par <- graphics::par(no.readonly = TRUE)
     graphics::par(mfrow = c(dd[1], dd[1]))
     graphics::par(cex = 0.6)
     graphics::par(mar = c(0, 0, 0, 0), oma = c(2, 2, 2, 2))
     graphics::par(tcl = -0.25)
     graphics::par(mgp = c(2, 0.6, 0))
     colOff <- grDevices::adjustcolor(col = colors, alpha.f = alphaOff)
     colDiag <- grDevices::adjustcolor(col = colors, alpha.f = alphaDiag)
     colEll <- grDevices::adjustcolor(col = colors, alpha.f = alphaEll)
     if (is.null(point.color)) {
     point.color <- colors
     }
     ell.plot.count <- 1
     hist.plot.count <- 1
     for (i in 1:dd) {
     for (j in 1:dd) {
     if (j >= i) {
     graphics::plot(1, xlim = xlim.hist, ylim = ylim.hist,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     mid <- mean(xlim.hist)
     first.quart <- xlim.hist[1] + (mid - xlim.hist[1])/2
     second.quart <- mid + (xlim.hist[2] - mid)/2
     graphics::lines(x = c(mid, mid), y = ylim.hist,
     type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(first.quart, first.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(second.quart, second.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     if (show.zero == TRUE) {
     graphics::lines(x = c(0, 0), y = ylim.hist,
     type = "l", lty = 3, col = "blue")
     }
     graphics::box(col = "grey")
     if (j != i) {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, col = colOff[w],
     border = "gray")
     }
     }
     else {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, col = colDiag[w],
     border = "black")
     }
     if (i == dd) {
     graphics::axis(1, at = round(c(xlim.hist[1],
     mean(xlim.hist), xlim.hist[2]), digits = 2))
     }
     }
     if (i == 1) {
     graphics::mtext(text = set.leg[j], side = 3,
     cex = l.cex)
     }
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     graphics::lines(x = c(point.matrix[[w]][i,
     j], point.matrix[[w]][i, j]), y = ylim.hist,
     type = "l", col = point.color[w], lwd = point.wd)
     }
     }
     hist.plot.count <- hist.plot.count + 1
     }
     else {
     graphics::plot(1, xlim = ell.lim.iso, ylim = ell.lim.iso,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     graphics::box(col = "grey")
     for (w in 1:length(p)) {
     invisible(lapply(ell.data[[w]][[ell.plot.count]][[2]],
     function(x) graphics::points(x, col = colEll[w],
     type = "l", lwd = ell.wd)))
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     invisible(graphics::points(ell.point[[w]][[ell.plot.count]],
     col = point.color[w], type = "l", lwd = point.wd))
     }
     }
     ell.plot.count <- ell.plot.count + 1
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     }
     }
     }
     graphics::par(old.par)
     }
    }
    <bytecode: 0xf29eec8>
    <environment: namespace:ratematrix>
     --- function search by body ---
    Function plotRatematrix in namespace ratematrix has this body.
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 186-188 (Making_prior_on_ratematrix.Rmd)
    Error: processing vignette 'Making_prior_on_ratematrix.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building 'Making_prior_on_ratematrix.Rmd'
    
    --- re-building 'Set_custom_starting_point.Rmd' using knitr
    --- finished re-building 'Set_custom_starting_point.Rmd'
    
    SUMMARY: processing the following file failed:
     'Making_prior_on_ratematrix.Rmd'
    
    Error: Vignette re-building failed.
    Execution halted
Flavor: r-devel-linux-x86_64-debian-clang

Version: 1.2.1
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
     ...
    --- re-building ‘Intro_on_the_package.Rmd’ using knitr
    --- finished re-building ‘Intro_on_the_package.Rmd’
    
    --- re-building ‘Making_prior_on_ratematrix.Rmd’ using knitr
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    ratematrix
     --- call from context ---
    plotRatematrix(chain = post.unif.root, set.leg = c("trait_1",
     "trait_2"), point.matrix = list(R), point.color = "red",
     point.wd = 1.5)
     --- call from argument ---
    if (!class(point.matrix[[1]]) == "matrix") stop(" point.matrix need to be a list of matrices.")
     --- R stacktrace ---
    where 1: plotRatematrix(chain = post.unif.root, set.leg = c("trait_1",
     "trait_2"), point.matrix = list(R), point.color = "red",
     point.wd = 1.5)
    where 2: eval(expr, envir, enclos)
    where 3: eval(expr, envir, enclos)
    where 4: withVisible(eval(expr, envir, enclos))
    where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
     debug = debug, last = i == length(out), use_try = stop_on_error !=
     2L, keep_warning = keep_warning, keep_message = keep_message,
     output_handler = output_handler, include_timing = include_timing)
    where 9: evaluate::evaluate(...)
    where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
     keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
     options$include) 0L else 2L, output_handler = knit_handlers(options$render,
     options))
    where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
     keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
     stop_on_error = if (options$error && options$include) 0L else 2L,
     output_handler = knit_handlers(options$render, options)))
    where 12: block_exec(params)
    where 13: call_block(x)
    where 14: process_group.block(group)
    where 15: process_group(group)
    where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
     error = function(e) {
     setwd(wd)
     cat(res, sep = "\n", file = output %n% "")
     message("Quitting from lines ", paste(current_lines(i),
     collapse = "-"), " (", knit_concord$get("infile"),
     ") ")
     })
    where 17: process_file(text, output)
    where 18: knit(input, text = text, envir = envir, quiet = quiet)
    where 19: knit2html(..., force_v1 = TRUE)
    where 20: (if (grepl("\\.[Rr]md$", file)) knit2html_v1 else if (grepl("\\.[Rr]rst$",
     file)) knit2pandoc else knit)(file, encoding = encoding,
     quiet = quiet, envir = globalenv(), ...)
    where 21: engine$weave(file, quiet = quiet, encoding = enc)
    where 22: doTryCatch(return(expr), name, parentenv, handler)
    where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 24: tryCatchList(expr, classes, parentenv, handlers)
    where 25: tryCatch({
     engine$weave(file, quiet = quiet, encoding = enc)
     setwd(startdir)
     output <- find_vignette_product(name, by = "weave", engine = engine)
     if (!have.makefile && vignette_is_tex(output)) {
     texi2pdf(file = output, clean = FALSE, quiet = quiet)
     output <- find_vignette_product(name, by = "texi2pdf",
     engine = engine)
     }
    }, error = function(e) {
     OK <<- FALSE
     message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
     file, conditionMessage(e)))
    })
    where 26: tools:::.buildOneVignette("Making_prior_on_ratematrix.Rmd", "/home/hornik/tmp/R.check/r-devel-gcc/Work/PKGS/ratematrix.Rcheck/vign_test/ratematrix",
     TRUE, FALSE, "Making_prior_on_ratematrix", "UTF-8", "/home/hornik/tmp/scratch/RtmpkxatGX/file35f25272e554.rds")
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (chain, p = NULL, colors = NULL, set.xlim = NULL, set.leg = NULL,
     l.cex = 0.7, ell.wd = 0.5, alphaOff = 1, alphaDiag = 1, alphaEll = 1,
     hpd = 100, show.zero = FALSE, n.lines = 50, n.points = 200,
     point.matrix = NULL, point.color = NULL, point.wd = 0.5)
    {
     ll_class <- length(class(chain))
     if (ll_class == 1) {
     correct_class <- grepl(pattern = "ratematrix", x = class(chain))
     }
     else {
     correct_class <- any(sapply(class(chain), function(x) grepl(pattern = "ratematrix",
     x = x)))
     }
     if (!correct_class)
     stop("chain argument need to be a single MCMC chain. See 'mergePosterior' function to merge multiple MCMC chains together.")
     if (is.null(chain$n_post_samples)) {
     if (n.lines > nrow(chain[[1]])) {
     n.lines <- nrow(chain[[1]])
     }
     }
     else {
     if (n.lines > chain$n_post_samples) {
     n.lines <- chain$n_post_samples
     }
     }
     if (is.null(p)) {
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[1]][[1]])) {
     np <- length(chain$matrix)
     p <- 1:np
     }
     else {
     p <- 1
     }
     }
     if (is.null(colors)) {
     np <- length(p)
     if (np > 9)
     stop("Unable to generate colors for more than 9 regimes. Please define color vector using 'colors' argument.")
     if (np == 1) {
     colors <- "black"
     }
     else {
     check <- c(np < 4, 3 < np && np < 6, np > 5)
     cols <- list(c("#002244", "#69BE28", "#A5ACAF"),
     c("#7fc97f", "#beaed4", "#fdc086", "#386cb0",
     "#ffff99"), c("#bc80bd", "#d9d9d9", "#fccde5",
     "#b3de69", "#fdb462", "#b3de69", "#fccde5",
     "#d9d9d9", "#bc80bd"))
     colors <- unlist(cols[check])[1:np]
     }
     }
     if (is.null(set.leg)) {
     if (is.null(chain$trait_names)) {
     set.leg <- colnames(chain$root)
     }
     else {
     set.leg <- chain$trait_names
     }
     }
     if (length(p) == 1) {
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[p]][[1]])) {
     cat("Plotting a single regime.", "\n")
     dd <- ncol(chain$matrix[[p]][[1]])
     ll <- length(chain$matrix[[p]])
     if (class(chain) == "ratematrix_prior_sample") {
     corr <- lapply(chain$matrix[[p]], decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[[p]][x, ]^2))
     chain$matrix[[p]] <- rb.matrix
     }
     }
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[1]])) {
     if (!p == 1)
     stop("There is only one regime in the chain, then p need to be equal to 1.")
     cat("Plotting a single regime.", "\n")
     dd <- ncol(chain$matrix[[1]])
     ll <- length(chain$matrix)
     if (class(chain) == "ratematrix_prior_sample") {
     corr <- lapply(chain$matrix, decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[x, ]^2))
     chain$matrix <- rb.matrix
     }
     temp <- chain$matrix
     rm(chain)
     chain <- list()
     chain$matrix <- list()
     chain$matrix[[1]] <- temp
     }
     }
     if (length(p) > 1) {
     cat("Plotting multiple regimes.", "\n")
     name.table <- rbind(names(chain$matrix)[p], colors)
     cat("Table with regimes and colors (names or HEX):\n")
     utils::write.table(format(name.table, justify = "right"),
     row.names = F, col.names = F, quote = F)
     check.mat <- vector()
     check.length <- vector()
     for (i in 1:length(p)) {
     check.mat[i] <- ncol(chain$matrix[[p[i]]][[1]])
     check.length[i] <- length(chain$matrix[[p[i]]])
     }
     equal.size <- sapply(2:length(p), function(x) check.mat[1] ==
     check.mat[x])
     equal.length <- sapply(2:length(p), function(x) check.length[1] ==
     check.length[x])
     if (!sum(equal.size) == (length(p) - 1))
     stop("Matrix regimes do not have the same number of traits.")
     if (!sum(equal.length) == (length(p) - 1))
     stop("Chain for regimes do not have the same length.")
     ll <- check.length[1]
     dd <- check.mat[1]
     if (class(chain) == "ratematrix_prior_sample") {
     for (i in p) {
     corr <- lapply(chain$matrix[[i]], decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[[i]][x, ]^2))
     chain$matrix[[i]] <- rb.matrix
     }
     }
     }
     if (hpd < 100) {
     frac <- (1 - (hpd/100))/2
     prob <- c(frac, 1 - frac)
     LL <- lapply(p, function(x) lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[x]],
     function(x) x[y, ])))))
     qq.list <- list()
     for (w in 1:length(LL)) {
     qq.list[[w]] <- list()
     qq.count <- 1
     for (i in 1:dd) {
     for (j in i:dd) {
     qq.list[[w]][[qq.count]] <- stats::quantile(x = LL[[w]][[i]][,
     j], probs = prob)
     qq.count <- qq.count + 1
     }
     }
     }
     if (ll < n.lines)
     stop(" n.lines is larger than number of matrices in the chain.")
     if (n.lines < 1)
     stop(" n.lines need to be > 1.")
     ss.list <- list()
     sampled.LL <- list()
     for (i in 1:length(p)) {
     count <- 1
     ss.list[[i]] <- vector()
     while (count < n.lines) {
     ss <- sample(1:ll, size = 1)
     if (ss %in% ss.list[[i]])
     next
     if (checkHPD(chain$matrix[[p[i]]][[ss]], qq.list[[i]],
     dd))
     next
     ss.list[[i]][count] <- ss
     count <- count + 1
     }
     sampled.LL[[i]] <- lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[p[i]]][ss.list[[i]]],
     function(x) x[y, ]))))
     }
     ell.data <- list()
     for (w in 1:length(p)) {
     ell.data.count <- 1
     ell.data[[w]] <- list()
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.data[[w]][[ell.data.count]] <- getEllipseMatrix(mat = chain$matrix[[p[w]]][ss.list[[w]]],
     traits = c(i, j), n.points = n.points)
     ell.data.count <- ell.data.count + 1
     }
     }
     }
     if (!is.null(point.matrix)) {
     if (!class(point.matrix) == "list")
     stop(" point.matrix need to be a list of matrices.")
     if (!length(point.matrix) == length(p))
     stop("Lenght of point.matrix need to be equal to the number of regimes fitted to the tree.")
     if (!class(point.matrix[[1]]) == "matrix")
     stop(" point.matrix need to be a list of matrices.")
     ell.point <- list()
     for (w in 1:length(p)) {
     ell.point[[w]] <- list()
     ell.point.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.point[[w]][[ell.point.count]] <- getEllipseMatrix(mat = point.matrix[[w]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.point.count <- ell.point.count + 1
     }
     }
     }
     }
     y.hist <- vector()
     x.hist <- vector()
     for (w in 1:length(p)) {
     for (i in 1:dd) {
     for (j in i:dd) {
     x.hist <- c(min(x.hist[1], LL[[w]][[i]][, j],
     na.rm = TRUE), max(x.hist[2], LL[[w]][[i]][,
     j], na.rm = TRUE))
     }
     }
     }
     if (is.null(set.xlim)) {
     wd <- (x.hist[2] - mean(x.hist))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- x.hist
     }
     else {
     wd <- (set.xlim[2] - mean(set.xlim))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- set.xlim
     }
     hists <- list()
     ccat <- list()
     for (w in 1:length(p)) {
     hists[[w]] <- list()
     ccat[[w]] <- list()
     hist.count <- 1
     for (i in 1:dd[1]) {
     for (j in i:dd[1]) {
     if (i == j) {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk.var)
     ccat[[w]][[hist.count]] <- cut(hists[[w]][[hist.count]]$breaks,
     c(-Inf, qq.list[[w]][[hist.count]][1],
     qq.list[[w]][[hist.count]][2], Inf))
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     else {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk)
     ccat[[w]][[hist.count]] <- cut(hists[[w]][[hist.count]]$breaks,
     c(-Inf, qq.list[[w]][[hist.count]][1],
     qq.list[[w]][[hist.count]][2], Inf))
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     }
     }
     }
     ylim.hist <- c(0, y.hist)
     ell.lim <- lapply(do.call(c, ell.data), function(x) x[[1]])
     ell.lim <- do.call(rbind, ell.lim)
     ell.lim <- apply(ell.lim, 2, range)
     ell.lim.iso <- c(min(ell.lim[1, ]), max(ell.lim[2, ]))
     old.par <- graphics::par(no.readonly = TRUE)
     graphics::par(mfrow = c(dd, dd))
     graphics::par(cex = 0.6)
     graphics::par(mar = c(0, 0, 0, 0), oma = c(2, 2, 2, 2))
     graphics::par(tcl = -0.25)
     graphics::par(mgp = c(2, 0.6, 0))
     colOff <- grDevices::adjustcolor(col = colors, alpha.f = alphaOff)
     colDiag <- grDevices::adjustcolor(col = colors, alpha.f = alphaDiag)
     colEll <- grDevices::adjustcolor(col = colors, alpha.f = alphaEll)
     if (is.null(point.color)) {
     point.color <- colors
     }
     ell.plot.count <- 1
     hist.plot.count <- 1
     for (i in 1:dd) {
     for (j in 1:dd) {
     if (j >= i) {
     graphics::plot(1, xlim = xlim.hist, ylim = ylim.hist,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     mid <- mean(xlim.hist)
     first.quart <- xlim.hist[1] + (mid - xlim.hist[1])/2
     second.quart <- mid + (xlim.hist[2] - mid)/2
     graphics::lines(x = c(mid, mid), y = ylim.hist,
     type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(first.quart, first.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(second.quart, second.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     if (show.zero == TRUE) {
     graphics::lines(x = c(0, 0), y = ylim.hist,
     type = "l", lty = 3, col = "blue")
     }
     graphics::box(col = "grey")
     if (j != i) {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, border = "gray",
     col = c("white", colOff[w], "white")[ccat[[w]][[hist.plot.count]]])
     }
     }
     else {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, border = "black",
     col = c("white", colDiag[w], "white")[ccat[[w]][[hist.plot.count]]])
     }
     if (i == dd[1]) {
     graphics::axis(1, at = round(c(xlim.hist[1],
     mean(xlim.hist), xlim.hist[2]), digits = 2))
     }
     }
     if (i == 1) {
     graphics::mtext(text = set.leg[j], side = 3,
     cex = l.cex)
     }
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     graphics::lines(x = c(point.matrix[[w]][i,
     j], point.matrix[[w]][i, j]), y = ylim.hist,
     type = "l", col = point.color[w], lwd = point.wd)
     }
     }
     hist.plot.count <- hist.plot.count + 1
     }
     else {
     graphics::plot(1, xlim = ell.lim.iso, ylim = ell.lim.iso,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     graphics::box(col = "grey")
     for (w in 1:length(p)) {
     invisible(lapply(ell.data[[w]][[ell.plot.count]][[2]],
     function(x) graphics::points(x, col = colEll[w],
     type = "l", lwd = ell.wd)))
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     invisible(graphics::points(ell.point[[w]][[ell.plot.count]],
     col = point.color[w], type = "l", lwd = point.wd))
     }
     }
     ell.plot.count <- ell.plot.count + 1
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     }
     }
     }
     graphics::par(old.par)
     }
     else {
     LL <- lapply(p, function(x) lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[x]],
     function(x) x[y, ])))))
     ell.data <- list()
     for (w in 1:length(p)) {
     ell.data[[w]] <- list()
     ell.data.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.data[[w]][[ell.data.count]] <- getEllipseMatrix(mat = chain$matrix[[p[w]]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.data.count <- ell.data.count + 1
     }
     }
     }
     if (!is.null(point.matrix)) {
     if (!class(point.matrix) == "list")
     stop(" point.matrix need to be a list of matrices.")
     if (!length(point.matrix) == length(p))
     stop("Lenght of point.matrix need to be equal to the number of regimes fitted to the tree.")
     if (!class(point.matrix[[1]]) == "matrix")
     stop(" point.matrix need to be a list of matrices.")
     ell.point <- list()
     for (w in 1:length(p)) {
     ell.point[[w]] <- list()
     ell.point.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.point[[w]][[ell.point.count]] <- getEllipseMatrix(mat = point.matrix[[w]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.point.count <- ell.point.count + 1
     }
     }
     }
     }
     y.hist <- vector()
     x.hist <- vector()
     for (w in 1:length(p)) {
     for (i in 1:dd) {
     for (j in i:dd) {
     x.hist <- c(min(x.hist[1], LL[[w]][[i]][, j],
     na.rm = TRUE), max(x.hist[2], LL[[w]][[i]][,
     j], na.rm = TRUE))
     }
     }
     }
     if (is.null(set.xlim)) {
     wd <- (x.hist[2] - mean(x.hist))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- x.hist
     }
     else {
     wd <- (set.xlim[2] - mean(set.xlim))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- set.xlim
     }
     hists <- list()
     for (w in 1:length(p)) {
     hists[[w]] <- list()
     hist.count <- 1
     for (i in 1:dd) {
     for (j in i:dd) {
     if (i == j) {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk.var)
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     else {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk)
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     }
     }
     }
     ylim.hist <- c(0, y.hist)
     ell.lim <- lapply(do.call(c, ell.data), function(x) x[[1]])
     ell.lim <- do.call(rbind, ell.lim)
     ell.lim <- apply(ell.lim, 2, range)
     ell.lim.iso <- c(min(ell.lim[1, ]), max(ell.lim[2, ]))
     old.par <- graphics::par(no.readonly = TRUE)
     graphics::par(mfrow = c(dd[1], dd[1]))
     graphics::par(cex = 0.6)
     graphics::par(mar = c(0, 0, 0, 0), oma = c(2, 2, 2, 2))
     graphics::par(tcl = -0.25)
     graphics::par(mgp = c(2, 0.6, 0))
     colOff <- grDevices::adjustcolor(col = colors, alpha.f = alphaOff)
     colDiag <- grDevices::adjustcolor(col = colors, alpha.f = alphaDiag)
     colEll <- grDevices::adjustcolor(col = colors, alpha.f = alphaEll)
     if (is.null(point.color)) {
     point.color <- colors
     }
     ell.plot.count <- 1
     hist.plot.count <- 1
     for (i in 1:dd) {
     for (j in 1:dd) {
     if (j >= i) {
     graphics::plot(1, xlim = xlim.hist, ylim = ylim.hist,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     mid <- mean(xlim.hist)
     first.quart <- xlim.hist[1] + (mid - xlim.hist[1])/2
     second.quart <- mid + (xlim.hist[2] - mid)/2
     graphics::lines(x = c(mid, mid), y = ylim.hist,
     type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(first.quart, first.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(second.quart, second.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     if (show.zero == TRUE) {
     graphics::lines(x = c(0, 0), y = ylim.hist,
     type = "l", lty = 3, col = "blue")
     }
     graphics::box(col = "grey")
     if (j != i) {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, col = colOff[w],
     border = "gray")
     }
     }
     else {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, col = colDiag[w],
     border = "black")
     }
     if (i == dd) {
     graphics::axis(1, at = round(c(xlim.hist[1],
     mean(xlim.hist), xlim.hist[2]), digits = 2))
     }
     }
     if (i == 1) {
     graphics::mtext(text = set.leg[j], side = 3,
     cex = l.cex)
     }
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     graphics::lines(x = c(point.matrix[[w]][i,
     j], point.matrix[[w]][i, j]), y = ylim.hist,
     type = "l", col = point.color[w], lwd = point.wd)
     }
     }
     hist.plot.count <- hist.plot.count + 1
     }
     else {
     graphics::plot(1, xlim = ell.lim.iso, ylim = ell.lim.iso,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     graphics::box(col = "grey")
     for (w in 1:length(p)) {
     invisible(lapply(ell.data[[w]][[ell.plot.count]][[2]],
     function(x) graphics::points(x, col = colEll[w],
     type = "l", lwd = ell.wd)))
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     invisible(graphics::points(ell.point[[w]][[ell.plot.count]],
     col = point.color[w], type = "l", lwd = point.wd))
     }
     }
     ell.plot.count <- ell.plot.count + 1
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     }
     }
     }
     graphics::par(old.par)
     }
    }
    <bytecode: 0x558926646980>
    <environment: namespace:ratematrix>
     --- function search by body ---
    Function plotRatematrix in namespace ratematrix has this body.
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 186-188 (Making_prior_on_ratematrix.Rmd)
    Error: processing vignette 'Making_prior_on_ratematrix.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building ‘Making_prior_on_ratematrix.Rmd’
    
    --- re-building ‘Set_custom_starting_point.Rmd’ using knitr
    --- finished re-building ‘Set_custom_starting_point.Rmd’
    
    SUMMARY: processing the following file failed:
     ‘Making_prior_on_ratematrix.Rmd’
    
    Error: Vignette re-building failed.
    Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc

Version: 1.2.1
Check: installed package size
Result: NOTE
     installed size is 6.0Mb
     sub-directories of 1Mb or more:
     libs 4.3Mb
Flavors: r-devel-linux-x86_64-fedora-clang, r-release-osx-x86_64, r-oldrel-osx-x86_64

Version: 1.2.1
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
    --- re-building ‘Intro_on_the_package.Rmd’ using knitr
    --- finished re-building ‘Intro_on_the_package.Rmd’
    
    --- re-building ‘Making_prior_on_ratematrix.Rmd’ using knitr
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    ratematrix
     --- call from context ---
    plotRatematrix(chain = post.unif.root, set.leg = c("trait_1",
     "trait_2"), point.matrix = list(R), point.color = "red",
     point.wd = 1.5)
     --- call from argument ---
    if (!class(point.matrix[[1]]) == "matrix") stop(" point.matrix need to be a list of matrices.")
     --- R stacktrace ---
    where 1: plotRatematrix(chain = post.unif.root, set.leg = c("trait_1",
     "trait_2"), point.matrix = list(R), point.color = "red",
     point.wd = 1.5)
    where 2: eval(expr, envir, enclos)
    where 3: eval(expr, envir, enclos)
    where 4: withVisible(eval(expr, envir, enclos))
    where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
     debug = debug, last = i == length(out), use_try = stop_on_error !=
     2L, keep_warning = keep_warning, keep_message = keep_message,
     output_handler = output_handler, include_timing = include_timing)
    where 9: evaluate::evaluate(...)
    where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
     keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
     options$include) 0L else 2L, output_handler = knit_handlers(options$render,
     options))
    where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
     keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
     stop_on_error = if (options$error && options$include) 0L else 2L,
     output_handler = knit_handlers(options$render, options)))
    where 12: block_exec(params)
    where 13: call_block(x)
    where 14: process_group.block(group)
    where 15: process_group(group)
    where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
     error = function(e) {
     setwd(wd)
     cat(res, sep = "\n", file = output %n% "")
     message("Quitting from lines ", paste(current_lines(i),
     collapse = "-"), " (", knit_concord$get("infile"),
     ") ")
     })
    where 17: process_file(text, output)
    where 18: knit(input, text = text, envir = envir, quiet = quiet)
    where 19: knit2html(..., force_v1 = TRUE)
    where 20: (if (grepl("\\.[Rr]md$", file)) knit2html_v1 else if (grepl("\\.[Rr]rst$",
     file)) knit2pandoc else knit)(file, encoding = encoding,
     quiet = quiet, envir = globalenv(), ...)
    where 21: engine$weave(file, quiet = quiet, encoding = enc)
    where 22: doTryCatch(return(expr), name, parentenv, handler)
    where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 24: tryCatchList(expr, classes, parentenv, handlers)
    where 25: tryCatch({
     engine$weave(file, quiet = quiet, encoding = enc)
     setwd(startdir)
     output <- find_vignette_product(name, by = "weave", engine = engine)
     if (!have.makefile && vignette_is_tex(output)) {
     texi2pdf(file = output, clean = FALSE, quiet = quiet)
     output <- find_vignette_product(name, by = "texi2pdf",
     engine = engine)
     }
    }, error = function(e) {
     OK <<- FALSE
     message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
     file, conditionMessage(e)))
    })
    where 26: tools:::.buildOneVignette("Making_prior_on_ratematrix.Rmd", "/data/gannet/ripley/R/packages/tests-clang/ratematrix.Rcheck/vign_test/ratematrix",
     TRUE, FALSE, "Making_prior_on_ratematrix", "UTF-8", "/tmp/RtmpfjbL84/working_dir/RtmpBRxxLI/file2fe75ca68d35.rds")
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (chain, p = NULL, colors = NULL, set.xlim = NULL, set.leg = NULL,
     l.cex = 0.7, ell.wd = 0.5, alphaOff = 1, alphaDiag = 1, alphaEll = 1,
     hpd = 100, show.zero = FALSE, n.lines = 50, n.points = 200,
     point.matrix = NULL, point.color = NULL, point.wd = 0.5)
    {
     ll_class <- length(class(chain))
     if (ll_class == 1) {
     correct_class <- grepl(pattern = "ratematrix", x = class(chain))
     }
     else {
     correct_class <- any(sapply(class(chain), function(x) grepl(pattern = "ratematrix",
     x = x)))
     }
     if (!correct_class)
     stop("chain argument need to be a single MCMC chain. See 'mergePosterior' function to merge multiple MCMC chains together.")
     if (is.null(chain$n_post_samples)) {
     if (n.lines > nrow(chain[[1]])) {
     n.lines <- nrow(chain[[1]])
     }
     }
     else {
     if (n.lines > chain$n_post_samples) {
     n.lines <- chain$n_post_samples
     }
     }
     if (is.null(p)) {
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[1]][[1]])) {
     np <- length(chain$matrix)
     p <- 1:np
     }
     else {
     p <- 1
     }
     }
     if (is.null(colors)) {
     np <- length(p)
     if (np > 9)
     stop("Unable to generate colors for more than 9 regimes. Please define color vector using 'colors' argument.")
     if (np == 1) {
     colors <- "black"
     }
     else {
     check <- c(np < 4, 3 < np && np < 6, np > 5)
     cols <- list(c("#002244", "#69BE28", "#A5ACAF"),
     c("#7fc97f", "#beaed4", "#fdc086", "#386cb0",
     "#ffff99"), c("#bc80bd", "#d9d9d9", "#fccde5",
     "#b3de69", "#fdb462", "#b3de69", "#fccde5",
     "#d9d9d9", "#bc80bd"))
     colors <- unlist(cols[check])[1:np]
     }
     }
     if (is.null(set.leg)) {
     if (is.null(chain$trait_names)) {
     set.leg <- colnames(chain$root)
     }
     else {
     set.leg <- chain$trait_names
     }
     }
     if (length(p) == 1) {
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[p]][[1]])) {
     cat("Plotting a single regime.", "\n")
     dd <- ncol(chain$matrix[[p]][[1]])
     ll <- length(chain$matrix[[p]])
     if (class(chain) == "ratematrix_prior_sample") {
     corr <- lapply(chain$matrix[[p]], decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[[p]][x, ]^2))
     chain$matrix[[p]] <- rb.matrix
     }
     }
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[1]])) {
     if (!p == 1)
     stop("There is only one regime in the chain, then p need to be equal to 1.")
     cat("Plotting a single regime.", "\n")
     dd <- ncol(chain$matrix[[1]])
     ll <- length(chain$matrix)
     if (class(chain) == "ratematrix_prior_sample") {
     corr <- lapply(chain$matrix, decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[x, ]^2))
     chain$matrix <- rb.matrix
     }
     temp <- chain$matrix
     rm(chain)
     chain <- list()
     chain$matrix <- list()
     chain$matrix[[1]] <- temp
     }
     }
     if (length(p) > 1) {
     cat("Plotting multiple regimes.", "\n")
     name.table <- rbind(names(chain$matrix)[p], colors)
     cat("Table with regimes and colors (names or HEX):\n")
     utils::write.table(format(name.table, justify = "right"),
     row.names = F, col.names = F, quote = F)
     check.mat <- vector()
     check.length <- vector()
     for (i in 1:length(p)) {
     check.mat[i] <- ncol(chain$matrix[[p[i]]][[1]])
     check.length[i] <- length(chain$matrix[[p[i]]])
     }
     equal.size <- sapply(2:length(p), function(x) check.mat[1] ==
     check.mat[x])
     equal.length <- sapply(2:length(p), function(x) check.length[1] ==
     check.length[x])
     if (!sum(equal.size) == (length(p) - 1))
     stop("Matrix regimes do not have the same number of traits.")
     if (!sum(equal.length) == (length(p) - 1))
     stop("Chain for regimes do not have the same length.")
     ll <- check.length[1]
     dd <- check.mat[1]
     if (class(chain) == "ratematrix_prior_sample") {
     for (i in p) {
     corr <- lapply(chain$matrix[[i]], decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[[i]][x, ]^2))
     chain$matrix[[i]] <- rb.matrix
     }
     }
     }
     if (hpd < 100) {
     frac <- (1 - (hpd/100))/2
     prob <- c(frac, 1 - frac)
     LL <- lapply(p, function(x) lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[x]],
     function(x) x[y, ])))))
     qq.list <- list()
     for (w in 1:length(LL)) {
     qq.list[[w]] <- list()
     qq.count <- 1
     for (i in 1:dd) {
     for (j in i:dd) {
     qq.list[[w]][[qq.count]] <- stats::quantile(x = LL[[w]][[i]][,
     j], probs = prob)
     qq.count <- qq.count + 1
     }
     }
     }
     if (ll < n.lines)
     stop(" n.lines is larger than number of matrices in the chain.")
     if (n.lines < 1)
     stop(" n.lines need to be > 1.")
     ss.list <- list()
     sampled.LL <- list()
     for (i in 1:length(p)) {
     count <- 1
     ss.list[[i]] <- vector()
     while (count < n.lines) {
     ss <- sample(1:ll, size = 1)
     if (ss %in% ss.list[[i]])
     next
     if (checkHPD(chain$matrix[[p[i]]][[ss]], qq.list[[i]],
     dd))
     next
     ss.list[[i]][count] <- ss
     count <- count + 1
     }
     sampled.LL[[i]] <- lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[p[i]]][ss.list[[i]]],
     function(x) x[y, ]))))
     }
     ell.data <- list()
     for (w in 1:length(p)) {
     ell.data.count <- 1
     ell.data[[w]] <- list()
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.data[[w]][[ell.data.count]] <- getEllipseMatrix(mat = chain$matrix[[p[w]]][ss.list[[w]]],
     traits = c(i, j), n.points = n.points)
     ell.data.count <- ell.data.count + 1
     }
     }
     }
     if (!is.null(point.matrix)) {
     if (!class(point.matrix) == "list")
     stop(" point.matrix need to be a list of matrices.")
     if (!length(point.matrix) == length(p))
     stop("Lenght of point.matrix need to be equal to the number of regimes fitted to the tree.")
     if (!class(point.matrix[[1]]) == "matrix")
     stop(" point.matrix need to be a list of matrices.")
     ell.point <- list()
     for (w in 1:length(p)) {
     ell.point[[w]] <- list()
     ell.point.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.point[[w]][[ell.point.count]] <- getEllipseMatrix(mat = point.matrix[[w]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.point.count <- ell.point.count + 1
     }
     }
     }
     }
     y.hist <- vector()
     x.hist <- vector()
     for (w in 1:length(p)) {
     for (i in 1:dd) {
     for (j in i:dd) {
     x.hist <- c(min(x.hist[1], LL[[w]][[i]][, j],
     na.rm = TRUE), max(x.hist[2], LL[[w]][[i]][,
     j], na.rm = TRUE))
     }
     }
     }
     if (is.null(set.xlim)) {
     wd <- (x.hist[2] - mean(x.hist))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- x.hist
     }
     else {
     wd <- (set.xlim[2] - mean(set.xlim))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- set.xlim
     }
     hists <- list()
     ccat <- list()
     for (w in 1:length(p)) {
     hists[[w]] <- list()
     ccat[[w]] <- list()
     hist.count <- 1
     for (i in 1:dd[1]) {
     for (j in i:dd[1]) {
     if (i == j) {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk.var)
     ccat[[w]][[hist.count]] <- cut(hists[[w]][[hist.count]]$breaks,
     c(-Inf, qq.list[[w]][[hist.count]][1],
     qq.list[[w]][[hist.count]][2], Inf))
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     else {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk)
     ccat[[w]][[hist.count]] <- cut(hists[[w]][[hist.count]]$breaks,
     c(-Inf, qq.list[[w]][[hist.count]][1],
     qq.list[[w]][[hist.count]][2], Inf))
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     }
     }
     }
     ylim.hist <- c(0, y.hist)
     ell.lim <- lapply(do.call(c, ell.data), function(x) x[[1]])
     ell.lim <- do.call(rbind, ell.lim)
     ell.lim <- apply(ell.lim, 2, range)
     ell.lim.iso <- c(min(ell.lim[1, ]), max(ell.lim[2, ]))
     old.par <- graphics::par(no.readonly = TRUE)
     graphics::par(mfrow = c(dd, dd))
     graphics::par(cex = 0.6)
     graphics::par(mar = c(0, 0, 0, 0), oma = c(2, 2, 2, 2))
     graphics::par(tcl = -0.25)
     graphics::par(mgp = c(2, 0.6, 0))
     colOff <- grDevices::adjustcolor(col = colors, alpha.f = alphaOff)
     colDiag <- grDevices::adjustcolor(col = colors, alpha.f = alphaDiag)
     colEll <- grDevices::adjustcolor(col = colors, alpha.f = alphaEll)
     if (is.null(point.color)) {
     point.color <- colors
     }
     ell.plot.count <- 1
     hist.plot.count <- 1
     for (i in 1:dd) {
     for (j in 1:dd) {
     if (j >= i) {
     graphics::plot(1, xlim = xlim.hist, ylim = ylim.hist,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     mid <- mean(xlim.hist)
     first.quart <- xlim.hist[1] + (mid - xlim.hist[1])/2
     second.quart <- mid + (xlim.hist[2] - mid)/2
     graphics::lines(x = c(mid, mid), y = ylim.hist,
     type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(first.quart, first.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(second.quart, second.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     if (show.zero == TRUE) {
     graphics::lines(x = c(0, 0), y = ylim.hist,
     type = "l", lty = 3, col = "blue")
     }
     graphics::box(col = "grey")
     if (j != i) {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, border = "gray",
     col = c("white", colOff[w], "white")[ccat[[w]][[hist.plot.count]]])
     }
     }
     else {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, border = "black",
     col = c("white", colDiag[w], "white")[ccat[[w]][[hist.plot.count]]])
     }
     if (i == dd[1]) {
     graphics::axis(1, at = round(c(xlim.hist[1],
     mean(xlim.hist), xlim.hist[2]), digits = 2))
     }
     }
     if (i == 1) {
     graphics::mtext(text = set.leg[j], side = 3,
     cex = l.cex)
     }
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     graphics::lines(x = c(point.matrix[[w]][i,
     j], point.matrix[[w]][i, j]), y = ylim.hist,
     type = "l", col = point.color[w], lwd = point.wd)
     }
     }
     hist.plot.count <- hist.plot.count + 1
     }
     else {
     graphics::plot(1, xlim = ell.lim.iso, ylim = ell.lim.iso,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     graphics::box(col = "grey")
     for (w in 1:length(p)) {
     invisible(lapply(ell.data[[w]][[ell.plot.count]][[2]],
     function(x) graphics::points(x, col = colEll[w],
     type = "l", lwd = ell.wd)))
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     invisible(graphics::points(ell.point[[w]][[ell.plot.count]],
     col = point.color[w], type = "l", lwd = point.wd))
     }
     }
     ell.plot.count <- ell.plot.count + 1
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     }
     }
     }
     graphics::par(old.par)
     }
     else {
     LL <- lapply(p, function(x) lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[x]],
     function(x) x[y, ])))))
     ell.data <- list()
     for (w in 1:length(p)) {
     ell.data[[w]] <- list()
     ell.data.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.data[[w]][[ell.data.count]] <- getEllipseMatrix(mat = chain$matrix[[p[w]]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.data.count <- ell.data.count + 1
     }
     }
     }
     if (!is.null(point.matrix)) {
     if (!class(point.matrix) == "list")
     stop(" point.matrix need to be a list of matrices.")
     if (!length(point.matrix) == length(p))
     stop("Lenght of point.matrix need to be equal to the number of regimes fitted to the tree.")
     if (!class(point.matrix[[1]]) == "matrix")
     stop(" point.matrix need to be a list of matrices.")
     ell.point <- list()
     for (w in 1:length(p)) {
     ell.point[[w]] <- list()
     ell.point.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.point[[w]][[ell.point.count]] <- getEllipseMatrix(mat = point.matrix[[w]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.point.count <- ell.point.count + 1
     }
     }
     }
     }
     y.hist <- vector()
     x.hist <- vector()
     for (w in 1:length(p)) {
     for (i in 1:dd) {
     for (j in i:dd) {
     x.hist <- c(min(x.hist[1], LL[[w]][[i]][, j],
     na.rm = TRUE), max(x.hist[2], LL[[w]][[i]][,
     j], na.rm = TRUE))
     }
     }
     }
     if (is.null(set.xlim)) {
     wd <- (x.hist[2] - mean(x.hist))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- x.hist
     }
     else {
     wd <- (set.xlim[2] - mean(set.xlim))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- set.xlim
     }
     hists <- list()
     for (w in 1:length(p)) {
     hists[[w]] <- list()
     hist.count <- 1
     for (i in 1:dd) {
     for (j in i:dd) {
     if (i == j) {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk.var)
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     else {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk)
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     }
     }
     }
     ylim.hist <- c(0, y.hist)
     ell.lim <- lapply(do.call(c, ell.data), function(x) x[[1]])
     ell.lim <- do.call(rbind, ell.lim)
     ell.lim <- apply(ell.lim, 2, range)
     ell.lim.iso <- c(min(ell.lim[1, ]), max(ell.lim[2, ]))
     old.par <- graphics::par(no.readonly = TRUE)
     graphics::par(mfrow = c(dd[1], dd[1]))
     graphics::par(cex = 0.6)
     graphics::par(mar = c(0, 0, 0, 0), oma = c(2, 2, 2, 2))
     graphics::par(tcl = -0.25)
     graphics::par(mgp = c(2, 0.6, 0))
     colOff <- grDevices::adjustcolor(col = colors, alpha.f = alphaOff)
     colDiag <- grDevices::adjustcolor(col = colors, alpha.f = alphaDiag)
     colEll <- grDevices::adjustcolor(col = colors, alpha.f = alphaEll)
     if (is.null(point.color)) {
     point.color <- colors
     }
     ell.plot.count <- 1
     hist.plot.count <- 1
     for (i in 1:dd) {
     for (j in 1:dd) {
     if (j >= i) {
     graphics::plot(1, xlim = xlim.hist, ylim = ylim.hist,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     mid <- mean(xlim.hist)
     first.quart <- xlim.hist[1] + (mid - xlim.hist[1])/2
     second.quart <- mid + (xlim.hist[2] - mid)/2
     graphics::lines(x = c(mid, mid), y = ylim.hist,
     type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(first.quart, first.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(second.quart, second.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     if (show.zero == TRUE) {
     graphics::lines(x = c(0, 0), y = ylim.hist,
     type = "l", lty = 3, col = "blue")
     }
     graphics::box(col = "grey")
     if (j != i) {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, col = colOff[w],
     border = "gray")
     }
     }
     else {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, col = colDiag[w],
     border = "black")
     }
     if (i == dd) {
     graphics::axis(1, at = round(c(xlim.hist[1],
     mean(xlim.hist), xlim.hist[2]), digits = 2))
     }
     }
     if (i == 1) {
     graphics::mtext(text = set.leg[j], side = 3,
     cex = l.cex)
     }
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     graphics::lines(x = c(point.matrix[[w]][i,
     j], point.matrix[[w]][i, j]), y = ylim.hist,
     type = "l", col = point.color[w], lwd = point.wd)
     }
     }
     hist.plot.count <- hist.plot.count + 1
     }
     else {
     graphics::plot(1, xlim = ell.lim.iso, ylim = ell.lim.iso,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     graphics::box(col = "grey")
     for (w in 1:length(p)) {
     invisible(lapply(ell.data[[w]][[ell.plot.count]][[2]],
     function(x) graphics::points(x, col = colEll[w],
     type = "l", lwd = ell.wd)))
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     invisible(graphics::points(ell.point[[w]][[ell.plot.count]],
     col = point.color[w], type = "l", lwd = point.wd))
     }
     }
     ell.plot.count <- ell.plot.count + 1
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     }
     }
     }
     graphics::par(old.par)
     }
    }
    <bytecode: 0xfa14700>
    <environment: namespace:ratematrix>
     --- function search by body ---
    Function plotRatematrix in namespace ratematrix has this body.
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 186-188 (Making_prior_on_ratematrix.Rmd)
    Error: processing vignette 'Making_prior_on_ratematrix.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building ‘Making_prior_on_ratematrix.Rmd’
    
    --- re-building ‘Set_custom_starting_point.Rmd’ using knitr
    --- finished re-building ‘Set_custom_starting_point.Rmd’
    
    SUMMARY: processing the following file failed:
     ‘Making_prior_on_ratematrix.Rmd’
    
    Error: Vignette re-building failed.
    Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang

Version: 1.2.1
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
    --- re-building ‘Intro_on_the_package.Rmd’ using knitr
    --- finished re-building ‘Intro_on_the_package.Rmd’
    
    --- re-building ‘Making_prior_on_ratematrix.Rmd’ using knitr
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    ratematrix
     --- call from context ---
    plotRatematrix(chain = post.unif.root, set.leg = c("trait_1",
     "trait_2"), point.matrix = list(R), point.color = "red",
     point.wd = 1.5)
     --- call from argument ---
    if (!class(point.matrix[[1]]) == "matrix") stop(" point.matrix need to be a list of matrices.")
     --- R stacktrace ---
    where 1: plotRatematrix(chain = post.unif.root, set.leg = c("trait_1",
     "trait_2"), point.matrix = list(R), point.color = "red",
     point.wd = 1.5)
    where 2: eval(expr, envir, enclos)
    where 3: eval(expr, envir, enclos)
    where 4: withVisible(eval(expr, envir, enclos))
    where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
     debug = debug, last = i == length(out), use_try = stop_on_error !=
     2L, keep_warning = keep_warning, keep_message = keep_message,
     output_handler = output_handler, include_timing = include_timing)
    where 9: evaluate::evaluate(...)
    where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
     keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
     options$include) 0L else 2L, output_handler = knit_handlers(options$render,
     options))
    where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
     keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
     stop_on_error = if (options$error && options$include) 0L else 2L,
     output_handler = knit_handlers(options$render, options)))
    where 12: block_exec(params)
    where 13: call_block(x)
    where 14: process_group.block(group)
    where 15: process_group(group)
    where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
     error = function(e) {
     setwd(wd)
     cat(res, sep = "\n", file = output %n% "")
     message("Quitting from lines ", paste(current_lines(i),
     collapse = "-"), " (", knit_concord$get("infile"),
     ") ")
     })
    where 17: process_file(text, output)
    where 18: knit(input, text = text, envir = envir, quiet = quiet)
    where 19: knit2html(..., force_v1 = TRUE)
    where 20: (if (grepl("\\.[Rr]md$", file)) knit2html_v1 else if (grepl("\\.[Rr]rst$",
     file)) knit2pandoc else knit)(file, encoding = encoding,
     quiet = quiet, envir = globalenv(), ...)
    where 21: engine$weave(file, quiet = quiet, encoding = enc)
    where 22: doTryCatch(return(expr), name, parentenv, handler)
    where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 24: tryCatchList(expr, classes, parentenv, handlers)
    where 25: tryCatch({
     engine$weave(file, quiet = quiet, encoding = enc)
     setwd(startdir)
     output <- find_vignette_product(name, by = "weave", engine = engine)
     if (!have.makefile && vignette_is_tex(output)) {
     texi2pdf(file = output, clean = FALSE, quiet = quiet)
     output <- find_vignette_product(name, by = "texi2pdf",
     engine = engine)
     }
    }, error = function(e) {
     OK <<- FALSE
     message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
     file, conditionMessage(e)))
    })
    where 26: tools:::.buildOneVignette("Making_prior_on_ratematrix.Rmd", "/data/gannet/ripley/R/packages/tests-devel/ratematrix.Rcheck/vign_test/ratematrix",
     TRUE, FALSE, "Making_prior_on_ratematrix", "UTF-8", "/tmp/RtmpyooDNg/working_dir/Rtmp8n9Edj/file23e6b226802.rds")
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (chain, p = NULL, colors = NULL, set.xlim = NULL, set.leg = NULL,
     l.cex = 0.7, ell.wd = 0.5, alphaOff = 1, alphaDiag = 1, alphaEll = 1,
     hpd = 100, show.zero = FALSE, n.lines = 50, n.points = 200,
     point.matrix = NULL, point.color = NULL, point.wd = 0.5)
    {
     ll_class <- length(class(chain))
     if (ll_class == 1) {
     correct_class <- grepl(pattern = "ratematrix", x = class(chain))
     }
     else {
     correct_class <- any(sapply(class(chain), function(x) grepl(pattern = "ratematrix",
     x = x)))
     }
     if (!correct_class)
     stop("chain argument need to be a single MCMC chain. See 'mergePosterior' function to merge multiple MCMC chains together.")
     if (is.null(chain$n_post_samples)) {
     if (n.lines > nrow(chain[[1]])) {
     n.lines <- nrow(chain[[1]])
     }
     }
     else {
     if (n.lines > chain$n_post_samples) {
     n.lines <- chain$n_post_samples
     }
     }
     if (is.null(p)) {
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[1]][[1]])) {
     np <- length(chain$matrix)
     p <- 1:np
     }
     else {
     p <- 1
     }
     }
     if (is.null(colors)) {
     np <- length(p)
     if (np > 9)
     stop("Unable to generate colors for more than 9 regimes. Please define color vector using 'colors' argument.")
     if (np == 1) {
     colors <- "black"
     }
     else {
     check <- c(np < 4, 3 < np && np < 6, np > 5)
     cols <- list(c("#002244", "#69BE28", "#A5ACAF"),
     c("#7fc97f", "#beaed4", "#fdc086", "#386cb0",
     "#ffff99"), c("#bc80bd", "#d9d9d9", "#fccde5",
     "#b3de69", "#fdb462", "#b3de69", "#fccde5",
     "#d9d9d9", "#bc80bd"))
     colors <- unlist(cols[check])[1:np]
     }
     }
     if (is.null(set.leg)) {
     if (is.null(chain$trait_names)) {
     set.leg <- colnames(chain$root)
     }
     else {
     set.leg <- chain$trait_names
     }
     }
     if (length(p) == 1) {
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[p]][[1]])) {
     cat("Plotting a single regime.", "\n")
     dd <- ncol(chain$matrix[[p]][[1]])
     ll <- length(chain$matrix[[p]])
     if (class(chain) == "ratematrix_prior_sample") {
     corr <- lapply(chain$matrix[[p]], decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[[p]][x, ]^2))
     chain$matrix[[p]] <- rb.matrix
     }
     }
     if (is.list(chain$matrix) & is.matrix(chain$matrix[[1]])) {
     if (!p == 1)
     stop("There is only one regime in the chain, then p need to be equal to 1.")
     cat("Plotting a single regime.", "\n")
     dd <- ncol(chain$matrix[[1]])
     ll <- length(chain$matrix)
     if (class(chain) == "ratematrix_prior_sample") {
     corr <- lapply(chain$matrix, decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[x, ]^2))
     chain$matrix <- rb.matrix
     }
     temp <- chain$matrix
     rm(chain)
     chain <- list()
     chain$matrix <- list()
     chain$matrix[[1]] <- temp
     }
     }
     if (length(p) > 1) {
     cat("Plotting multiple regimes.", "\n")
     name.table <- rbind(names(chain$matrix)[p], colors)
     cat("Table with regimes and colors (names or HEX):\n")
     utils::write.table(format(name.table, justify = "right"),
     row.names = F, col.names = F, quote = F)
     check.mat <- vector()
     check.length <- vector()
     for (i in 1:length(p)) {
     check.mat[i] <- ncol(chain$matrix[[p[i]]][[1]])
     check.length[i] <- length(chain$matrix[[p[i]]])
     }
     equal.size <- sapply(2:length(p), function(x) check.mat[1] ==
     check.mat[x])
     equal.length <- sapply(2:length(p), function(x) check.length[1] ==
     check.length[x])
     if (!sum(equal.size) == (length(p) - 1))
     stop("Matrix regimes do not have the same number of traits.")
     if (!sum(equal.length) == (length(p) - 1))
     stop("Chain for regimes do not have the same length.")
     ll <- check.length[1]
     dd <- check.mat[1]
     if (class(chain) == "ratematrix_prior_sample") {
     for (i in p) {
     corr <- lapply(chain$matrix[[i]], decompose.cov)
     rb.matrix <- lapply(1:ll, function(x) rebuild.cov(r = corr[[x]]$r,
     v = chain$sd[[i]][x, ]^2))
     chain$matrix[[i]] <- rb.matrix
     }
     }
     }
     if (hpd < 100) {
     frac <- (1 - (hpd/100))/2
     prob <- c(frac, 1 - frac)
     LL <- lapply(p, function(x) lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[x]],
     function(x) x[y, ])))))
     qq.list <- list()
     for (w in 1:length(LL)) {
     qq.list[[w]] <- list()
     qq.count <- 1
     for (i in 1:dd) {
     for (j in i:dd) {
     qq.list[[w]][[qq.count]] <- stats::quantile(x = LL[[w]][[i]][,
     j], probs = prob)
     qq.count <- qq.count + 1
     }
     }
     }
     if (ll < n.lines)
     stop(" n.lines is larger than number of matrices in the chain.")
     if (n.lines < 1)
     stop(" n.lines need to be > 1.")
     ss.list <- list()
     sampled.LL <- list()
     for (i in 1:length(p)) {
     count <- 1
     ss.list[[i]] <- vector()
     while (count < n.lines) {
     ss <- sample(1:ll, size = 1)
     if (ss %in% ss.list[[i]])
     next
     if (checkHPD(chain$matrix[[p[i]]][[ss]], qq.list[[i]],
     dd))
     next
     ss.list[[i]][count] <- ss
     count <- count + 1
     }
     sampled.LL[[i]] <- lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[p[i]]][ss.list[[i]]],
     function(x) x[y, ]))))
     }
     ell.data <- list()
     for (w in 1:length(p)) {
     ell.data.count <- 1
     ell.data[[w]] <- list()
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.data[[w]][[ell.data.count]] <- getEllipseMatrix(mat = chain$matrix[[p[w]]][ss.list[[w]]],
     traits = c(i, j), n.points = n.points)
     ell.data.count <- ell.data.count + 1
     }
     }
     }
     if (!is.null(point.matrix)) {
     if (!class(point.matrix) == "list")
     stop(" point.matrix need to be a list of matrices.")
     if (!length(point.matrix) == length(p))
     stop("Lenght of point.matrix need to be equal to the number of regimes fitted to the tree.")
     if (!class(point.matrix[[1]]) == "matrix")
     stop(" point.matrix need to be a list of matrices.")
     ell.point <- list()
     for (w in 1:length(p)) {
     ell.point[[w]] <- list()
     ell.point.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.point[[w]][[ell.point.count]] <- getEllipseMatrix(mat = point.matrix[[w]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.point.count <- ell.point.count + 1
     }
     }
     }
     }
     y.hist <- vector()
     x.hist <- vector()
     for (w in 1:length(p)) {
     for (i in 1:dd) {
     for (j in i:dd) {
     x.hist <- c(min(x.hist[1], LL[[w]][[i]][, j],
     na.rm = TRUE), max(x.hist[2], LL[[w]][[i]][,
     j], na.rm = TRUE))
     }
     }
     }
     if (is.null(set.xlim)) {
     wd <- (x.hist[2] - mean(x.hist))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- x.hist
     }
     else {
     wd <- (set.xlim[2] - mean(set.xlim))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- set.xlim
     }
     hists <- list()
     ccat <- list()
     for (w in 1:length(p)) {
     hists[[w]] <- list()
     ccat[[w]] <- list()
     hist.count <- 1
     for (i in 1:dd[1]) {
     for (j in i:dd[1]) {
     if (i == j) {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk.var)
     ccat[[w]][[hist.count]] <- cut(hists[[w]][[hist.count]]$breaks,
     c(-Inf, qq.list[[w]][[hist.count]][1],
     qq.list[[w]][[hist.count]][2], Inf))
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     else {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk)
     ccat[[w]][[hist.count]] <- cut(hists[[w]][[hist.count]]$breaks,
     c(-Inf, qq.list[[w]][[hist.count]][1],
     qq.list[[w]][[hist.count]][2], Inf))
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     }
     }
     }
     ylim.hist <- c(0, y.hist)
     ell.lim <- lapply(do.call(c, ell.data), function(x) x[[1]])
     ell.lim <- do.call(rbind, ell.lim)
     ell.lim <- apply(ell.lim, 2, range)
     ell.lim.iso <- c(min(ell.lim[1, ]), max(ell.lim[2, ]))
     old.par <- graphics::par(no.readonly = TRUE)
     graphics::par(mfrow = c(dd, dd))
     graphics::par(cex = 0.6)
     graphics::par(mar = c(0, 0, 0, 0), oma = c(2, 2, 2, 2))
     graphics::par(tcl = -0.25)
     graphics::par(mgp = c(2, 0.6, 0))
     colOff <- grDevices::adjustcolor(col = colors, alpha.f = alphaOff)
     colDiag <- grDevices::adjustcolor(col = colors, alpha.f = alphaDiag)
     colEll <- grDevices::adjustcolor(col = colors, alpha.f = alphaEll)
     if (is.null(point.color)) {
     point.color <- colors
     }
     ell.plot.count <- 1
     hist.plot.count <- 1
     for (i in 1:dd) {
     for (j in 1:dd) {
     if (j >= i) {
     graphics::plot(1, xlim = xlim.hist, ylim = ylim.hist,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     mid <- mean(xlim.hist)
     first.quart <- xlim.hist[1] + (mid - xlim.hist[1])/2
     second.quart <- mid + (xlim.hist[2] - mid)/2
     graphics::lines(x = c(mid, mid), y = ylim.hist,
     type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(first.quart, first.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(second.quart, second.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     if (show.zero == TRUE) {
     graphics::lines(x = c(0, 0), y = ylim.hist,
     type = "l", lty = 3, col = "blue")
     }
     graphics::box(col = "grey")
     if (j != i) {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, border = "gray",
     col = c("white", colOff[w], "white")[ccat[[w]][[hist.plot.count]]])
     }
     }
     else {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, border = "black",
     col = c("white", colDiag[w], "white")[ccat[[w]][[hist.plot.count]]])
     }
     if (i == dd[1]) {
     graphics::axis(1, at = round(c(xlim.hist[1],
     mean(xlim.hist), xlim.hist[2]), digits = 2))
     }
     }
     if (i == 1) {
     graphics::mtext(text = set.leg[j], side = 3,
     cex = l.cex)
     }
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     graphics::lines(x = c(point.matrix[[w]][i,
     j], point.matrix[[w]][i, j]), y = ylim.hist,
     type = "l", col = point.color[w], lwd = point.wd)
     }
     }
     hist.plot.count <- hist.plot.count + 1
     }
     else {
     graphics::plot(1, xlim = ell.lim.iso, ylim = ell.lim.iso,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     graphics::box(col = "grey")
     for (w in 1:length(p)) {
     invisible(lapply(ell.data[[w]][[ell.plot.count]][[2]],
     function(x) graphics::points(x, col = colEll[w],
     type = "l", lwd = ell.wd)))
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     invisible(graphics::points(ell.point[[w]][[ell.plot.count]],
     col = point.color[w], type = "l", lwd = point.wd))
     }
     }
     ell.plot.count <- ell.plot.count + 1
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     }
     }
     }
     graphics::par(old.par)
     }
     else {
     LL <- lapply(p, function(x) lapply(1:dd, function(y) data.frame(t(sapply(chain$matrix[[x]],
     function(x) x[y, ])))))
     ell.data <- list()
     for (w in 1:length(p)) {
     ell.data[[w]] <- list()
     ell.data.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.data[[w]][[ell.data.count]] <- getEllipseMatrix(mat = chain$matrix[[p[w]]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.data.count <- ell.data.count + 1
     }
     }
     }
     if (!is.null(point.matrix)) {
     if (!class(point.matrix) == "list")
     stop(" point.matrix need to be a list of matrices.")
     if (!length(point.matrix) == length(p))
     stop("Lenght of point.matrix need to be equal to the number of regimes fitted to the tree.")
     if (!class(point.matrix[[1]]) == "matrix")
     stop(" point.matrix need to be a list of matrices.")
     ell.point <- list()
     for (w in 1:length(p)) {
     ell.point[[w]] <- list()
     ell.point.count <- 1
     for (j in 2:dd) {
     for (i in 1:(j - 1)) {
     ell.point[[w]][[ell.point.count]] <- getEllipseMatrix(mat = point.matrix[[w]],
     traits = c(i, j), sample.line = n.lines,
     n.points = n.points)
     ell.point.count <- ell.point.count + 1
     }
     }
     }
     }
     y.hist <- vector()
     x.hist <- vector()
     for (w in 1:length(p)) {
     for (i in 1:dd) {
     for (j in i:dd) {
     x.hist <- c(min(x.hist[1], LL[[w]][[i]][, j],
     na.rm = TRUE), max(x.hist[2], LL[[w]][[i]][,
     j], na.rm = TRUE))
     }
     }
     }
     if (is.null(set.xlim)) {
     wd <- (x.hist[2] - mean(x.hist))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- x.hist
     }
     else {
     wd <- (set.xlim[2] - mean(set.xlim))/20
     brk <- seq(from = x.hist[1] - wd, to = x.hist[2] +
     wd, by = wd)
     brk.var <- seq(from = 0, to = x.hist[2] + wd, by = wd)
     xlim.hist <- set.xlim
     }
     hists <- list()
     for (w in 1:length(p)) {
     hists[[w]] <- list()
     hist.count <- 1
     for (i in 1:dd) {
     for (j in i:dd) {
     if (i == j) {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk.var)
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     else {
     hists[[w]][[hist.count]] <- graphics::hist(LL[[w]][[i]][,
     j], plot = FALSE, breaks = brk)
     y.hist <- max(y.hist, hists[[w]][[hist.count]]$density)
     hist.count <- hist.count + 1
     }
     }
     }
     }
     ylim.hist <- c(0, y.hist)
     ell.lim <- lapply(do.call(c, ell.data), function(x) x[[1]])
     ell.lim <- do.call(rbind, ell.lim)
     ell.lim <- apply(ell.lim, 2, range)
     ell.lim.iso <- c(min(ell.lim[1, ]), max(ell.lim[2, ]))
     old.par <- graphics::par(no.readonly = TRUE)
     graphics::par(mfrow = c(dd[1], dd[1]))
     graphics::par(cex = 0.6)
     graphics::par(mar = c(0, 0, 0, 0), oma = c(2, 2, 2, 2))
     graphics::par(tcl = -0.25)
     graphics::par(mgp = c(2, 0.6, 0))
     colOff <- grDevices::adjustcolor(col = colors, alpha.f = alphaOff)
     colDiag <- grDevices::adjustcolor(col = colors, alpha.f = alphaDiag)
     colEll <- grDevices::adjustcolor(col = colors, alpha.f = alphaEll)
     if (is.null(point.color)) {
     point.color <- colors
     }
     ell.plot.count <- 1
     hist.plot.count <- 1
     for (i in 1:dd) {
     for (j in 1:dd) {
     if (j >= i) {
     graphics::plot(1, xlim = xlim.hist, ylim = ylim.hist,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     mid <- mean(xlim.hist)
     first.quart <- xlim.hist[1] + (mid - xlim.hist[1])/2
     second.quart <- mid + (xlim.hist[2] - mid)/2
     graphics::lines(x = c(mid, mid), y = ylim.hist,
     type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(first.quart, first.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     graphics::lines(x = c(second.quart, second.quart),
     y = ylim.hist, type = "l", lty = 3, col = "grey")
     if (show.zero == TRUE) {
     graphics::lines(x = c(0, 0), y = ylim.hist,
     type = "l", lty = 3, col = "blue")
     }
     graphics::box(col = "grey")
     if (j != i) {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, col = colOff[w],
     border = "gray")
     }
     }
     else {
     for (w in 1:length(p)) {
     graphics::plot(hists[[w]][[hist.plot.count]],
     add = TRUE, freq = FALSE, col = colDiag[w],
     border = "black")
     }
     if (i == dd) {
     graphics::axis(1, at = round(c(xlim.hist[1],
     mean(xlim.hist), xlim.hist[2]), digits = 2))
     }
     }
     if (i == 1) {
     graphics::mtext(text = set.leg[j], side = 3,
     cex = l.cex)
     }
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     graphics::lines(x = c(point.matrix[[w]][i,
     j], point.matrix[[w]][i, j]), y = ylim.hist,
     type = "l", col = point.color[w], lwd = point.wd)
     }
     }
     hist.plot.count <- hist.plot.count + 1
     }
     else {
     graphics::plot(1, xlim = ell.lim.iso, ylim = ell.lim.iso,
     axes = FALSE, type = "n", xlab = "", ylab = "")
     graphics::box(col = "grey")
     for (w in 1:length(p)) {
     invisible(lapply(ell.data[[w]][[ell.plot.count]][[2]],
     function(x) graphics::points(x, col = colEll[w],
     type = "l", lwd = ell.wd)))
     }
     if (!is.null(point.matrix)) {
     for (w in 1:length(p)) {
     invisible(graphics::points(ell.point[[w]][[ell.plot.count]],
     col = point.color[w], type = "l", lwd = point.wd))
     }
     }
     ell.plot.count <- ell.plot.count + 1
     if (j == 1) {
     graphics::mtext(text = set.leg[i], side = 2,
     cex = l.cex)
     }
     }
     }
     }
     graphics::par(old.par)
     }
    }
    <bytecode: 0xdcd43b0>
    <environment: namespace:ratematrix>
     --- function search by body ---
    Function plotRatematrix in namespace ratematrix has this body.
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 186-188 (Making_prior_on_ratematrix.Rmd)
    Error: processing vignette 'Making_prior_on_ratematrix.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building ‘Making_prior_on_ratematrix.Rmd’
    
    --- re-building ‘Set_custom_starting_point.Rmd’ using knitr
    --- finished re-building ‘Set_custom_starting_point.Rmd’
    
    SUMMARY: processing the following file failed:
     ‘Making_prior_on_ratematrix.Rmd’
    
    Error: Vignette re-building failed.
    Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc