Skip to content

Commit

Permalink
Merge pull request #92 from xiangpin/full_join.update
Browse files Browse the repository at this point in the history
update full_join method
  • Loading branch information
GuangchuangYu authored Mar 2, 2023
2 parents db85803 + 0103b55 commit 2195cc8
Show file tree
Hide file tree
Showing 5 changed files with 43 additions and 26 deletions.
5 changes: 3 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,8 @@ Imports:
rlang,
tibble,
tidytree (>= 0.3.9),
utils
utils,
cli
Suggests:
Biostrings,
ggplot2,
Expand All @@ -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
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
52 changes: 30 additions & 22 deletions R/full-join.R
Original file line number Diff line number Diff line change
@@ -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, ...)
}
4 changes: 2 additions & 2 deletions R/method-as-phylo.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
}

Expand Down
7 changes: 7 additions & 0 deletions R/tree-utilities.R
Original file line number Diff line number Diff line change
Expand Up @@ -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')

0 comments on commit 2195cc8

Please sign in to comment.