... | ... |
@@ -184,6 +184,7 @@ importFrom(magrittr,equals) |
184 | 184 |
importFrom(methods,is) |
185 | 185 |
importFrom(methods,missingArg) |
186 | 186 |
importFrom(tidyr,gather) |
187 |
+importFrom(treeio,as.phylo) |
|
187 | 188 |
importFrom(treeio,as.treedata) |
188 | 189 |
importFrom(treeio,get.placements) |
189 | 190 |
importFrom(treeio,groupClade) |
... | ... |
@@ -1,5 +1,6 @@ |
1 | 1 |
CHANGES IN VERSION 1.7.5 |
2 | 2 |
------------------------ |
3 |
+ o fortify.phylo4d via converting phylo4d to treedata object <2016-12-28, Wed> |
|
3 | 4 |
o improve viewClade function, use coord_cartesian instead of xlim <2016-12-28, Wed> |
4 | 5 |
o remove codes that move to treeio and now ggtree depends treeio <2016-12-20, Tue> |
5 | 6 |
|
... | ... |
@@ -389,10 +389,11 @@ scaleY <- function(phylo, df, yscale, layout, ...) { |
389 | 389 |
|
390 | 390 |
|
391 | 391 |
##' @method fortify phylo4 |
392 |
+##' @importFrom treeio as.phylo |
|
392 | 393 |
##' @export |
393 | 394 |
fortify.phylo4 <- function(model, data, layout="rectangular", yscale="none", |
394 | 395 |
ladderize=TRUE, right=FALSE, mrsd=NULL, ...) { |
395 |
- phylo <- as.phylo.phylo4(model) |
|
396 |
+ phylo <- as.phylo(model) |
|
396 | 397 |
df <- fortify.phylo(phylo, data, |
397 | 398 |
layout, ladderize, right, mrsd=mrsd, ...) |
398 | 399 |
scaleY(phylo, df, yscale, layout, ...) |
... | ... |
@@ -403,36 +404,17 @@ fortify.phylo4 <- function(model, data, layout="rectangular", yscale="none", |
403 | 404 |
fortify.phylo4d <- function(model, data, layout="rectangular", yscale="none", |
404 | 405 |
ladderize=TRUE, right=FALSE, branch.length="branch.length", |
405 | 406 |
mrsd=NULL, ...) { |
406 |
- model <- set_branch_length(model, branch.length) |
|
407 |
- phylo <- as.phylo.phylo4(model) |
|
408 |
- res <- fortify(phylo, data, layout, branch.length=branch.length, |
|
409 |
- ladderize, right, mrsd, ...) |
|
410 |
- tdata <- model@data[match(res$node, rownames(model@data)), , drop=FALSE] |
|
411 |
- df <- cbind(res, tdata) |
|
412 |
- scaleY(as.phylo.phylo4(model), df, yscale, layout, ...) |
|
407 |
+ ## model <- set_branch_length(model, branch.length) |
|
408 |
+ ## phylo <- as.phylo.phylo4(model) |
|
409 |
+ ## res <- fortify(phylo, data, layout, branch.length=branch.length, |
|
410 |
+ ## ladderize, right, mrsd, ...) |
|
411 |
+ ## tdata <- model@data[match(res$node, rownames(model@data)), , drop=FALSE] |
|
412 |
+ ## df <- cbind(res, tdata) |
|
413 |
+ ## scaleY(as.phylo.phylo4(model), df, yscale, layout, ...) |
|
414 |
+ fortify(as.treedata(model), data, layout, yscale, ladderize, right, branch.length, mrsd, ...) |
|
413 | 415 |
} |
414 | 416 |
|
415 |
-as.phylo.phylo4 <- function(phylo4) { |
|
416 |
- edge <- phylo4@edge |
|
417 |
- edge <- edge[edge[,1] != 0, ] |
|
418 |
- edge.length <- phylo4@edge.length |
|
419 |
- edge.length <- edge.length[!is.na(edge.length)] |
|
420 |
- tip.id <- sort(setdiff(edge[,2], edge[,1])) |
|
421 |
- tip.label <- phylo4@label[tip.id] |
|
422 |
- phylo <- list(edge = edge, |
|
423 |
- edge.length = edge.length, |
|
424 |
- tip.label = tip.label) |
|
425 |
- |
|
426 |
- node.id <- sort(unique(edge[,1])) |
|
427 |
- node.id <- node.id[node.id != 0] |
|
428 |
- node.label <- phylo4@label[node.id] |
|
429 |
- if (!all(is.na(node.label))) { |
|
430 |
- phylo$node.label <- node.label |
|
431 |
- } |
|
432 |
- phylo$Nnode <- length(node.id) |
|
433 |
- class(phylo) <- "phylo" |
|
434 |
- return(phylo) |
|
435 |
-} |
|
417 |
+ |
|
436 | 418 |
|
437 | 419 |
##' fortify a phylo to data.frame |
438 | 420 |
##' |
... | ... |
@@ -1,10 +1,12 @@ |
1 | 1 |
##' @importFrom ggplot2 fortify |
2 | 2 |
##' @method fortify treedata |
3 | 3 |
##' @export |
4 |
-fortify.treedata <- function(model, data, layout="rectangular", branch.length ="branch.length", |
|
5 |
- ladderize=TRUE, right=FALSE, mrsd=NULL, ...) { |
|
4 |
+fortify.treedata <- function(model, data, layout="rectangular", yscale="none", |
|
5 |
+ ladderize=TRUE, right=FALSE, branch.length ="branch.length", |
|
6 |
+ mrsd=NULL, ...) { |
|
7 |
+ |
|
6 | 8 |
model <- set_branch_length(model, branch.length) |
7 |
- |
|
9 |
+ |
|
8 | 10 |
x <- reorder.phylo(get.tree(model), "postorder") |
9 | 11 |
if (is.null(x$edge.length) || branch.length == "none") { |
10 | 12 |
xpos <- getXcoord_no_length(x) |
... | ... |
@@ -27,7 +29,7 @@ fortify.treedata <- function(model, data, layout="rectangular", branch.length =" |
27 | 29 |
|
28 | 30 |
## ## angle for all layout, if 'rectangular', user use coord_polar, can still use angle |
29 | 31 |
res <- calculate_angle(res) |
30 |
- res |
|
32 |
+ scaleY(as.phylo(model), res, yscale, layout, ...) |
|
31 | 33 |
} |
32 | 34 |
|
33 | 35 |
##' @method as.data.frame treedata |
... | ... |
@@ -824,11 +826,7 @@ set_branch_length <- function(tree_object, branch.length) { |
824 | 826 |
if (branch.length == "branch.length") { |
825 | 827 |
return(tree_object) |
826 | 828 |
} else if (branch.length == "none") { |
827 |
- if (is(tree_object, "phylo4d")) { |
|
828 |
- tree_object@edge.length <- NULL |
|
829 |
- } else { |
|
830 |
- tree_object@phylo$edge.length <- NULL |
|
831 |
- } |
|
829 |
+ tree_object@phylo$edge.length <- NULL |
|
832 | 830 |
return(tree_object) |
833 | 831 |
} |
834 | 832 |
|
... | ... |
@@ -836,11 +834,7 @@ set_branch_length <- function(tree_object, branch.length) { |
836 | 834 |
return(tree_object) |
837 | 835 |
} |
838 | 836 |
|
839 |
- if (is(tree_object, "phylo4d")) { |
|
840 |
- phylo <- as.phylo.phylo4(tree_object) |
|
841 |
- d <- tree_object@data |
|
842 |
- tree_anno <- data.frame(node=rownames(d), d) |
|
843 |
- } else if (is(tree_object, "codeml")) { |
|
837 |
+ if (is(tree_object, "codeml")) { |
|
844 | 838 |
tree_anno <- tree_object@mlc@dNdS |
845 | 839 |
} else if (is(tree_object, "codeml_mlc")) { |
846 | 840 |
tree_anno <- tree_object@dNdS |
... | ... |
@@ -850,10 +844,8 @@ set_branch_length <- function(tree_object, branch.length) { |
850 | 844 |
tree_anno <- get_tree_data(tree_object) |
851 | 845 |
} |
852 | 846 |
|
853 |
- if (!is(tree_object, "phylo4d")) { |
|
854 |
- phylo <- get.tree(tree_object) |
|
855 |
- } |
|
856 |
- |
|
847 |
+ phylo <- get.tree(tree_object) |
|
848 |
+ |
|
857 | 849 |
cn <- colnames(tree_anno) |
858 | 850 |
cn <- cn[!cn %in% c('node', 'parent')] |
859 | 851 |
|
... | ... |
@@ -876,11 +868,7 @@ set_branch_length <- function(tree_object, branch.length) { |
876 | 868 |
|
877 | 869 |
phylo$edge.length <- len |
878 | 870 |
|
879 |
- if (is(tree_object, "phylo4d")) { |
|
880 |
- tree_object@edge.length <- phylo$edge.length |
|
881 |
- } else { |
|
882 |
- tree_object@phylo <- phylo |
|
883 |
- } |
|
871 |
+ tree_object@phylo <- phylo |
|
884 | 872 |
return(tree_object) |
885 | 873 |
} |
886 | 874 |
|
... | ... |
@@ -12,163 +12,3 @@ get.tree <- treeio::get.tree |
12 | 12 |
drop.tip <- treeio::drop.tip |
13 | 13 |
get.fields <- treeio::get.fields |
14 | 14 |
|
15 |
- |
|
16 |
-## filename <- function(file) { |
|
17 |
-## ## textConnection(text_string) will work just like a file |
|
18 |
-## ## in this case, just set the filename as "" |
|
19 |
-## file_name <- "" |
|
20 |
-## if (is.character(file)) { |
|
21 |
-## file_name <- file |
|
22 |
-## } |
|
23 |
-## return(file_name) |
|
24 |
-## } |
|
25 |
- |
|
26 |
-## ##' read nhx tree file |
|
27 |
-## ##' |
|
28 |
-## ##' |
|
29 |
-## ##' @title read.nhx |
|
30 |
-## ##' @param file nhx file |
|
31 |
-## ##' @return nhx object |
|
32 |
-## ##' @export |
|
33 |
-## ##' @author Guangchuang Yu \url{https://guangchuangyu.github.io} |
|
34 |
-## read.nhx <- function(file) { |
|
35 |
-## treetext <- suppressWarnings(readLines(file)) |
|
36 |
-## treetext <- treetext[treetext != ""] |
|
37 |
-## treetext <- treetext[treetext != " "] |
|
38 |
- |
|
39 |
-## if (length(treetext) > 1) { |
|
40 |
-## treetext <- paste0(treetext, collapse = '') |
|
41 |
-## } |
|
42 |
-## treetext %<>% gsub(" ", "",. ) |
|
43 |
- |
|
44 |
-## phylo <- read.tree(text=treetext) |
|
45 |
-## nnode <- phylo$Nnode + Ntip(phylo) |
|
46 |
-## nlab <- paste("X", 1:nnode, sep="") |
|
47 |
-## tree2 <- treetext |
|
48 |
- |
|
49 |
-## for (i in 1:nnode) { |
|
50 |
-## tree2 <- sub("(\\w+)?(:?\\d*\\.?\\d*[Ee]?[\\+\\-]?\\d*)?\\[&&NHX.*?\\]", paste0("\\", nlab[i], "\\2"), tree2) |
|
51 |
-## } |
|
52 |
- |
|
53 |
-## phylo2 <- read.tree(text = tree2) |
|
54 |
-## treeinfo <- fortify(phylo2) |
|
55 |
-## node <- treeinfo$node[match(nlab, sub(".+(X\\d+)$","\\1",treeinfo$label))] # as.character |
|
56 |
- |
|
57 |
-## nhx.matches <- gregexpr("(\\w+)?(:?\\d*\\.?\\d*[Ee]?[\\+\\-]?\\d*)?\\[&&NHX.*?\\]", treetext) |
|
58 |
-## matches <- nhx.matches[[1]] |
|
59 |
-## match.pos <- as.numeric(matches) |
|
60 |
-## if (length(match.pos) == 1 && (match.pos == -1)) { |
|
61 |
-## nhx_tags <- data.frame(node = as.numeric(treeinfo$node)) |
|
62 |
-## } else { |
|
63 |
-## match.len <- attr(matches, 'match.length') |
|
64 |
- |
|
65 |
-## nhx_str <- substring(treetext, match.pos, match.pos+match.len-1) |
|
66 |
- |
|
67 |
-## ## nhx_features <- gsub("^(\\w+)?:?\\d*\\.?\\d*[Ee]?[\\+\\-]?\\d*", "", nhx_str) %>% |
|
68 |
-## nhx_features <- gsub("^[^\\[]*", "", nhx_str) %>% |
|
69 |
-## gsub("\\[&&NHX:", "", .) %>% |
|
70 |
-## gsub("\\]", "", .) |
|
71 |
- |
|
72 |
-## nhx_tags <- get_nhx_feature(nhx_features) |
|
73 |
-## fields <- names(nhx_tags) |
|
74 |
-## for (i in ncol(nhx_tags)) { |
|
75 |
-## if(any(grepl("\\D+", nhx_tags[,i])) == FALSE) { |
|
76 |
-## ## should be numerical varialbe |
|
77 |
-## nhx_tags[,i] <- as.numeric(nhx_tags[,i]) |
|
78 |
-## } |
|
79 |
-## } |
|
80 |
-## nhx_tags$node <- as.numeric(node) |
|
81 |
-## } |
|
82 |
- |
|
83 |
-## # Order rows by row number to facilitate downstream manipulations |
|
84 |
-## nhx_tags=nhx_tags[order(nhx_tags$node),] |
|
85 |
- |
|
86 |
-## new("nhx", |
|
87 |
-## file = filename(file), |
|
88 |
-## fields = fields, |
|
89 |
-## phylo = phylo, |
|
90 |
-## nhx_tags = nhx_tags |
|
91 |
-## ) |
|
92 |
-## } |
|
93 |
- |
|
94 |
- |
|
95 |
-## get_nhx_feature <- function(nhx_features) { |
|
96 |
-## nameSET <- strsplit(nhx_features, split=":") %>% unlist %>% |
|
97 |
-## gsub("=.*", "", .) %>% unique |
|
98 |
-## lapply(nhx_features, get_nhx_feature_internal, nameSET=nameSET) %>% |
|
99 |
-## do.call(rbind, .) %>% as.data.frame(., stringsAsFactors = FALSE) |
|
100 |
-## } |
|
101 |
- |
|
102 |
-## get_nhx_feature_internal <- function(feature, nameSET) { |
|
103 |
-## x <- strsplit(feature, ":") %>% unlist |
|
104 |
-## name <- gsub("=.*", "", x) |
|
105 |
-## val <- gsub(".*=", "", x) |
|
106 |
- |
|
107 |
-## names(val) <- name |
|
108 |
-## y <- character(length(nameSET)) |
|
109 |
-## for (i in seq_along(nameSET)) { |
|
110 |
-## if (nameSET[i] %in% name) { |
|
111 |
-## y[i] <- val[nameSET[i]] |
|
112 |
-## } else { |
|
113 |
-## y[i] <- NA |
|
114 |
-## } |
|
115 |
-## } |
|
116 |
-## names(y) <- nameSET |
|
117 |
-## return(y) |
|
118 |
-## } |
|
119 |
- |
|
120 |
- |
|
121 |
- |
|
122 |
- |
|
123 |
- |
|
124 |
-## ##' @rdname get.fields-methods |
|
125 |
-## ##' @exportMethod get.fields |
|
126 |
-## setMethod("get.fields", signature(object="nhx"), |
|
127 |
-## function(object, ...) { |
|
128 |
-## get.fields.tree(object) |
|
129 |
-## } |
|
130 |
-## ) |
|
131 |
- |
|
132 |
- |
|
133 |
-## Ntip <- function(tree) { |
|
134 |
-## phylo <- get.tree(tree) |
|
135 |
-## length(phylo$tip.label) |
|
136 |
-## } |
|
137 |
- |
|
138 |
-## Nnode <- function(tree, internal.only=TRUE) { |
|
139 |
-## phylo <- get.tree(tree) |
|
140 |
-## if (internal.only) |
|
141 |
-## return(phylo$Nnode) |
|
142 |
- |
|
143 |
-## Ntip(phylo) + phylo$Nnode |
|
144 |
-## } |
|
145 |
- |
|
146 |
- |
|
147 |
-## has.extraInfo <- function(object) { |
|
148 |
-## if (!is.tree(object)) { |
|
149 |
-## return(FALSE) |
|
150 |
-## } |
|
151 |
- |
|
152 |
-## if (! .hasSlot(object, "extraInfo")) { |
|
153 |
-## return(FALSE) |
|
154 |
-## } |
|
155 |
- |
|
156 |
-## extraInfo <- object@extraInfo |
|
157 |
- |
|
158 |
-## if (nrow(extraInfo) > 0) { |
|
159 |
-## return(TRUE) |
|
160 |
-## } |
|
161 |
- |
|
162 |
-## return(FALSE) |
|
163 |
-## } |
|
164 |
- |
|
165 |
-## ##' @importFrom methods .hasSlot is missingArg new slot slot<- |
|
166 |
-## has.slot <- function(object, slotName) { |
|
167 |
-## if (!isS4(object)) { |
|
168 |
-## return(FALSE) |
|
169 |
-## } |
|
170 |
-## .hasSlot(object, slotName) |
|
171 |
-## ## slot <- tryCatch(slot(object, slotName), error=function(e) NULL) |
|
172 |
-## ## ! is.null(slot) |
|
173 |
-## } |
|
174 |
- |