Browse code

update geom_tiplab when label mapping as as_ylab

xiangpin authored on 11/08/2022 10:56:00
Showing1 changed files

... ...
@@ -224,11 +224,11 @@ ggplot_add.tiplab <- function(object, plot, object_name) {
224 224
         ly <- do.call(geom_tiplab_rectangular, object)
225 225
         plot <- ggplot_add(ly, plot, object_name)
226 226
         object$size <- fontsize
227
-        object$mapping <- NULL
227
+        #object$mapping <- NULL
228 228
         object$align <- NULL
229 229
         object$linetype <- NULL
230 230
         object$linesize <- NULL
231
-        object$geom <- NULL
231
+        #object$geom <- NULL
232 232
         object$offset <- NULL
233 233
         object$nodelab <- NULL
234 234
         res <- ggplot_add.tiplab_ylab(object, plot, object_name)
... ...
@@ -259,11 +259,30 @@ ggplot_add.tiplab_ylab <- function(object, plot, object_name) {
259 259
     }
260 260
 
261 261
     df <- plot$data
262
-    df <- df[df$isTip, ]
262
+    if ('label' %in% names(object$mapping)){
263
+        if (object$geom == 'text'){
264
+            xx <- do.call('geom_text', list(mapping=object$mapping))
265
+            xx$computed_mapping <- c(xx$mapping, plot$mapping[setdiff(names(plot$mapping), names(xx$mapping))])
266
+            class(xx$computed_mapping) <- "uneval"
267
+            if (!is.null(object$data)){
268
+                df <- object$data
269
+            }else{
270
+                df <- df[df$isTip,]
271
+            }
272
+            df <- suppressWarnings(xx$compute_aesthetics(data=df, plot=plot))
273
+        }else{
274
+            message('The geom is not text, as_ylab will use original tip labels of tree')
275
+            df <- df[df$isTip, ]
276
+        }
277
+    }else{
278
+        df <- df[df$isTip, ]
279
+    }
263 280
     yscale <- scale_y_continuous(breaks = df$y, labels = df$label,
264 281
                                  position = object$position, expand = expansion(0, 0.6))
265 282
 
266 283
     object$position <- NULL
284
+    object$mapping <- NULL
285
+    object$geom <- NULL
267 286
     object$node <- NULL
268 287
     ytext <- do.call(element_text, object)
269 288