diff --git a/DESCRIPTION b/DESCRIPTION index d89aa3e..f7fce34 100644 --- a/DESCRIPTION +++ b/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 diff --git a/NAMESPACE b/NAMESPACE index 8b6834a..77a398f 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/full-join.R b/R/full-join.R index c88d4dc..bbf0d7b 100644 --- a/R/full-join.R +++ b/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, ...) } diff --git a/R/method-as-phylo.R b/R/method-as-phylo.R index 8d123c2..2d663a4 100644 --- a/R/method-as-phylo.R +++ b/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))) } diff --git a/R/tree-utilities.R b/R/tree-utilities.R index b60ecfc..0252da6 100644 --- a/R/tree-utilities.R +++ b/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') +