CRAN Package Check Results for Package TreeSimGM

Last updated on 2020-01-20 01:50:38 CET.

Flavor Version Tinstall Tcheck Ttotal Status Flags
r-devel-linux-x86_64-debian-clang 2.3 5.71 43.32 49.03 ERROR
r-devel-linux-x86_64-debian-gcc 2.3 4.23 37.37 41.60 OK
r-devel-linux-x86_64-fedora-clang 2.3 65.02 OK
r-devel-linux-x86_64-fedora-gcc 2.3 63.21 OK
r-devel-windows-ix86+x86_64 2.3 15.00 93.00 108.00 OK
r-devel-windows-ix86+x86_64-gcc8 2.3 10.00 69.00 79.00 OK
r-patched-linux-x86_64 2.3 4.26 43.93 48.19 OK
r-patched-solaris-x86 2.3 84.50 OK
r-release-linux-x86_64 2.3 4.04 43.83 47.87 OK
r-release-windows-ix86+x86_64 2.3 14.00 58.00 72.00 OK
r-release-osx-x86_64 2.3 OK
r-oldrel-windows-ix86+x86_64 2.3 5.00 57.00 62.00 OK
r-oldrel-osx-x86_64 2.3 OK

Check Details

Version: 2.3
Check: examples
Result: ERROR
    Running examples in 'TreeSimGM-Ex.R' failed
    The error most likely occurred in:
    
    > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
    > ### Name: TreeSimGM-package
    > ### Title: Simulating Phylogenetic Trees under General Bellman Harris and
    > ### Lineage Shift Model
    > ### Aliases: TreeSimGM-package TreeSimGM
    > ### Keywords: tree, phylogeny, simulation, general model, macroevolution
    >
    > ### ** Examples
    >
    > ##plots the first tree of a list of two simulated trees
    > #simulation based on age, this case = 3.
    > #Note that by default, symmetric = TRUE
    > #i.e. we simulate under symmetric speciation and under no extinction.
    > library("TreeSimGM")
    > trialtrees <- sim.age(3,4,"rweibull(0.4,3)")
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    TreeSimGM
     --- call from context ---
    FUN(X[[i]], ...)
     --- call from argument ---
    if (class(data) == "numeric") {
     data <- matrix(data, ncol = 2)
    }
     --- R stacktrace ---
    where 1: FUN(X[[i]], ...)
    where 2: lapply(rep(age, numbsim), mytree.symmetric.age, waitsp, waitext,
     complete, tiplabel, shiftsp, shiftext, sampling)
    where 3: sim.age(3, 4, "rweibull(0.4,3)")
    
     --- value of length: 2 type: logical ---
    [1] FALSE FALSE
     --- function from context ---
    function (age, waitsp, waitext, complete = TRUE, tiplabel, shiftsp,
     shiftext, sampling)
    {
     if (is.function(waitsp)) {
     rnumbsp <- waitsp
     }
     else if (is.character(waitsp)) {
     rnumbsp <- express.distribution(waitsp)
     }
     if (is.function(waitext)) {
     rnumbext <- waitext
     firstextpar <- "funk"
     }
     else if (is.character(waitext)) {
     rnumbext <- express.distribution(waitext)
     firstextpar <- get.first.par.distribution(waitext)
     }
     if (is.function(shiftsp$strength)) {
     rnumbshiftsp <- shiftsp$strength
     }
     else if (is.character(shiftsp$strength)) {
     rnumbshiftsp <- express.distribution(shiftsp$strength)
     }
     if (is.function(shiftext$strength)) {
     rnumbshiftext <- shiftext$strength
     }
     else if (is.character(shiftext$strength)) {
     rnumbshiftext <- express.distribution(shiftext$strength)
     }
     labellivingsp = tiplabel[1]
     labelextinctsp = tiplabel[2]
     shiftsplabel = tiplabel[3]
     shiftextlabel = tiplabel[4]
     shiftspprob = shiftsp$prob
     shiftextprob = shiftext$prob
     stop <- FALSE
     mytree <- list(edge = NULL, tip.label = NULL, edge.length = NULL,
     Nnode = NULL, root.edge = NULL, age = NULL, shiftsp = NULL,
     shiftext = NULL, shifted.sp.living = NULL, shifted.sp.extinct = NULL,
     shifted.ext.living = NULL, shifted.ext.extinct = NULL)
     class(mytree) <- "phylo"
     edge <- matrix(c(-1, -2), ncol = 2)
     leaves <- NULL
     realleaves <- NULL
     extinct <- NULL
     tip.label <- NULL
     shiftedspliving <- NULL
     shiftedextliving <- NULL
     shiftedspextinct <- NULL
     shiftedextextinct <- NULL
     testshiftsp <- function(spt) {
     if (shiftspprob != 0) {
     if (runif(1, 0, 1) < shiftspprob) {
     shiftspstrength <- rnumbshiftsp()
     }
     else {
     shiftspstrength <- shiftspm[shiftspm[, "node"] ==
     species, "strength"]
     }
     }
     else {
     shiftspstrength <- 1
     }
     spt <- spt * shiftspstrength
     shiftspmr <- c((nextsp - i), shiftspstrength)
     attributes(spt) <- NULL
     attributes(shiftspmr) <- NULL
     return(list(spt = spt, shiftspmr = shiftspmr))
     }
     testshiftext <- function(extt) {
     if (shiftextprob != 0) {
     if (runif(1, 0, 1) < shiftextprob) {
     shiftextstrength <- rnumbshiftext()
     }
     else {
     shiftextstrength <- shiftextm[shiftextm[, "node"] ==
     species, "strength"]
     }
     }
     else {
     shiftextstrength <- 1
     }
     extt <- extt * shiftextstrength
     shiftextmr <- c((nextsp - i), shiftextstrength)
     attributes(extt) <- NULL
     attributes(shiftextmr) <- NULL
     return(list(extt = extt, shiftextmr = shiftextmr))
     }
     trajectory <- function(trace) {
     trajectory <- NULL
     while (length(which(edge[, 2] == trace))) {
     atual <- which(edge[, 2] == trace)
     trajectory <- c(edge.length[atual], trajectory)
     trace <- edge[atual, 1]
     }
     return(trajectory)
     }
     shiftspm <- matrix(c(-1, 1, -2, 1), byrow = TRUE, ncol = 2,
     dimnames = list(NULL, c("node", "strength")))
     shiftextm <- matrix(c(-1, 1, -2, 1), byrow = TRUE, ncol = 2,
     dimnames = list(NULL, c("node", "strength")))
     spt <- rnumbsp()
     {
     if (firstextpar == 0) {
     extt <- suppressWarnings(rnumbext())
     }
     else {
     extt <- rnumbext()
     }
     }
     {
     if (is.nan(extt)) {
     extt <- spt + 1
     }
     }
     {
     if (spt <= extt) {
     status <- "sp"
     edge.length <- spt
     leaves <- -2
     }
     else {
     status <- "ext"
     edge.length <- extt
     extinct <- -2
     stop <- TRUE
     }
     }
     {
     if (min(spt, extt) >= age) {
     edge.length <- age
     stop <- TRUE
     {
     if (status == "sp") {
     realleaves <- leaves
     leaves <- NULL
     }
     else {
     realleaves <- extinct
     extinct <- NULL
     }
     }
     }
     }
     while (stop == FALSE) {
     species <- leaves[1]
     nextsp <- min(edge[, 2])
     i <- 1
     for (i in 1:2) {
     edge <- rbind(edge, c(species, (nextsp - i)))
     spt <- rnumbsp()
     testshiftspout <- testshiftsp(spt)
     spt <- testshiftspout$spt
     shiftspm <- rbind(shiftspm, testshiftspout$shiftspmr)
     {
     if (firstextpar == 0) {
     extt <- suppressWarnings(rnumbext())
     }
     else {
     extt <- rnumbext()
     }
     }
     {
     if (is.nan(extt)) {
     extt <- spt + 10000
     }
     }
     testshiftextout <- testshiftext(extt)
     extt <- testshiftextout$extt
     shiftextm <- rbind(shiftextm, testshiftextout$shiftextmr)
     {
     if (spt <= extt) {
     status <- "sp"
     edge.length <- c(edge.length, spt)
     leaves <- c(leaves, (nextsp - i))
     }
     else {
     status <- "ext"
     edge.length <- c(edge.length, extt)
     extinct <- c(extinct, (nextsp - i))
     }
     }
     traject <- trajectory(nextsp - i)
     {
     if (sum(traject) >= age) {
     edge.length[length(edge.length)] <- age - sum(traject[1:(length(traject) -
     1)])
     {
     if (status == "sp") {
     realleaves <- c(realleaves, leaves[length(leaves)])
     leaves <- leaves[-length(leaves)]
     }
     else {
     realleaves <- c(realleaves, extinct[length(extinct)])
     extinct <- extinct[-length(extinct)]
     }
     }
     }
     }
     }
     leaves <- leaves[-1]
     {
     if (length(leaves) == 0) {
     stop <- TRUE
     }
     }
     }
     {
     if (stop == TRUE) {
     prealleaves <- realleaves
     {
     if (length(realleaves) > 0) {
     realleaves <- c(1:length(realleaves))
     i <- 1
     for (i in 1:length(realleaves)) {
     edge[which(edge[, 2] == prealleaves[i]),
     2] <- realleaves[i]
     shiftspm[which(shiftspm[, "node"] == prealleaves[i]),
     "node"] <- realleaves[i]
     shiftextm[which(shiftextm[, "node"] == prealleaves[i]),
     "node"] <- realleaves[i]
     }
     tip.label <- paste(labellivingsp, realleaves,
     sep = "")
     shiftedspliving <- rep(0, length(realleaves))
     data <- shiftspm[shiftspm[, "node"] %in% realleaves,
     ]
     if (class(data) == "numeric") {
     data <- matrix(data, ncol = 2)
     }
     shiftedspliving[data[sort.list(data[, 1]),
     2] != 1] <- 1
     tip.label[shiftedspliving == 1] <- paste(tip.label[shiftedspliving ==
     1], shiftsplabel, sep = " ")
     shiftedspliving <- cbind(realleaves, shiftedspliving)
     colnames(shiftedspliving) <- c("LivingSpecies",
     "shift")
     shiftedextliving <- rep(0, length(realleaves))
     data <- shiftextm[shiftextm[, "node"] %in%
     realleaves, ]
     if (class(data) == "numeric") {
     data <- matrix(data, ncol = 2)
     }
     shiftedextliving[data[sort.list(data[, 1]),
     2] != 1] <- 1
     tip.label[shiftedextliving == 1] <- paste(tip.label[shiftedextliving ==
     1], shiftextlabel, sep = " ")
     shiftedextliving <- cbind(realleaves, shiftedextliving)
     colnames(shiftedextliving) <- c("LivingSpecies",
     "shift")
     }
     }
     pextinct <- extinct
     {
     if (length(extinct) > 0) {
     extinct <- c((length(realleaves) + 1):(length(realleaves) +
     length(extinct)))
     i <- 1
     for (i in 1:length(extinct)) {
     edge[which(edge[, 2] == pextinct[i]), 2] <- extinct[i]
     shiftspm[which(shiftspm[, "node"] == pextinct[i]),
     "node"] <- extinct[i]
     shiftextm[which(shiftextm[, "node"] == pextinct[i]),
     "node"] <- extinct[i]
     }
     tip.label.tail <- paste(labelextinctsp, extinct,
     sep = "")
     shiftedspextinct <- rep(0, length(extinct))
     data <- shiftspm[shiftspm[, "node"] %in% extinct,
     ]
     if (class(data) == "numeric") {
     data <- matrix(data, ncol = 2)
     }
     shiftedspextinct[data[sort.list(data[, 1]),
     2] != 1] <- 1
     tip.label.tail[shiftedspextinct == 1] <- paste(tip.label.tail[shiftedspextinct ==
     1], shiftsplabel, sep = " ")
     shiftedspextinct <- cbind(extinct, shiftedspextinct)
     colnames(shiftedspextinct) <- c("ExtinctSpecies",
     "shift")
     shiftedextextinct <- rep(0, length(extinct))
     data <- shiftextm[shiftextm[, "node"] %in%
     extinct, ]
     if (class(data) == "numeric") {
     data <- matrix(data, ncol = 2)
     }
     shiftedextextinct[data[sort.list(data[, 1]),
     2] != 1] <- 1
     tip.label.tail[shiftedextextinct == 1] <- paste(tip.label.tail[shiftedextextinct ==
     1], shiftextlabel, sep = " ")
     shiftedextextinct <- cbind(extinct, shiftedextextinct)
     colnames(shiftedextextinct) <- c("ExtinctSpecies",
     "shift")
     tip.label <- c(tip.label, tip.label.tail)
     }
     }
     potheredges <- levels(as.factor(edge[edge < 0]))
     otheredges <- rev(seq((max(realleaves, extinct) +
     1), length.out = length(potheredges)))
     i <- 1
     for (i in 1:length(potheredges)) {
     edge[edge == potheredges[i]] <- otheredges[i]
     shiftspm[shiftspm[, "node"] == potheredges[i],
     "node"] <- otheredges[i]
     shiftextm[shiftextm[, "node"] == potheredges[i],
     "node"] <- otheredges[i]
     }
     mytree$edge <- edge
     mytree$tip.label <- tip.label
     mytree$edge.length <- edge.length
     mytree$Nnode <- length(realleaves) + length(extinct)
     mytree$root.edge <- edge.length[1]
     mytree$age <- age
     mytree$shiftsp <- shiftspm
     mytree$shiftext <- shiftextm
     mytree$shifted.sp.living <- shiftedspliving
     mytree$shifted.sp.extinct <- shiftedspextinct
     mytree$shifted.ext.living <- shiftedextliving
     mytree$shifted.ext.extinct <- shiftedextextinct
     }
     }
     {
     if (length(realleaves) == 0) {
     mytree <- 0
     }
     else {
     {
     if (length(realleaves) == 1 & complete == FALSE) {
     mytree <- 1
     }
     else {
     {
     if (length(realleaves) == 1 & length(extinct) ==
     0 & complete == TRUE) {
     mytree <- 1
     }
     else {
     mytree <- collapse.singles(mytree)
     {
     if (complete == FALSE) {
     mytree <- drop.fossil(mytree)
     mytree$root.edge <- age - max(getx(mytree))
     }
     }
     }
     }
     }
     }
     }
     }
     if (sampling$frac != 1 & class(mytree) == "phylo") {
     mytree <- sample.mytree(mytree. = mytree, realleaves. = realleaves,
     extinct. = extinct, sampling. = sampling)
     }
     return(mytree)
    }
    <bytecode: 0x27b4798>
    <environment: namespace:TreeSimGM>
     --- function search by body ---
    Function mytree.symmetric.age in namespace TreeSimGM has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (class(data) == "numeric") { : the condition has length > 1
    Calls: sim.age -> lapply -> FUN
    Execution halted
Flavor: r-devel-linux-x86_64-debian-clang

Version: 2.3
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
     ...
    --- re-building 'TreeSimGM.Rmd' using rmarkdown
    Loading required package: TreeSim
    Loading required package: ape
    Loading required package: geiger
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    TreeSimGM
     --- call from context ---
    FUN(X[[i]], ...)
     --- call from argument ---
    if (class(data) == "numeric") {
     data <- matrix(data, ncol = 2)
    }
     --- R stacktrace ---
    where 1: FUN(X[[i]], ...)
    where 2: lapply(rep(age, numbsim), mytree.symmetric.age, waitsp, waitext,
     complete, tiplabel, shiftsp, shiftext, sampling)
    where 3: sim.age(age = 3, numbsim = 1, "rexp(1.2)")
    where 4: eval(expr, envir, enclos)
    where 5: eval(expr, envir, enclos)
    where 6: withVisible(eval(expr, envir, enclos))
    where 7: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 8: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 9: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 10: 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 11: evaluate::evaluate(...)
    where 12: 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 13: 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 14: block_exec(params)
    where 15: call_block(x)
    where 16: process_group.block(group)
    where 17: process_group(group)
    where 18: 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 19: process_file(text, output)
    where 20: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet)
    where 21: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(),
     ...)
    where 22: vweave_rmarkdown(...)
    where 23: engine$weave(file, quiet = quiet, encoding = enc)
    where 24: doTryCatch(return(expr), name, parentenv, handler)
    where 25: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 26: tryCatchList(expr, classes, parentenv, handlers)
    where 27: 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)
     }
     outputs <- c(outputs, output)
    }, error = function(e) {
     thisOK <<- FALSE
     fails <<- c(fails, file)
     message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
     file, conditionMessage(e)))
    })
    where 28: tools:::buildVignettes(dir = "/home/hornik/tmp/R.check/r-devel-clang/Work/PKGS/TreeSimGM.Rcheck/vign_test/TreeSimGM",
     ser_elibs = "/tmp/RtmpqW2FOP/file34e73a3d492.rds")
    
     --- value of length: 2 type: logical ---
    [1] FALSE FALSE
     --- function from context ---
    function (age, waitsp, waitext, complete = TRUE, tiplabel, shiftsp,
     shiftext, sampling)
    {
     if (is.function(waitsp)) {
     rnumbsp <- waitsp
     }
     else if (is.character(waitsp)) {
     rnumbsp <- express.distribution(waitsp)
     }
     if (is.function(waitext)) {
     rnumbext <- waitext
     firstextpar <- "funk"
     }
     else if (is.character(waitext)) {
     rnumbext <- express.distribution(waitext)
     firstextpar <- get.first.par.distribution(waitext)
     }
     if (is.function(shiftsp$strength)) {
     rnumbshiftsp <- shiftsp$strength
     }
     else if (is.character(shiftsp$strength)) {
     rnumbshiftsp <- express.distribution(shiftsp$strength)
     }
     if (is.function(shiftext$strength)) {
     rnumbshiftext <- shiftext$strength
     }
     else if (is.character(shiftext$strength)) {
     rnumbshiftext <- express.distribution(shiftext$strength)
     }
     labellivingsp = tiplabel[1]
     labelextinctsp = tiplabel[2]
     shiftsplabel = tiplabel[3]
     shiftextlabel = tiplabel[4]
     shiftspprob = shiftsp$prob
     shiftextprob = shiftext$prob
     stop <- FALSE
     mytree <- list(edge = NULL, tip.label = NULL, edge.length = NULL,
     Nnode = NULL, root.edge = NULL, age = NULL, shiftsp = NULL,
     shiftext = NULL, shifted.sp.living = NULL, shifted.sp.extinct = NULL,
     shifted.ext.living = NULL, shifted.ext.extinct = NULL)
     class(mytree) <- "phylo"
     edge <- matrix(c(-1, -2), ncol = 2)
     leaves <- NULL
     realleaves <- NULL
     extinct <- NULL
     tip.label <- NULL
     shiftedspliving <- NULL
     shiftedextliving <- NULL
     shiftedspextinct <- NULL
     shiftedextextinct <- NULL
     testshiftsp <- function(spt) {
     if (shiftspprob != 0) {
     if (runif(1, 0, 1) < shiftspprob) {
     shiftspstrength <- rnumbshiftsp()
     }
     else {
     shiftspstrength <- shiftspm[shiftspm[, "node"] ==
     species, "strength"]
     }
     }
     else {
     shiftspstrength <- 1
     }
     spt <- spt * shiftspstrength
     shiftspmr <- c((nextsp - i), shiftspstrength)
     attributes(spt) <- NULL
     attributes(shiftspmr) <- NULL
     return(list(spt = spt, shiftspmr = shiftspmr))
     }
     testshiftext <- function(extt) {
     if (shiftextprob != 0) {
     if (runif(1, 0, 1) < shiftextprob) {
     shiftextstrength <- rnumbshiftext()
     }
     else {
     shiftextstrength <- shiftextm[shiftextm[, "node"] ==
     species, "strength"]
     }
     }
     else {
     shiftextstrength <- 1
     }
     extt <- extt * shiftextstrength
     shiftextmr <- c((nextsp - i), shiftextstrength)
     attributes(extt) <- NULL
     attributes(shiftextmr) <- NULL
     return(list(extt = extt, shiftextmr = shiftextmr))
     }
     trajectory <- function(trace) {
     trajectory <- NULL
     while (length(which(edge[, 2] == trace))) {
     atual <- which(edge[, 2] == trace)
     trajectory <- c(edge.length[atual], trajectory)
     trace <- edge[atual, 1]
     }
     return(trajectory)
     }
     shiftspm <- matrix(c(-1, 1, -2, 1), byrow = TRUE, ncol = 2,
     dimnames = list(NULL, c("node", "strength")))
     shiftextm <- matrix(c(-1, 1, -2, 1), byrow = TRUE, ncol = 2,
     dimnames = list(NULL, c("node", "strength")))
     spt <- rnumbsp()
     {
     if (firstextpar == 0) {
     extt <- suppressWarnings(rnumbext())
     }
     else {
     extt <- rnumbext()
     }
     }
     {
     if (is.nan(extt)) {
     extt <- spt + 1
     }
     }
     {
     if (spt <= extt) {
     status <- "sp"
     edge.length <- spt
     leaves <- -2
     }
     else {
     status <- "ext"
     edge.length <- extt
     extinct <- -2
     stop <- TRUE
     }
     }
     {
     if (min(spt, extt) >= age) {
     edge.length <- age
     stop <- TRUE
     {
     if (status == "sp") {
     realleaves <- leaves
     leaves <- NULL
     }
     else {
     realleaves <- extinct
     extinct <- NULL
     }
     }
     }
     }
     while (stop == FALSE) {
     species <- leaves[1]
     nextsp <- min(edge[, 2])
     i <- 1
     for (i in 1:2) {
     edge <- rbind(edge, c(species, (nextsp - i)))
     spt <- rnumbsp()
     testshiftspout <- testshiftsp(spt)
     spt <- testshiftspout$spt
     shiftspm <- rbind(shiftspm, testshiftspout$shiftspmr)
     {
     if (firstextpar == 0) {
     extt <- suppressWarnings(rnumbext())
     }
     else {
     extt <- rnumbext()
     }
     }
     {
     if (is.nan(extt)) {
     extt <- spt + 10000
     }
     }
     testshiftextout <- testshiftext(extt)
     extt <- testshiftextout$extt
     shiftextm <- rbind(shiftextm, testshiftextout$shiftextmr)
     {
     if (spt <= extt) {
     status <- "sp"
     edge.length <- c(edge.length, spt)
     leaves <- c(leaves, (nextsp - i))
     }
     else {
     status <- "ext"
     edge.length <- c(edge.length, extt)
     extinct <- c(extinct, (nextsp - i))
     }
     }
     traject <- trajectory(nextsp - i)
     {
     if (sum(traject) >= age) {
     edge.length[length(edge.length)] <- age - sum(traject[1:(length(traject) -
     1)])
     {
     if (status == "sp") {
     realleaves <- c(realleaves, leaves[length(leaves)])
     leaves <- leaves[-length(leaves)]
     }
     else {
     realleaves <- c(realleaves, extinct[length(extinct)])
     extinct <- extinct[-length(extinct)]
     }
     }
     }
     }
     }
     leaves <- leaves[-1]
     {
     if (length(leaves) == 0) {
     stop <- TRUE
     }
     }
     }
     {
     if (stop == TRUE) {
     prealleaves <- realleaves
     {
     if (length(realleaves) > 0) {
     realleaves <- c(1:length(realleaves))
     i <- 1
     for (i in 1:length(realleaves)) {
     edge[which(edge[, 2] == prealleaves[i]),
     2] <- realleaves[i]
     shiftspm[which(shiftspm[, "node"] == prealleaves[i]),
     "node"] <- realleaves[i]
     shiftextm[which(shiftextm[, "node"] == prealleaves[i]),
     "node"] <- realleaves[i]
     }
     tip.label <- paste(labellivingsp, realleaves,
     sep = "")
     shiftedspliving <- rep(0, length(realleaves))
     data <- shiftspm[shiftspm[, "node"] %in% realleaves,
     ]
     if (class(data) == "numeric") {
     data <- matrix(data, ncol = 2)
     }
     shiftedspliving[data[sort.list(data[, 1]),
     2] != 1] <- 1
     tip.label[shiftedspliving == 1] <- paste(tip.label[shiftedspliving ==
     1], shiftsplabel, sep = " ")
     shiftedspliving <- cbind(realleaves, shiftedspliving)
     colnames(shiftedspliving) <- c("LivingSpecies",
     "shift")
     shiftedextliving <- rep(0, length(realleaves))
     data <- shiftextm[shiftextm[, "node"] %in%
     realleaves, ]
     if (class(data) == "numeric") {
     data <- matrix(data, ncol = 2)
     }
     shiftedextliving[data[sort.list(data[, 1]),
     2] != 1] <- 1
     tip.label[shiftedextliving == 1] <- paste(tip.label[shiftedextliving ==
     1], shiftextlabel, sep = " ")
     shiftedextliving <- cbind(realleaves, shiftedextliving)
     colnames(shiftedextliving) <- c("LivingSpecies",
     "shift")
     }
     }
     pextinct <- extinct
     {
     if (length(extinct) > 0) {
     extinct <- c((length(realleaves) + 1):(length(realleaves) +
     length(extinct)))
     i <- 1
     for (i in 1:length(extinct)) {
     edge[which(edge[, 2] == pextinct[i]), 2] <- extinct[i]
     shiftspm[which(shiftspm[, "node"] == pextinct[i]),
     "node"] <- extinct[i]
     shiftextm[which(shiftextm[, "node"] == pextinct[i]),
     "node"] <- extinct[i]
     }
     tip.label.tail <- paste(labelextinctsp, extinct,
     sep = "")
     shiftedspextinct <- rep(0, length(extinct))
     data <- shiftspm[shiftspm[, "node"] %in% extinct,
     ]
     if (class(data) == "numeric") {
     data <- matrix(data, ncol = 2)
     }
     shiftedspextinct[data[sort.list(data[, 1]),
     2] != 1] <- 1
     tip.label.tail[shiftedspextinct == 1] <- paste(tip.label.tail[shiftedspextinct ==
     1], shiftsplabel, sep = " ")
     shiftedspextinct <- cbind(extinct, shiftedspextinct)
     colnames(shiftedspextinct) <- c("ExtinctSpecies",
     "shift")
     shiftedextextinct <- rep(0, length(extinct))
     data <- shiftextm[shiftextm[, "node"] %in%
     extinct, ]
     if (class(data) == "numeric") {
     data <- matrix(data, ncol = 2)
     }
     shiftedextextinct[data[sort.list(data[, 1]),
     2] != 1] <- 1
     tip.label.tail[shiftedextextinct == 1] <- paste(tip.label.tail[shiftedextextinct ==
     1], shiftextlabel, sep = " ")
     shiftedextextinct <- cbind(extinct, shiftedextextinct)
     colnames(shiftedextextinct) <- c("ExtinctSpecies",
     "shift")
     tip.label <- c(tip.label, tip.label.tail)
     }
     }
     potheredges <- levels(as.factor(edge[edge < 0]))
     otheredges <- rev(seq((max(realleaves, extinct) +
     1), length.out = length(potheredges)))
     i <- 1
     for (i in 1:length(potheredges)) {
     edge[edge == potheredges[i]] <- otheredges[i]
     shiftspm[shiftspm[, "node"] == potheredges[i],
     "node"] <- otheredges[i]
     shiftextm[shiftextm[, "node"] == potheredges[i],
     "node"] <- otheredges[i]
     }
     mytree$edge <- edge
     mytree$tip.label <- tip.label
     mytree$edge.length <- edge.length
     mytree$Nnode <- length(realleaves) + length(extinct)
     mytree$root.edge <- edge.length[1]
     mytree$age <- age
     mytree$shiftsp <- shiftspm
     mytree$shiftext <- shiftextm
     mytree$shifted.sp.living <- shiftedspliving
     mytree$shifted.sp.extinct <- shiftedspextinct
     mytree$shifted.ext.living <- shiftedextliving
     mytree$shifted.ext.extinct <- shiftedextextinct
     }
     }
     {
     if (length(realleaves) == 0) {
     mytree <- 0
     }
     else {
     {
     if (length(realleaves) == 1 & complete == FALSE) {
     mytree <- 1
     }
     else {
     {
     if (length(realleaves) == 1 & length(extinct) ==
     0 & complete == TRUE) {
     mytree <- 1
     }
     else {
     mytree <- collapse.singles(mytree)
     {
     if (complete == FALSE) {
     mytree <- drop.fossil(mytree)
     mytree$root.edge <- age - max(getx(mytree))
     }
     }
     }
     }
     }
     }
     }
     }
     if (sampling$frac != 1 & class(mytree) == "phylo") {
     mytree <- sample.mytree(mytree. = mytree, realleaves. = realleaves,
     extinct. = extinct, sampling. = sampling)
     }
     return(mytree)
    }
    <bytecode: 0x56a4120>
    <environment: namespace:TreeSimGM>
     --- function search by body ---
    Function mytree.symmetric.age in namespace TreeSimGM has this body.
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 41-43 (TreeSimGM.Rmd)
    Error: processing vignette 'TreeSimGM.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building 'TreeSimGM.Rmd'
    
    SUMMARY: processing the following file failed:
     'TreeSimGM.Rmd'
    
    Error: Vignette re-building failed.
    Execution halted
Flavor: r-devel-linux-x86_64-debian-clang