Browse code

Merge pull request #517 from xiangpin/master

adjust the height of hclust-like class with dendrogram layout

Guangchuang Yu authored on 21/07/2022 09:21:37 • GitHub committed on 21/07/2022 09:21:37
Showing6 changed files

... ...
@@ -113,10 +113,14 @@ scale_x_range <- function() {
113 113
 ##' p2 + scale_x_continuous(labels=abs)
114 114
 ##' @author Guangchuang Yu
115 115
 revts <- function(treeview) {
116
+    if (attr(treeview$data, 'revts.done')){
117
+         return(treeview)
118
+    }
116 119
     x <- treeview$data$x
117 120
     mx <- max(x, na.rm=TRUE)
118 121
     treeview$data$x <- x - mx
119 122
     treeview$data$branch <- treeview$data$branch - mx
123
+	tip.edge.len <- attr(treeview$data, 'tip.edge.len')
120 124
     treeview
121 125
 }
122 126
 
... ...
@@ -17,6 +17,9 @@
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 19
 ##' @param layout.params list, the parameters of layout, when layout is a function.
20
+##' @param hang numeric The fraction of the tree plot height by which labels should hang 
21
+##' below the rest of the plot. A negative value will cause the labels to hang down from 0. This
22
+##' parameter only work with the 'dendrogram' layout for 'hclust' like class, default is 0.1.
20 23
 ##' @return tree
21 24
 ##' @importFrom ggplot2 ggplot
22 25
 ##' @importFrom ggplot2 xlab
... ...
@@ -59,6 +62,7 @@ ggtree <- function(tr,
59 62
                    root.position  = 0,
60 63
                    xlim = NULL,
61 64
                    layout.params = list(),
65
+                   hang = .1,
62 66
                    ...) {
63 67
 
64 68
     # Check if layout string is valid.
... ...
@@ -102,6 +106,7 @@ ggtree <- function(tr,
102 106
                 right         = right,
103 107
                 branch.length = branch.length,
104 108
                 root.position = root.position,
109
+                hang          = hang,
105 110
                 ...)
106 111
 
107 112
     if (!is.null(dd)){
... ...
@@ -133,19 +133,28 @@ fortify.phylo4 <- function(model, data,
133 133
                            ladderize = TRUE,
134 134
                            right     = FALSE,
135 135
                            mrsd      = NULL,
136
+                           hang      = .1,
136 137
                            ...) {
137 138
     if (inherits(model, c("dendrogram", "agnes", "diana", "twins"))) {
138 139
         model <- stats::as.hclust(model)
139 140
     }
140 141
 
141 142
     if (inherits(model, "hclust")) {
142
-        phylo <- as.phylo.hclust2(model)
143
+        phylo <- as.phylo.hclust2(model, hang = hang)
143 144
     } else {
144 145
         phylo <- as.phylo(model)
145 146
     }
146 147
 
147 148
     df <- fortify.phylo(phylo, data,
148 149
                         layout, ladderize, right, mrsd=mrsd, ...)
150
+    mx <- max(df$x, na.rm=TRUE)
151
+    df$x <- df$x - mx
152
+    df$branch <- df$branch - mx
153
+    tip.edge.len <- attr(phylo, 'tip.edge.len')
154
+    if (!is.null(tip.edge.len)){
155
+        df[df$isTip, "x", drop=TRUE] <- tip.edge.len
156
+    }
157
+    attr(df, 'revts.done') = TRUE
149 158
     scaleY(phylo, df, yscale, layout, ...)
150 159
 }
151 160
 
... ...
@@ -100,7 +100,7 @@ ggplot_add.layout_ggtree <- function(object, plot, object_name) {
100 100
 
101 101
     if (object$layout == 'dendrogram') {
102 102
         plot <- revts(plot)
103
-        obj <- list(scale_x_reverse(labels = abs),
103
+        obj <- list(scale_x_reverse(labels = function(x){-x}),
104 104
                     coord_flip(clip = 'off')
105 105
                     )
106 106
     } else if (object$layout == 'circular' || object$layout == "inward_circular") {
... ...
@@ -202,8 +202,16 @@ ggplot_add.facet_plot <- function(object, plot, object_name) {
202 202
 ##' @export
203 203
 ggplot_add.tiplab <- function(object, plot, object_name) {
204 204
     layout <- get_layout(plot)
205
-    if (layout == 'dendrogram' && object$hjust == 0 ){
206
-        object$hjust <- .5
205
+    if (layout == 'dendrogram'){
206
+        if( object$hjust == 0 ){
207
+            object$hjust = 1
208
+        }
209
+        if (!'vjust' %in% names(object)){
210
+            object$vjust = .5
211
+        }
212
+        if (!'angle' %in% names(object)){
213
+            object$angle = 90
214
+        }
207 215
     }
208 216
     if (object$as_ylab) {
209 217
         if (layout != "rectangular" && layout != "dendrogram") {
... ...
@@ -1355,14 +1355,21 @@ as.phylo.hclust2 <- function(x, hang=0.1, ...) {
1355 1355
     }
1356 1356
   }
1357 1357
 
1358
-  len <- numeric(max(tr$edge))
1359
-  len[nodes] <- h$height
1360
-  pn <- ev[nodes]
1361
-  pn[pn == 0] <- treeio::rootnode(tr)
1362
-  len[nodes] <- len[pn] - len[nodes]
1363
-  len[1:Ntip(tr)] <- hang #max(h$height)/10
1364
-
1365
-  tr$edge.length <- len[tr$edge[,2]]
1358
+  #len <- numeric(max(tr$edge))
1359
+  #len[nodes] <- h$height
1360
+  #pn <- ev[nodes]
1361
+  #pn[pn == 0] <- treeio::rootnode(tr)
1362
+  #len[nodes] <- len[pn] - len[nodes]
1363
+  #len[1:Ntip(tr)] <- hang #max(h$height)/10
1364
+
1365
+  #tr$edge.length <- len[tr$edge[,2]]
1366
+
1367
+  tip2parent <- tr$edge[match(seq_len(Ntip(tr)), tr$edge[,2]), 1]
1368
+  if (hang > 0){
1369
+    tip.edge.len <- hang * max(h$height) - h$height[match(tip2parent, nodes)]
1370
+    attr(tr,'tip.edge.len') <- tip.edge.len
1371
+  }
1372
+  tr$edge.length <- tr$edge.length * 2
1366 1373
   return(tr)
1367 1374
 }
1368 1375
 
... ...
@@ -22,6 +22,7 @@ ggtree(
22 22
   root.position = 0,
23 23
   xlim = NULL,
24 24
   layout.params = list(),
25
+  hang = 0.1,
25 26
   ...
26 27
 )
27 28
 }
... ...
@@ -57,6 +58,10 @@ right-hand side? See \code{\link[ape:ladderize]{ape::ladderize()}} for more info
57 58
 
58 59
 \item{layout.params}{list, the parameters of layout, when layout is a function.}
59 60
 
61
+\item{hang}{numeric The fraction of the tree plot height by which labels should hang
62
+below the rest of the plot. A negative value will cause the labels to hang down from 0. This
63
+parameter only work with the 'dendrogram' layout for 'hclust' like class, default is 0.1.}
64
+
60 65
 \item{...}{additional parameter
61 66
 
62 67
 some dot arguments: