Integrate agglomerateBy* functions (microbiome#554)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mia
 Type: Package
-Version: 1.13.16
+Version: 1.13.17
 Authors@R:
     c(person(given = "Felix G.M.", family = "Ernst", role = c("aut"),
              email = "[email protected]",

R/agglomerate.R

@@ -376,17 +376,12 @@ setMethod(
                 # dataset could be presented with one tree. 
                 # --> order the data so that the taxa are searched from one tree 
                 # first.
-                if( length(x@rowTree) > 1 ){
+                if( length(rowTreeNames(x)) > 1 ){
                     x <- .order_based_on_trees(x)
                 }
                 # Agglomerate data
-                x <- callNextMethod(x, ...)
-                # Agglomerate also trees if user has specified and if there
-                # are trees available
-                if( agglomerate.tree && !is.null(x@rowTree) ){
-                    x <- .agglomerate_trees(x)
-                }
-                x
+                x <- callNextMethod(x, mergeTree = agglomerate.tree, ...)
+                return(x)
             }
 )
 
@@ -450,32 +445,43 @@ setMethod(
 
 # Agglomerate all rowTrees found in TreeSE object. Get tips that represent
 # rows and remove all others.
-.agglomerate_trees <- function(x){
+.agglomerate_trees <- function(x, MARGIN = 1){
+    # Get right functions based on direction
+    tree_names_FUN <- switch(
+        MARGIN, "1" = rowTreeNames, "2" = colTreeNames, stop("."))
+    links_FUN <- switch(MARGIN, "1" = rowLinks, "2" = colLinks, stop("."))
+    tree_FUN <- switch(MARGIN, "1" = rowTree, "2" = colTree, stop("."))
+    # Get right argument names for changeTree call
+    args_names <- switch(
+        MARGIN, "1" = c("x", "rowTree", "rowNodeLab", "whichRowTree"),
+        "2" = c("x", "colTree", "colNodeLab", "whichColTree"),
+        stop("."))
     # Get names of trees and links between trees and rows
-    tree_names <- rowTreeNames(x)
-    row_links <- rowLinks(x)
+    tree_names <- tree_names_FUN(x)
+    row_links <- links_FUN(x)
     # Loop through tree names
     for( name in tree_names ){
         # Get the tree that is being agglomerated
-        tree <- rowTree(x, name)
+        tree <- tree_FUN(x, name)
         # Get row links that corresponds this specific tree
         links_temp <- row_links[ row_links[["whichTree"]] == name, ]
         # If the tree represents the data, agglomerate it
         if( nrow(links_temp) > 0 ){
-            # For each row, get corresponding node from the tree
+            # Get names of nodes that are preserved
             links_temp <- links_temp[["nodeLab"]]
             # Agglomerate the tree
             tree <- .prune_tree(tree, links_temp)
             # Change the tree with agglomerated version
-            x <- changeTree(
-                x, rowTree = tree,
-                whichRowTree = name, rowNodeLab = links_temp)
+            args <- list(x, tree, links_temp, name)
+            names(args) <- args_names
+            x <- do.call(changeTree, args)
         }
     }
     return(x)
 }
 
-# This function trims tips until all tips can be found from provided set of nodes
+# This function trims tips until all tips can be found from provided set of
+# nodes
 #' @importFrom ape drop.tip has.singles collapse.singles
 .prune_tree <- function(tree, nodes){
     # Get those tips that can not be found from provided nodes
@@ -502,7 +508,8 @@ setMethod(
             warning("Pruning resulted to empty tree.", call. = FALSE)
             break
         }
-        # Again, get those tips of updated tree that cannot be found from provided nodes
+        # Again, get those tips of updated tree that cannot be found from
+        # provided nodes
         remove_tips <- tree$tip.label[!tree$tip.label %in% nodes]
     }
     # Simplify the tree structure. Remove nodes that have only single

R/merge.R

@@ -173,62 +173,6 @@
     .merge_cols(x, f, archetype = archetype, ...)
 }
 
-.merge_tree <- function(tree, links){
-    tips <- sort(setdiff(tree$edge[, 2], tree$edge[, 1]))
-    drop_tip <- tips[!(tips %in% unique(links$nodeNum[links$isLeaf]))]
-    oldTree <- tree
-    newTree <- ape::drop.tip(oldTree, tip = drop_tip)
-    track <- trackNode(oldTree)
-    track <- ape::drop.tip(track, tip = drop_tip)
-    #
-    oldAlias <- links$nodeLab_alias
-    newNode <- convertNode(tree = track, node = oldAlias)
-    newAlias <- convertNode(tree = newTree, node = newNode)
-    #
-    list(newTree = newTree, newAlias = newAlias)
-}
-
-# Merge trees, MARGIN specifies if trees are rowTrees or colTrees
-.merge_trees <- function(x, mergeTree, MARGIN){
-    # Get rowtrees or colTrees based on MARGIN
-    if( MARGIN == 1 ){
-        trees <- x@rowTree
-        links <- rowLinks(x)
-    } else{
-        trees <- x@colTree
-        links <- colLinks(x)
-    }
-    # If trees exist and mergeTree is TRUE
-    if(!is.null(trees) && mergeTree){
-        # Loop over trees and replace them one by one
-        for( i in seq_len(length(trees)) ){
-            # Get tree
-            tree <- trees[[i]]
-            # Get the name of the tree
-            tree_name <- names(trees)[[i]]
-            # Subset links by taking only those rows that are included in tree
-            links_sub <- links[ links$whichTree == tree_name, , drop = FALSE ]
-            # Merge tree
-            tmp <- .merge_tree(tree, links_sub)
-            # Based on MARGIN, replace ith rowTree or colTree
-            if( MARGIN == 1 ){
-                x <- changeTree(x = x,
-                                rowTree = tmp$newTree,
-                                rowNodeLab = tmp$newAlias,
-                                whichRowTree = i
-                )
-            } else{
-                x <- changeTree(x = x,
-                                colTree = tmp$newTree,
-                                colNodeLab = tmp$newAlias,
-                                whichColTree = i
-                )
-            }
-        }
-    }
-    return(x)
-}
-
 #' @importFrom Biostrings DNAStringSetList
 .merge_refseq_list <- function(sequences_list, f, names, ...){
     threshold <- list(...)[["threshold"]]
@@ -271,16 +215,16 @@
     #
     x <- .merge_rows_SE(x, f, archetype = 1L, ...)
     # optionally merge rowTree
-    x <- .merge_trees(x, mergeTree, 1)
+    if( mergeTree ){
+        x <- .agglomerate_trees(x, 1)
+    }
     # optionally merge referenceSeq
     if(!is.null(refSeq)){
         referenceSeq(x) <- .merge_refseq_list(refSeq, f, rownames(x), ...)
     }
     x
 }
 
-
-
 .merge_cols_TSE <- function(x, f, archetype = 1L, mergeTree = FALSE, ...){
     # input check
     if(!.is_a_bool(mergeTree)){
@@ -289,6 +233,8 @@
     #
     x <- .merge_cols_SE(x, f, archetype = 1L, ...)
     # optionally merge colTree
-    x <- .merge_trees(x, mergeTree, 2)
+    if( mergeTree ){
+        x <- .agglomerate_trees(x, 2)
+    }
     return(x)
 }