Browse code

hclust for all layout and update geom_tiplab type of dendrogram layout

xiangpin authored on 20/07/2022 12:05:44
Showing3 changed files

... ...
@@ -113,14 +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
120 123
 	tip.edge.len <- attr(treeview$data, 'tip.edge.len')
121
-    if (!is.null(tip.edge.len)){
122
-        treeview$data[treeview$data$isTip,"x", drop=TRUE] <- tip.edge.len
123
-    }
124 124
     treeview
125 125
 }
126 126
 
... ...
@@ -139,7 +139,7 @@ fortify.phylo4 <- function(model, data,
139 139
         model <- stats::as.hclust(model)
140 140
     }
141 141
 
142
-    if (inherits(model, "hclust") && layout == 'dendrogram') {
142
+    if (inherits(model, "hclust")) {
143 143
         phylo <- as.phylo.hclust2(model, hang = hang)
144 144
     } else {
145 145
         phylo <- as.phylo(model)
... ...
@@ -147,9 +147,14 @@ fortify.phylo4 <- function(model, data,
147 147
 
148 148
     df <- fortify.phylo(phylo, data,
149 149
                         layout, ladderize, right, mrsd=mrsd, ...)
150
-    if (!is.null(attr(phylo, 'tip.edge.len'))){
151
-        attr(df, 'tip.edge.len') <- attr(phylo, 'tip.edge.len')
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
152 156
     }
157
+    attr(df, 'revts.done') = TRUE
153 158
     scaleY(phylo, df, yscale, layout, ...)
154 159
 }
155 160
 
... ...
@@ -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") {