Browse code

update_edge_hclust

Guangchuang Yu authored on 04/06/2022 17:02:02
Showing3 changed files

... ...
@@ -1,7 +1,7 @@
1 1
 Package: ggtree
2 2
 Type: Package
3 3
 Title: an R package for visualization of tree and annotation data
4
-Version: 3.5.0.900
4
+Version: 3.5.0.901
5 5
 Authors@R: c(
6 6
        person("Guangchuang", "Yu",     email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph"), 
7 7
             comment = c(ORCID = "0000-0002-6485-8781")),
... ...
@@ -25,8 +25,9 @@
25 25
 
26 26
 -->
27 27
 
28
-# ggtree 3.5.0.900
28
+# ggtree 3.5.0.901
29 29
 
30
++ `update_edge_hclust()` to adjust edge length of a `phylo` object converted from a `hclust` object via `ape::as.phylo()` (2022-06-05, Sun)
30 31
 + new 'slanted' layout for `branch.length = 'none'` (2022-04-29, Fri, #497)
31 32
     - only works for Cartesian coordination, that means it will not work for `layout = 'radial'`
32 33
 
... ...
@@ -904,9 +904,7 @@ getYcoord <- function(tr, step=1, tip.order = NULL) {
904 904
     y[-tip.idx] <- NA
905 905
 
906 906
 
907
-    ## use lookup table
908
-    pvec <- integer(max(tr$edge))
909
-    pvec[child] = parent
907
+    pvec <- edge2vec(tr)
910 908
 
911 909
     currentNode <- 1:Ntip
912 910
     while(anyNA(y)) {
... ...
@@ -1308,3 +1306,47 @@ getYcoord_no_length_slanted <- function(y){
1308 1306
     y <- unname(y[order(as.numeric(names(y)))])
1309 1307
     return(y)
1310 1308
 }
1309
+
1310
+
1311
+edge2vec <- function(tr) {
1312
+  parent <- tr$edge[,1]
1313
+  child <- tr$edge[,2]
1314
+  
1315
+  ## use lookup table
1316
+  pvec <- integer(max(tr$edge))
1317
+  pvec[child] <- parent
1318
+  return(pvec)
1319
+}
1320
+
1321
+
1322
+extract_inode_hclust_item <- function(h, i, ev) {
1323
+  j <- h$merge[i,]
1324
+  if (any(j < 0)) {
1325
+    j2 <- j[j < 0][1]
1326
+    res <- ev[abs(j2)]
1327
+  } else {
1328
+    res <- ev[extract_inode_hclust_item(h, j, ev)]
1329
+  }
1330
+  return(res)
1331
+}
1332
+
1333
+
1334
+
1335
+# tr is converted from h via ape::as.phylo
1336
+update_edge_hclust <- function(tr, h) {
1337
+  ev <- edge2vec(tr)
1338
+  
1339
+  nodes <- vapply(seq_along(h$height), function(i) {
1340
+    extract_inode_hclust_item(h, i, ev)
1341
+  }, numeric(1))
1342
+  
1343
+  len <- numeric(max(tr$edge))
1344
+  len[nodes] <- h$height
1345
+  pn <- ev[nodes]
1346
+  pn[pn == 0] <- rootnode(tr)
1347
+  len[nodes] <- len[pn] - len[nodes]
1348
+  len[1:Ntip(tr)] <- max(h$height)/10
1349
+
1350
+  tr$edge.length <- len[tr$edge[,2]]
1351
+  return(tr)
1352
+}