@@ -1,5 +1,4 @@

-

 ##' @importFrom ggplot2 last_plot

 get_tree_view <- function(tree_view) {

     if (is.null(tree_view))

@@ -17,6 +17,18 @@ get_layout <- function(tree_view = NULL) {

     return(layout)

 }

+build_new_plot_env <- function(env){

+    newenv <- list2env(

+                x = as.list(

+                  env, 

+                  all.names = TRUE

+                ), 

+                parent = parent.env(env)

+              )

+    attributes(newenv) <- attributes(env)

+    return(newenv)

+}

+

 reverse.treeview <- function(tv) {

     tv$data <- reverse.treeview.data(tv$data)

     return(tv)

@@ -175,5 +175,5 @@ message_wrap <- function(...){

 ## }

-ggrange <- getFromNamespace("ggrange", "aplot")

+

@@ -173,3 +173,7 @@ message_wrap <- function(...){

 ##     tree$edge.length <- c(tree$edge.length, rep(0, ii))

 ##     return(tree)

 ## }

+

+

+ggrange <- getFromNamespace("ggrange", "aplot")

+

@@ -117,6 +117,17 @@ getCols <- function (n) {

     grDevices::colorRampPalette(col3)(n)

 }

+message_wrap <- function(...){

+    msg <- .return_wrap(...)

+    message(msg)

+}

+

+.return_wrap <- function(...){

+    msg <- paste(..., collapse = "", sep = "")

+    wrapped <- strwrap(msg, width = getOption("width") - 2) %>%

+        glue::glue_collapse(., "\n", last = "\n")

+    wrapped

+}

 ##

 ##

@@ -162,56 +162,3 @@ getCols <- function (n) {

 ##     tree$edge.length <- c(tree$edge.length, rep(0, ii))

 ##     return(tree)

 ## }

-

-build_cladeids_df <- function(trdf, nodeids){

-    dat <- lapply(seq_along(nodeids), function(i){

-             ids <- getSubtree.df(trdf, nodeids[i])

-             dt <- trdf[trdf$node %in% ids,]

-             dt$clade_root_node <- nodeids[i]

-             return(dt)

-              })

-    return(do.call("rbind", dat))

-}

-

-build_cladeids_df2 <- function(trdf, nodeids){

-    flagreverse <- check_reverse(data=trdf)

-    dat <- lapply(nodeids, function(i)get_clade_position_(data=trdf, node=i, reverse=flagreverse))

-    dat <- do.call("rbind", dat)

-    dat$clade_root_node <- nodeids

-    return(dat)

-}

-

-check_reverse <- function(data){

-    tiptab <- data[data$isTip,]

-    nodetab <- data[match(tiptab$parent, data$node),]

-    if (all(tiptab$x < nodetab$x)){

-        return(TRUE)

-    }else{

-        return(FALSE)

-    }

-}

-

-

-

-choose_hilight_layer <- function(object, type){

-    if (type=="encircle"){

-        if (!is.null(object$mapping)){

-            object$mapping <- modifyList(object$mapping, aes_(x=~x, y=~y, clade_root_node=~clade_root_node))

-        }else{

-            object$mapping <- aes_(x=~x, y=~y, clade_root_node=~clade_root_node)

-        }

-        params <- c(list(data=object$data, mapping=object$mapping), object$params)

-        ly <- do.call("geom_hilight_encircle2", params)

-    }else{

-        if (!is.null(object$mapping)){

-            object$mapping <- modifyList(object$mapping, aes_(xmin=~xmin, xmax=~xmax, 

-                                                              ymin=~ymin, ymax=~ymax, 

-                                                              clade_root_node=~clade_root_node))

-        }else{

-            object$mapping <- aes_(xmin=~xmin, xmax=~xmax, ymin=~ymin, ymax=~ymax, clade_root_node=~clade_root_node)

-        }

-        params <- c(list(data=object$data, mapping=object$mapping), object$params)

-        ly <- do.call("geom_hilight_rect2", params)

-    }

-    return (ly)

-}

@@ -174,12 +174,25 @@ build_cladeids_df <- function(trdf, nodeids){

 }

 build_cladeids_df2 <- function(trdf, nodeids){

-    dat <- lapply(nodeids, function(i)get_clade_position_(data=trdf, node=i))

+    flagreverse <- check_reverse(data=trdf)

+    dat <- lapply(nodeids, function(i)get_clade_position_(data=trdf, node=i, reverse=flagreverse))

     dat <- do.call("rbind", dat)

     dat$clade_root_node <- nodeids

     return(dat)

 }

+check_reverse <- function(data){

+    tiptab <- data[data$isTip,]

+    nodetab <- data[match(tiptab$parent, data$node),]

+    if (all(tiptab$x < nodetab$x)){

+        return(TRUE)

+    }else{

+        return(FALSE)

+    }

+}

+

+

+

 choose_hilight_layer <- function(object, type){

     if (type=="encircle"){

         if (!is.null(object$mapping)){

@@ -8,6 +8,15 @@ get_tree_view <- function(tree_view) {

     return(tree_view)

 }

+get_layout <- function(tree_view = NULL) {

+    plot <- get_tree_view(tree_view)

+    layout <- get("layout", envir = plot$plot_env)

+    if (!is(layout, "character")) {

+        layout <- attr(plot$data, "layout")

+    }

+    return(layout)

+}

+

 reverse.treeview <- function(tv) {

     tv$data <- reverse.treeview.data(tv$data)

     return(tv)

@@ -154,7 +154,6 @@ getCols <- function (n) {

 ##     return(tree)

 ## }

-

 build_cladeids_df <- function(trdf, nodeids){

     dat <- lapply(seq_along(nodeids), function(i){

              ids <- getSubtree.df(trdf, nodeids[i])

@@ -165,3 +164,32 @@ build_cladeids_df <- function(trdf, nodeids){

     return(do.call("rbind", dat))

 }

+build_cladeids_df2 <- function(trdf, nodeids){

+    dat <- lapply(nodeids, function(i)get_clade_position_(data=trdf, node=i))

+    dat <- do.call("rbind", dat)

+    dat$clade_root_node <- nodeids

+    return(dat)

+}

+

+choose_hilight_layer <- function(object, type){

+    if (type=="encircle"){

+        if (!is.null(object$mapping)){

+            object$mapping <- modifyList(object$mapping, aes_(x=~x, y=~y, clade_root_node=~clade_root_node))

+        }else{

+            object$mapping <- aes_(x=~x, y=~y, clade_root_node=~clade_root_node)

+        }

+        params <- c(list(data=object$data, mapping=object$mapping), object$params)

+        ly <- do.call("geom_hilight_encircle2", params)

+    }else{

+        if (!is.null(object$mapping)){

+            object$mapping <- modifyList(object$mapping, aes_(xmin=~xmin, xmax=~xmax, 

+                                                              ymin=~ymin, ymax=~ymax, 

+                                                              clade_root_node=~clade_root_node))

+        }else{

+            object$mapping <- aes_(xmin=~xmin, xmax=~xmax, ymin=~ymin, ymax=~ymax, clade_root_node=~clade_root_node)

+        }

+        params <- c(list(data=object$data, mapping=object$mapping), object$params)

+        ly <- do.call("geom_hilight_rect2", params)

+    }

+    return (ly)

+}

@@ -155,5 +155,13 @@ getCols <- function (n) {

 ## }

-

+build_cladeids_df <- function(trdf, nodeids){

+    dat <- lapply(seq_along(nodeids), function(i){

+             ids <- getSubtree.df(trdf, nodeids[i])

+             dt <- trdf[trdf$node %in% ids,]

+             dt$clade_root_node <- nodeids[i]

+             return(dt)

+              })

+    return(do.call("rbind", dat))

+}

@@ -73,8 +73,6 @@ roundDigit <- function(d) {

     round(d)/10^i

 }

-##' @import aplot

-xrange <- getFromNamespace("xrange", "aplot")

 globalVariables(".")

@@ -73,7 +73,7 @@ roundDigit <- function(d) {

     round(d)/10^i

 }

-

+##' @import aplot

 xrange <- getFromNamespace("xrange", "aplot")

 globalVariables(".")

@@ -74,6 +74,8 @@ roundDigit <- function(d) {

 }

+xrange <- getFromNamespace("xrange", "aplot")

+

 globalVariables(".")

 ## ## . function was from plyr package

@@ -74,21 +74,23 @@ roundDigit <- function(d) {

 }

-## . function was from plyr package

-##' capture name of variable

-##'

-##' @rdname dotFun

-##' @export

-##' @title .

-##' @param ... expression

-##' @param .env environment

-##' @return expression

-##' @examples

-##' x <- 1

-##' eval(.(x)[[1]])

-. <- function (..., .env = parent.frame()) {

-    structure(as.list(match.call()[-1]), env = .env, class = "quoted")

-}

+globalVariables(".")

+

+## ## . function was from plyr package

+## ##' capture name of variable

+## ##'

+## ##' @rdname dotFun

+## ##' @export

+## ##' @title .

+## ##' @param ... expression

+## ##' @param .env environment

+## ##' @return expression

+## ##' @examples

+## ##' x <- 1

+## ##' eval(.(x)[[1]])

+## . <- function (..., .env = parent.frame()) {

+##     structure(as.list(match.call()[-1]), env = .env, class = "quoted")

+## }

 ## from ChIPseeker

@@ -1,6 +1,5 @@

-

 ##' @importFrom ggplot2 last_plot

 get_tree_view <- function(tree_view) {

     if (is.null(tree_view))

@@ -23,7 +23,7 @@ reverse.treeview.data <- function(df) {

 color_scale <- function(c1="grey", c2="red", n=100) {

-    pal <- colorRampPalette(c(c1, c2))

+    pal <- grDevices::colorRampPalette(c(c1, c2))

     colors <- pal(n)

     return(colors)

 }

@@ -93,7 +93,7 @@ roundDigit <- function(d) {

 ## from ChIPseeker

-##' @importFrom grDevices colorRampPalette

+## @importFrom grDevices colorRampPalette

 getCols <- function (n) {

     col <- c("#8dd3c7", "#ffffb3", "#bebada", "#fb8072", "#80b1d3",

              "#fdb462", "#b3de69", "#fccde5", "#d9d9d9", "#bc80bd",

@@ -104,12 +104,9 @@ getCols <- function (n) {

     col3 <- c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c", "#fb9a99",

               "#e31a1c", "#fdbf6f", "#ff7f00", "#cab2d6", "#6a3d9a",

               "#ffff99", "#b15928")

-    colorRampPalette(col3)(n)

+    grDevices::colorRampPalette(col3)(n)

 }

-##' @importFrom rvcheck get_fun_from_pkg

-hist <- get_fun_from_pkg("graphics", "hist")

-

 ##

 ##

@@ -111,6 +111,50 @@ getCols <- function (n) {

 hist <- get_fun_from_pkg("graphics", "hist")

+##

+##

+## use ape::multi2di

+##

+##

+## ##' convert polytomy to binary tree

+## ##'

+## ##' as.binary method for \code{phylo} object

+## ##' @rdname as.binary

+## ##' @return binary tree

+## ##' @method as.binary phylo

+## ##' @importFrom ape is.binary.tree

+## ##' @export

+## ##' @author Guangchuang Yu \url{http://ygc.name}

+## ##' @examples

+## ##' require(ape)

+## ##' tr <- read.tree(text="((A, B, C), D);")

+## ##' is.binary.tree(tr)

+## ##' tr2 <- as.binary(tr)

+## ##' is.binary.tree(tr2)

+## as.binary.phylo <- function(tree, ...) {

+##     if(is.binary.tree(tree)) {

+##         message("The input tree is already binary...")

+##         invisible(tree)

+##     }

+##     polyNode <- tree$edge[,1] %>% table %>% '>'(2) %>%

+##         which %>% names %>% as.numeric

+##     N <- getNodeNum(tree)

+##     ii <- 0

+##     for (pn in polyNode) {

+##         idx <- which(tree$edge[,1] == pn)

+##         while(length(idx) >2) {

+##             ii <- ii + 1

+##             newNode <- N+ii

+##             tree$edge[idx[-1],1] <- newNode

+##             newEdge <- matrix(c(tree$edge[idx[1],1], newNode), ncol=2)

+##             tree$edge <- rbind(tree$edge, newEdge)

+##             idx <- idx[-1]

+##         }

+##     }

+##     tree$Nnode <- tree$Nnode+ii

+##     tree$edge.length <- c(tree$edge.length, rep(0, ii))

+##     return(tree)

+## }

@@ -9,240 +9,6 @@ get_tree_view <- function(tree_view) {

     return(tree_view)

 }

-

-

-## has.field <- function(tree_object, field) {

-##     if ( ! field %in% get.fields(tree_object) ) {

-##         return(FALSE)

-##     }

-

-##     if (is(tree_object, "codeml")) {

-##         is_codeml <- TRUE

-##         tree <- tree_object@rst

-##     } else {

-##         is_codeml <- FALSE

-##         tree <- tree_object

-##     }

-

-##     if (.hasSlot(tree, field)) {

-##         has_slot <- TRUE

-##     } else {

-##         has_slot <- FALSE

-##     }

-

-##     if (has_slot == FALSE) {

-##         if (has.extraInfo(tree_object) == FALSE) {

-##             return(FALSE)

-##         }

-

-##         if (nrow(tree_object@extraInfo) == 0) {

-##             return(FALSE)

-##         }

-

-##         if (!field %in% colnames(tree_object@extraInfo)) {

-##             return(FALSE)

-##         }

-##     }

-##     res <- TRUE

-##     attr(res, "has_slot") <- has_slot

-##     attr(res, "is_codeml") <- is_codeml

-##     return(res)

-## }

-

-## append_extraInfo <- function(df, object) {

-##     if (has.extraInfo(object)) {

-##         info <- object@extraInfo

-##         if ("parent" %in% colnames(info)) {

-##             res <- merge(df, info, by.x=c("node", "parent"), by.y=c("node", "parent"))

-##         } else {

-##             res <- merge(df, info, by.x="node", by.y="node")

-##         }

-##     } else {

-##         return(df)

-##     }

-

-##     i <- order(res$node, decreasing = FALSE)

-##     res <- res[i,]

-##     return(res)

-## }

-

-## get.fields.tree <- function(object) {

-##     if (is(object, "codeml")) {

-##         fields <- c(get.fields(object@rst),

-##                     get.fields(object@mlc))

-##         fields <- unique(fields)

-##     } else {

-##         fields <- object@fields

-##     }

-

-##     if (has.slot(object, "extraInfo")) {

-##         extraInfo <- object@extraInfo

-##         if (nrow(extraInfo) > 0) {

-##             cn <- colnames(extraInfo)

-##             i <- match(c("x", "y", "isTip", "node", "parent", "label", "branch", "branch.length"), cn)

-##             i <- i[!is.na(i)]

-##             fields %<>% c(cn[-i])

-##         }

-##     }

-##     return(fields)

-## }

-

-## print_fields <- function(object, len=5) {

-##     fields <- get.fields(object)

-##     n <- length(fields)

-##     i <- floor(n/len)

-##     for (j in 0:i) {

-##         ii <- 1:len + len * j

-##         if (j == i) {

-##             x <- n %% len

-##             if (x == 0) {

-##                 ii <- NULL

-##             } else {

-##                 ii <- ii[1:x]

-##             }

-##         }

-

-##         if (!is.null(ii)) {

-##             cat("\t", paste0("'",

-##                              paste(fields[ii], collapse="',\t'"),

-##                              "'")

-##                 )

-##         }

-##         if ( j == i) {

-##             cat(".\n")

-##         } else {

-##             cat(",\n")

-##         }

-##     }

-## }

-

-## plot.subs <- function(x, layout, show.tip.label,

-##                       tip.label.size,

-##                       tip.label.hjust,

-##                       position, annotation,

-##                       annotation.color = "black",

-##                       annotation.size=3, ...) {

-

-##     p <- ggtree(x, layout=layout, ...)

-##     if (show.tip.label) {

-##         p <- p + geom_tiplab(hjust = tip.label.hjust,

-##                              size  = tip.label.size)

-##     }

-##     if (!is.null(annotation) && !is.na(annotation)) {

-##         p <- p + geom_text(aes_string(x=position, label=annotation),

-##                            size=annotation.size,

-##                            color=annotation.color, vjust=-.5)

-##     }

-##     p + theme_tree2()

-## }

-

-## .add_new_line <- function(res) {

-##     ## res <- paste0(strwrap(res, 50), collapse="\n")

-##     ## res %<>% gsub("\\s/\n", "\n", .) %>% gsub("\n/\\s", "\n", .)

-##     if (nchar(res) > 50) {

-##         idx <- gregexpr("/", res)[[1]]

-##         i <- idx[floor(length(idx)/2)]

-##         res <- paste0(substring(res, 1, i-1), "\n", substring(res, i+1))

-##     }

-##     return(res)

-## }

-

-## get.subs_ <- function(tree, fasta, translate=TRUE, removeGap=TRUE) {

-##     N <- getNodeNum(tree)

-##     node <- 1:N

-##     parent <- sapply(node, getParent, tr=tree)

-##     label <- getNodeName(tree)

-##     subs <- sapply(seq_along(node), function(i) {

-##         if (i == getRoot(tree)) {

-##             return(NA)

-##         }

-##         res <- getSubsLabel(fasta, label[parent[i]], label[i], translate, removeGap)

-##         if (is.null(res)) {

-##             return('')

-##         }

-##         .add_new_line(res)

-##     })

-

-##     dd <- data.frame(node=node, parent=parent, label=label, subs=subs)

-##     dd <- dd[dd$parent != 0,]

-##     dd <- dd[, -c(1,2)]

-##     dd[,1] <- as.character(dd[,1])

-##     dd[,2] <- as.character(dd[,2])

-##     return(dd)

-## }

-

-## getSubsLabel <- function(seqs, A, B, translate, removeGap) {

-##     seqA <- seqs[A]

-##     seqB <- seqs[B]

-

-##     if (nchar(seqA) != nchar(seqB)) {

-##         stop("seqA should have equal length to seqB")

-##     }

-

-##     if (translate == TRUE) {

-##         AA <- seqA %>% seq2codon %>% codon2AA

-##         BB <- seqB %>% seq2codon %>% codon2AA

-##     } else {

-##         ## strsplit is faster than substring

-##         ##

-##         ## n <- nchar(seqA) ## should equals to nchar(seqB)

-##         ## AA <- substring(seqA, 1:n, 1:n)

-##         ## BB <- substring(seqB, 1:n, 1:n)

-##         AA <- strsplit(seqA, split="") %>% unlist

-##         BB <- strsplit(seqB, split="") %>% unlist

-##     }

-

-##     ii <- which(AA != BB)

-

-##     if (removeGap == TRUE) {

-##         if (length(ii) > 0 && translate == TRUE) {

-##             ii <- ii[AA[ii] != "X" & BB[ii] != "X"]

-##         }

-

-##         if (length(ii) > 0 && translate == FALSE) {

-##             ii <- ii[AA[ii] != "-" & BB[ii] != "-"]

-##         }

-##     }

-

-##     if (length(ii) == 0) {

-##         return(NULL)

-##     }

-

-##     res <- paste(AA[ii], ii, BB[ii], sep="", collapse=" / ")

-##     return(res)

-## }

-

-## seq2codon <- function(x) {

-##     substring(x, first=seq(1, nchar(x)-2, 3), last=seq(3, nchar(x), 3))

-## }

-

-## ## @importFrom Biostrings GENETIC_CODE

-## codon2AA <- function(codon) {

-##     ## a genetic code name vector

-##     GENETIC_CODE <- get_fun_from_pkg("Biostrings", "GENETIC_CODE")

-##     aa <- GENETIC_CODE[codon]

-##     aa[is.na(aa)] <- "X"

-##     return(aa)

-## }

-

-

-## getPhyInfo <- function(phy) {

-##     line1 <- readLines(phy, n=1)

-##     res <- strsplit(line1, split="\\s")[[1]]

-##     res <- res[res != ""]

-

-##     return(list(num=as.numeric(res[1]), width=as.numeric(res[2])))

-## }

-

-## get_seqtype <- function(seq) {

-##     if (length(grep("[^-ACGT]+", seq[1])) == 0) {

-##         seq_type = "NT" ## NucleoTide

-##     } else {

-##         seq_type = "AA" ## Amino Acid

-##     }

-##     return(seq_type)

-## }

-

 reverse.treeview <- function(tv) {

     tv$data <- reverse.treeview.data(tv$data)

     return(tv)

@@ -256,91 +22,6 @@ reverse.treeview.data <- function(df) {

 }

-## jplace_treetext_to_phylo <- function(tree.text) {

-##     ## move edge label to node label separate by @

-##     tr <- gsub('(:[0-9\\.eE\\+\\-]+)\\{(\\d+)\\}', '\\@\\2\\1', tree.text)

-##     phylo <- read.tree(text=tr)

-##     if (length(grep('@', phylo$tip.label)) > 0) {

-##         phylo$node.label[1] %<>% gsub("(.*)\\{(\\d+)\\}", "\\1@\\2", .)

-##         tip.edgeNum <- as.numeric(gsub("[^@]*@(\\d*)", "\\1",phylo$tip.label))

-##         node.edgeNum <- as.numeric(gsub("[^@]*@(\\d*)", "\\1",phylo$node.label))

-##         phylo$tip.label %<>% gsub("@\\d+", "", .)

-##         phylo$node.label %<>% gsub("@\\d+", "", .)

-##         if (all(phylo$node.label == "")) {

-##             phylo$node.label <- NULL

-##         }

-

-##         N <- getNodeNum(phylo)

-##         edgeNum.df <- data.frame(node=1:N, edgeNum=c(tip.edgeNum, node.edgeNum))

-##         ## root node is not encoded with edge number

-##         edgeNum.df <- edgeNum.df[!is.na(edgeNum.df[,2]),]

-##         attr(phylo, "edgeNum") <- edgeNum.df

-##     }

-

-##     ## using :edge_length{edge_num} to match edge_num to node_num

-##     ## this is not a good idea since there may exists identical edge_length.

-##     ## but we can use it to verify our method.

-##     ##

-##     ## en.matches <- gregexpr(":[0-9\\.eE\\+\\-]+\\{\\d+\\}", tree.text)

-##     ## matches <- en.matches[[1]]

-##     ## match.pos <- as.numeric(matches)

-##     ## match.len <- attr(matches, 'match.length')

-

-##     ## edgeLN <- substring(tree.text, match.pos+1, match.pos+match.len-2)

-##     ## edgeLN.df <- data.frame(length=as.numeric(gsub("\\{.+", "", edgeLN)),

-##     ##                         edgeNum = as.numeric(gsub(".+\\{", "", edgeLN)))

-

-##     ## xx <- merge(edgeLN.df, edgeNum.df, by.x="node", by.y="node")

-

-##     return(phylo)

-## }

-

-extract.treeinfo.jplace <- function(object, layout="rectangular", ladderize=TRUE, right=FALSE, ...) {

-

-    tree <- get.tree(object)

-

-    df <- fortify.phylo(tree, layout=layout, ladderize=ladderize, right=right, ...)

-

-    edgeNum.df <- attr(tree, "edgeNum")

-    if (!is.null(edgeNum.df)) {

-        df2 <- merge(df, edgeNum.df, by.x="node", by.y="node", all.x=TRUE)

-        df <- df2[match(df[, "node"], df2[, "node"]),]

-    }

-

-    attr(df, "ladderize") <- ladderize

-    attr(df, "right") <- right

-    return(df)

-}

-

-## ## convert edge number to node number for EPA/pplacer output

-## edgeNum2nodeNum <- function(jp, edgeNum) {

-##     edges <- attr(jp@phylo, "edgeNum")

-

-##     idx <- which(edges$edgeNum == edgeNum)

-##     if (length(idx) == 0) {

-##         return(NA)

-##     }

-

-##     edges[idx, "node"]

-## }

-

-## is.character_beast <- function(stats3, cn) {

-##     for (i in 1:nrow(stats3)) {

-##         if ( is.na(stats3[i,cn]) ) {

-##             next

-##         } else {

-##             ## res <- grepl("[a-df-zA-DF-Z]+", unlist(stats3[i, cn]))

-##             ## return(all(res == TRUE))

-##             res <- grepl("^[0-9\\.eE-]+$", unlist(stats3[i, cn]))

-##             return(all(res == FALSE))

-##         }

-##     }

-##     return(FALSE)

-## }

-

-

-

-

 color_scale <- function(c1="grey", c2="red", n=100) {

     pal <- colorRampPalette(c(c1, c2))

     colors <- pal(n)

@@ -384,22 +65,6 @@ is.tree_attribute_ <- function(p, var) {

-

-## `%IN%` <- function(x, table) {

-##     ii <- NULL ## satisify codetools

-##     idx <- match(x, table, nomatch=NA)

-##     ii <<- idx[!is.na(idx)]

-##     res <- as.logical(idx)

-##     res[is.na(res)] <- FALSE

-##     return(res)

-## }

-## geom_nplace <- function(data, map, place, ...) {

-##     label <- NULL

-##     ii <- 1:nrow(data)

-##     geom_text(subset=.(label %IN% data[[map]]), label = data[ii, place], ...)

-## }

-

-

 roundDigit <- function(d) {

     i <- 0

     while(d < 1) {

@@ -339,25 +339,6 @@ extract.treeinfo.jplace <- function(object, layout="rectangular", ladderize=TRUE

 ## }

-is.tree <- function(x) {

-    if (class(x) %in% c("phylo",

-                        "phylo4",

-                        "jplace",

-                        "baseml",

-                        "paml_rst",

-                        "baseml_mlc",

-                        "codeml_mlc",

-                        "codeml",

-                        "hyphy",

-                        "beast",

-                        "phangorn",

-                        "treedata")

-        ) {

-        return(TRUE)

-    }

-    return(FALSE)

-}

-

 color_scale <- function(c1="grey", c2="red", n=100) {

@@ -350,7 +350,8 @@ is.tree <- function(x) {

                         "codeml",

                         "hyphy",

                         "beast",

-                        "phangorn")

+                        "phangorn",

+                        "treedata")

         ) {

         return(TRUE)

     }

@@ -349,7 +349,8 @@ is.tree <- function(x) {

                         "codeml_mlc",

                         "codeml",

                         "hyphy",

-                        "beast")

+                        "beast",

+                        "phangorn")

         ) {

         return(TRUE)

     }

@@ -459,14 +459,7 @@ getCols <- function (n) {

     colorRampPalette(col3)(n)

 }

-

-get_fun_from_pkg <- function(pkg, fun) {

-    ## requireNamespace(pkg)

-    ## eval(parse(text=paste0(pkg, "::", fun)))

-    require(pkg, character.only = TRUE)

-    eval(parse(text = fun))

-}

-

+##' @importFrom rvcheck get_fun_from_pkg

 hist <- get_fun_from_pkg("graphics", "hist")

@@ -1,8 +1,6 @@

-

-

 ##' @importFrom ggplot2 last_plot

 get_tree_view <- function(tree_view) {

     if (is.null(tree_view))

@@ -297,22 +297,22 @@ reverse.treeview.data <- function(df) {

 ##     return(phylo)

 ## }

-## extract.treeinfo.jplace <- function(object, layout="phylogram", ladderize=TRUE, right=FALSE, ...) {

+extract.treeinfo.jplace <- function(object, layout="rectangular", ladderize=TRUE, right=FALSE, ...) {

-##     tree <- get.tree(object)

+    tree <- get.tree(object)

-##     df <- fortify.phylo(tree, layout=layout, ladderize=ladderize, right=right, ...)

+    df <- fortify.phylo(tree, layout=layout, ladderize=ladderize, right=right, ...)

-##     edgeNum.df <- attr(tree, "edgeNum")

-##     if (!is.null(edgeNum.df)) {

-##         df2 <- merge(df, edgeNum.df, by.x="node", by.y="node", all.x=TRUE)

-##         df <- df2[match(df[, "node"], df2[, "node"]),]

-##     }

+    edgeNum.df <- attr(tree, "edgeNum")

+    if (!is.null(edgeNum.df)) {

+        df2 <- merge(df, edgeNum.df, by.x="node", by.y="node", all.x=TRUE)

+        df <- df2[match(df[, "node"], df2[, "node"]),]

+    }

-##     attr(df, "ladderize") <- ladderize

-##     attr(df, "right") <- right

-##     return(df)

-## }

+    attr(df, "ladderize") <- ladderize

+    attr(df, "right") <- right

+    return(df)

+}