Browse code

slanted layout when branch.length is none

xiangpin authored on 29/04/2022 06:50:09
Showing2 changed files

... ...
@@ -32,14 +32,20 @@ fortify.phylo <- function(model, data,
32 32
     if (layout %in% c("equal_angle", "daylight", "ape")) {
33 33
         res <- layout.unrooted(model, layout.method = layout, branch.length = branch.length, ...)
34 34
     } else {
35
+        ypos <- getYcoord(x)
36
+        N <- Nnode(x, internal.only=FALSE)
35 37
         if (is.null(x$edge.length) || branch.length == "none") {
36
-            xpos <- getXcoord_no_length(x)
38
+            if (layout == 'slanted'){
39
+                sbp <- .convert_tips2ancestors_sbp(x, include.root = TRUE)
40
+                xpos <- getXcoord_no_length_slanted(sbp)
41
+                ypos <- getYcoord_no_length_slanted(sbp)  
42
+            }else{
43
+                xpos <- getXcoord_no_length(x)
44
+            }
37 45
         } else {
38 46
             xpos <- getXcoord(x)
39 47
         }
40 48
 
41
-        ypos <- getYcoord(x)
42
-        N <- Nnode(x, internal.only=FALSE)
43 49
         xypos <- tibble::tibble(node=1:N, x=xpos + root.position, y=ypos)
44 50
 
45 51
         df <- as_tibble(model) %>%
... ...
@@ -1244,3 +1244,54 @@ layoutApe <- function(model, branch.length="branch.length") {
1244 1244
 	class(tree_df) <- c("tbl_tree", class(tree_df))
1245 1245
 	tree_df
1246 1246
 }
1247
+
1248
+.nodeId <- function (tree, type = "all"){
1249
+    type <- match.arg(type, c("all", "tips", "internal"))
1250
+    if (inherits(tree, "treedata")) {
1251
+        tree <- tree@phylo
1252
+    }
1253
+    nodes <- unique(as.vector(tree$edge))
1254
+    if (type == "all") {
1255
+        return(nodes)
1256
+    }
1257
+    edge <- tree$edge
1258
+    tips <- edge[!edge[, 2] %in% edge[, 1], 2]
1259
+    if (type == "tips"){
1260
+        return(tips)
1261
+    }
1262
+    else if (type == "internal") {
1263
+        return(setdiff(nodes, tips))
1264
+    }
1265
+}
1266
+
1267
+.convert_tips2ancestors_sbp <- function (tree, include.root = FALSE, type = "all", include.self = TRUE){
1268
+    all.nodes <- .nodeId(tree)
1269
+    if (!include.root) {
1270
+        all.nodes <- setdiff(all.nodes, treeio::rootnode(tree))
1271
+    }
1272
+    tip.nodes <- .nodeId(tree, type = "tips")
1273
+    .internal_anc <- switch(type, all = treeio::ancestor, parent = treeio::parent)
1274
+    ancestor <- lapply(tip.nodes, .internal_anc, .data = tree)
1275
+    if (include.self) {
1276
+        ancestor <- mapply(append, tip.nodes, ancestor, SIMPLIFY = FALSE)
1277
+    }
1278
+    sbp <- lapply(ancestor, function(i) all.nodes %in% i) %>%
1279
+        stats::setNames(tip.nodes) %>% do.call(rbind, .) 
1280
+    colnames(sbp) <- all.nodes
1281
+    return(sbp)
1282
+}
1283
+
1284
+getXcoord_no_length_slanted <- function(x){
1285
+    x <- -colSums(x)
1286
+    x <- unname(x[order(as.numeric(names(x)))])
1287
+    x <- x + max(abs(x))
1288
+    return(x)
1289
+}
1290
+
1291
+getYcoord_no_length_slanted <- function(y){
1292
+    y <- seq_len(nrow(y)) * y
1293
+    y[y==0] <- NA
1294
+    y <- colMeans(y, na.rm = TRUE)
1295
+    y <- unname(y[order(as.numeric(names(y)))])
1296
+    return(y)
1297
+}