Browse code

add graph layout

xiangpin authored on 09/12/2021 13:33:49
Showing2 changed files

... ...
@@ -16,6 +16,7 @@
16 16
 ##' @param branch.length variable for scaling branch, if 'none' draw cladogram
17 17
 ##' @param root.position position of the root node (default = 0)
18 18
 ##' @param xlim x limits, only works for 'inward_circular' layout
19
+##' @param layout.params list, the parameters of layout, when layout is a function.
19 20
 ##' @return tree
20 21
 ##' @importFrom ggplot2 ggplot
21 22
 ##' @importFrom ggplot2 xlab
... ...
@@ -53,12 +54,22 @@ ggtree <- function(tr,
53 54
                    branch.length  = "branch.length",
54 55
                    root.position  = 0,
55 56
                    xlim = NULL,
57
+                   layout.params = list(),
56 58
                    ...) {
57 59
 
58 60
     # Check if layout string is valid.
59
-    layout %<>% match.arg(c("rectangular", "slanted", "fan", "circular", 'inward_circular',
61
+    trash <- try(silent = TRUE,
62
+                 expr = {
63
+                   layout %<>% match.arg(c("rectangular", "slanted", "fan", "circular", 'inward_circular',
60 64
                             "radial", "unrooted", "equal_angle", "daylight", "dendrogram",
61 65
                             "ape", "ellipse", "roundrect"))
66
+                  }
67
+             )
68
+
69
+    dd <- check.graph.layout(tr, trash, layout, layout.params)
70
+    if (inherits(trash, "try-error") && !is.null(dd)){
71
+        layout <- "rectangular"
72
+    }
62 73
 
63 74
     if (layout == "unrooted") {
64 75
         layout <- "daylight"
... ...
@@ -89,6 +100,15 @@ ggtree <- function(tr,
89 100
                 root.position = root.position,
90 101
                 ...)
91 102
 
103
+    if (!is.null(dd)){
104
+        p$data <- dplyr::left_join(
105
+                    p$data %>% select(-c("x", "y")), 
106
+                    dd, 
107
+                    by = "node"
108
+        )
109
+        layout <- "equal_angle"
110
+    }
111
+
92 112
     if (is(tr, "multiPhylo")) {
93 113
         multiPhylo <- TRUE
94 114
     } else {
... ...
@@ -154,3 +174,30 @@ ggtree_references <- function() {
154 174
            "<http://yulab-smu.top/treedata-book/>\n"
155 175
            )
156 176
 }
177
+
178
+check.graph.layout <- function(tr, trash, layout, layout.params){
179
+    if (inherits(trash, "try-error")){
180
+        gp <- ape::as.igraph.phylo(as.phylo(tr), use.labels = FALSE)
181
+        #dd <- ggraph::create_layout(gp, layout = layout)
182
+        if (is.function(layout)){
183
+            dd <- do.call(layout, c(list(gp), layout.params))
184
+            if (!inherits(dd, "matrix")){
185
+                if ("xy" %in% names(dd)){
186
+                    dd <- dd$xx
187
+                }else if ("layout" %in% names(dd)){
188
+                    dd <- dd$layout
189
+                }else{
190
+                    stop(trash, call. = FALSE)
191
+                }
192
+            }
193
+            dd <- data.frame(dd)
194
+            colnames(dd) <- c("x", "y")
195
+            dd$node <- seq_len(nrow(dd))
196
+        }else{
197
+            stop(trash, call. = FALSE)
198
+        }
199
+    }else{
200
+        dd <- NULL
201
+    }
202
+    return(dd)
203
+}
... ...
@@ -21,6 +21,7 @@ ggtree(
21 21
   branch.length = "branch.length",
22 22
   root.position = 0,
23 23
   xlim = NULL,
24
+  layout.params = list(),
24 25
   ...
25 26
 )
26 27
 }
... ...
@@ -54,6 +55,8 @@ right-hand side? See \code{\link[ape:ladderize]{ape::ladderize()}} for more info
54 55
 
55 56
 \item{xlim}{x limits, only works for 'inward_circular' layout}
56 57
 
58
+\item{layout.params}{list, the parameters of layout, when layout is a function.}
59
+
57 60
 \item{...}{additional parameter
58 61
 
59 62
 some dot arguments: