update full_join method

DESCRIPTION

@@ -22,7 +22,8 @@ Imports:
     rlang,
     tibble,
     tidytree (>= 0.3.9),
-    utils
+    utils,
+    cli
 Suggests:
     Biostrings,
     ggplot2,
@@ -46,4 +47,4 @@ URL: https://github.com/YuLab-SMU/treeio (devel), https://docs.ropensci.org/tree
 BugReports: https://github.com/YuLab-SMU/treeio/issues
 biocViews: Software, Annotation, Clustering, DataImport, DataRepresentation,
     Alignment, MultipleSequenceAlignment, Phylogenetics
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3

NAMESPACE

@@ -152,6 +152,7 @@ importFrom(ape,trans)
 importFrom(ape,which.edge)
 importFrom(ape,write.nexus)
 importFrom(ape,write.tree)
+importFrom(cli,cli_warn)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,filter)
 importFrom(dplyr,full_join)

R/full-join.R

@@ -1,37 +1,45 @@
 ##' @importFrom dplyr full_join
 ##' @importFrom tibble tibble
+##' @importFrom cli cli_warn
 ##' @method full_join treedata
 ##' @export
 full_join.treedata <- function(x, y, by = NULL,
-                               copy = FALSE, suffix = c(".x", ".y"), ...) {
+                               copy = FALSE, suffix = c("", ".y"), ...) {
 
-    by <- match.arg(by, c("node", "label"))
-    y <- as_tibble(y)
-    if (by == "label") {
-        ntip <- Ntip(x)
-        N <- Nnode2(x)
-        label <- rep(NA, N)
-        label[1:ntip] <- x@phylo[["tip.label"]]
-        if (!is.null(x@phylo$node.label)) {
-            label[(ntip+1):N] <- x@phylo$node.label
-        }
-        lab <- tibble(node = 1:N, label = label)
-        y <- full_join(lab, y, by = "label") %>% select(-.data$label)
+    dat <- .extract_annotda.treedata(x)
+    ornm <- colnames(dat)
+    msg <- c("The {.arg suffix} requires a character vector containing 2 different elements,",
+             "The first element must be \"\", and the second element must not be \"\",",
+             "it was set {.code suffix=c(\"\", \".y\")} automatically.")
+    if (all(nchar(suffix)!=0)){
+        cli::cli_warn(msg)
+        suffix[1] = ""
     }
+    if (all(nchar(suffix)==0)){
+        cli::cli_warn(msg)
+        suffix[2] = ".y"
+    }
+    if (nchar(suffix[1])!=0 && nchar(suffix[2])==0){
+        cli::cli_warn(msg)
+        suffix <- rev(suffix[seq_len(2)])
+    }
+
+    da <- dplyr::full_join(dat, y, by = by, copy = copy, suffix = suffix, ...)
 
-    if (nrow(x@extraInfo) == 0) {
-        x@extraInfo <- y
-    } else {
-        x@extraInfo <- full_join(x@extraInfo, y, by = "node", copy = copy, suffix = suffix)
+    da <- da[!is.na(da$node),]
+
+    if (any(duplicated(da$node))){
+        da %<>% .internal_nest(keepnm=ornm)
     }
-    return(x)
+
+    tr <- .update.td.join(td=x, da=da)
+    return(tr)    
 }
 
 ##' @method full_join phylo
 ##' @export
 full_join.phylo <- function(x, y, by = NULL,
-                            copy = FALSE, suffix = c(".x", ".y"), ...) {
-    full_join(as_tibble(x), y = y, by = by,
-              copy = copy, suffix = suffix, ...) %>%
-        as.treedata
+                            copy = FALSE, suffix = c("", ".y"), ...) {
+    full_join(as.treedata(x), y = y, by = by,
+              copy = copy, suffix = suffix, ...)
 }

R/method-as-phylo.R

@@ -8,12 +8,12 @@ ape::as.phylo
 ##' @importFrom dplyr mutate_if
 ##' @export
 as.phylo.tbl_df <- function(x, branch.length, label, ...) {
-    x <- as_tibble(x) %>% mutate_if(is.factor, as.character)
+    x <- data.frame(x) %>% mutate_if(is.factor, as.character)
     branch.length <- rlang::enquo(branch.length)
     label <- rlang::enquo(label)
     length_var <- root.edge <- edge.length <- NULL
     tip.label <- node.label <- labels <- NULL
-    if (nrow(unique(x[, 1])) > nrow(unique(x[,2]))){
+    if (nrow(unique(x[, 1, drop=FALSE])) > nrow(unique(x[, 2, drop=FALSE]))){
         x %<>% dplyr::select(rev(seq_len(2)), seq_len(ncol(x)))
     }
 

R/tree-utilities.R

@@ -96,3 +96,10 @@ getNodeName <- function(tr) {
     return(nodeName)
 }
 
+
+.extract_annotda.treedata <- getFromNamespace('.extract_annotda.treedata', 'tidytree')
+
+.internal_nest <- getFromNamespace('.internal_nest', 'tidytree')
+
+.update.td.join <- getFromNamespace('.update.td.join', 'tidytree')
+