Browse code

bug fixed of parsing treetext in beast file

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@123195 bc3139a8-67e5-0310-9ffc-ced21a209358

Guangchuang Yu authored on 31/10/2016 11:30:17
Showing 3 changed files

... ...
@@ -1,7 +1,7 @@
1 1
 Package: ggtree
2 2
 Type: Package
3 3
 Title: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data
4
-Version: 1.7.1
4
+Version: 1.7.2
5 5
 Authors@R: c(
6 6
 	   person("Guangchuang", "Yu", email = "guangchuangyu@gmail.com", role = c("aut", "cre")),
7 7
 	   person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com", rol = c("aut", "ths")),
... ...
@@ -1,3 +1,8 @@
1
+CHANGES IN VERSION 1.7.2
2
+------------------------
3
+ o bug fixed of parsing tree text in beast file <2016-10-31, Mon>
4
+   + https://github.com/GuangchuangYu/ggtree/issues/84
5
+
1 6
 CHANGES IN VERSION 1.7.1
2 7
 ------------------------
3 8
  o xlim_tree layer and test <2016-10-31, Mon>
... ...
@@ -1,7 +1,7 @@
1 1
 
2 2
 ##' read beast output
3 3
 ##'
4
-##' 
4
+##'
5 5
 ##' @title read.beast
6 6
 ##' @param file beast file
7 7
 ##' @return \code{beast} object
... ...
@@ -16,7 +16,7 @@ read.beast <- function(file) {
16 16
     treetext <- read.treetext_beast(file)
17 17
     stats <- read.stats_beast(file)
18 18
     phylo <- read.nexus(file)
19
-    
19
+
20 20
     if (length(treetext) == 1) {
21 21
         obj <- BEAST(file, treetext, translation, stats, phylo)
22 22
     } else {
... ...
@@ -31,12 +31,12 @@ read.beast <- function(file) {
31 31
 
32 32
 BEAST <- function(file, treetext, translation, stats, phylo) {
33 33
     stats$node %<>% gsub("\"*'*", "", .)
34
-    
34
+
35 35
     fields <- sub("_lower|_upper", "", names(stats)) %>% unique
36 36
     fields %<>% `[`(.!="node")
37
-        
37
+
38 38
     phylo <- remove_quote_in_tree_label(phylo)
39
-        
39
+
40 40
     obj <- new("beast",
41 41
                fields      = fields,
42 42
                treetext    = treetext,
... ...
@@ -53,7 +53,7 @@ remove_quote_in_tree_label <- function(phylo) {
53 53
         phylo$node.label %<>% gsub("\"*'*", "", .)
54 54
     }
55 55
     if ( !is.null(phylo$tip.label)) {
56
-        phylo$tip.label %<>% gsub("\"*'*", "", .) 
56
+        phylo$tip.label %<>% gsub("\"*'*", "", .)
57 57
     }
58 58
     return(phylo)
59 59
 }
... ...
@@ -70,29 +70,18 @@ setMethod("get.fields", signature(object="beast"),
70 70
 
71 71
 read.treetext_beast <- function(file) {
72 72
     beast <- readLines(file)
73
-    ## ii <- grep("^tree TREE1\\s+=", beast)
74
-    ii <- grep("^tree ", beast)
75
-    if (length(ii) == 0) {
76
-        ii <- grep("[Bb]egin trees;", beast)
77
-    }
78
-    
73
+
74
+    ii <- grep("[Bb]egin trees;", beast)
79 75
     jj <- grep("[Ee]nd;", beast)
80 76
     jj <- jj[jj > max(ii)][1]
81
-
82
-    ## tree <- beast[ii:(jj-1)]
83
-    ## if (length(tree) > 1) {
84
-    ##     tree <- paste0(tree)
85
-    ## }
86
-    ## tree %<>% sub("[^=]+=", "", .) %>%
87
-    ##     sub("\\s+\\[&R\\]\\s+", "", .) %>%
88
-    ##         sub("[^(]*", "", .)
89
-    
90 77
     jj <- c(ii[-1], jj)
78
+
91 79
     trees <- sapply(seq_along(ii), function(i) {
92
-        tree <- beast[ii[i]:(jj[i]-1)]
93
-        if (length(tree) > 1) {
94
-            tree <- paste0(tree)
95
-        }
80
+        tree <- beast[(ii[i]+1):(jj[i]-1)]
81
+        tree <- tree[grep("\\s*[Tt]ree", tree)]
82
+        ## if (length(tree) > 1) {
83
+        ##     tree <- paste0(tree, collapse='')
84
+        ## }
96 85
         sub("[^(]*", "", tree)
97 86
     })
98 87
 
... ...
@@ -134,17 +123,17 @@ read.stats_beast_internal <- function(beast, tree) {
134 123
     phylo <- read.tree(text = tree2)
135 124
 
136 125
     tree2 <- add_pseudo_nodelabel(phylo, tree2)
137
-    
126
+
138 127
     ## node name corresponding to stats
139 128
     nn <- strsplit(tree2, split=",") %>% unlist %>%
140 129
         strsplit(., split="\\)") %>% unlist %>%
141 130
         gsub("\\(*", "", .) %>%
142
-        gsub("[:;].*", "", .) 
143
-    
131
+        gsub("[:;].*", "", .)
132
+
144 133
     phylo <- read.tree(text = tree2)
145 134
     root <- getRoot(phylo)
146 135
     nnode <- phylo$Nnode
147
-    
136
+
148 137
     ## phylo2 <- read.nexus(file)
149 138
     ## treeinfo <- fortify.phylo(phylo)
150 139
     ## treeinfo2 <- fortify.phylo(phylo2)
... ...
@@ -178,7 +167,7 @@ read.stats_beast_internal <- function(beast, tree) {
178 167
     ## ## convert nn to node that encoded in phylo2
179 168
     ## node <- treeinfo$label2[match(nn, treeinfo$label)]
180 169
 
181
-    
170
+
182 171
     ####################################################
183 172
     ##                                                ##
184 173
     ##  after doing it in the hard way                ##
... ...
@@ -194,7 +183,7 @@ read.stats_beast_internal <- function(beast, tree) {
194 183
     } else {
195 184
         node <- as.character(treeinfo$node[match(nn, treeinfo$label)])
196 185
     }
197
-    
186
+
198 187
     ## stats <- unlist(strsplit(tree, "\\["))[-1]
199 188
     ## stats <- sub(":.+$", "", stats
200 189
     stats <- strsplit(tree, ":") %>% unlist
... ...
@@ -204,7 +193,7 @@ read.stats_beast_internal <- function(beast, tree) {
204 193
 
205 194
     stats <- sub("^&", "", stats)
206 195
     stats <- sub("];*$", "", stats)
207
-        
196
+
208 197
     stats2 <- lapply(stats, function(x) {
209 198
         y <- unlist(strsplit(x, ","))
210 199
         sidx <- grep("=\\{", y)
... ...
@@ -215,18 +204,18 @@ read.stats_beast_internal <- function(beast, tree) {
215 204
             flag <- TRUE
216 205
             SETS <- sapply(seq_along(sidx), function(k) {
217 206
                 p <- y[sidx[k]:eidx[k]]
218
-                gsub(".*=\\{", "", p) %>% gsub("\\}$", "", .) %>% list                
207
+                gsub(".*=\\{", "", p) %>% gsub("\\}$", "", .) %>% list
219 208
             })
220 209
             names(SETS) <- gsub("=.*", "", y[sidx])
221 210
 
222 211
             kk <- sapply(seq_along(sidx), function(k) sidx[k]:eidx[k]) %>% unlist
223 212
             y <- y[-kk]
224 213
         }
225
-        
226
-        
214
+
215
+
227 216
         name <- gsub("=.*", "", y)
228 217
         val <- gsub(".*=", "", y) %>% gsub("^\\{", "", .) %>%
229
-            gsub("\\}$", "", .) 
218
+            gsub("\\}$", "", .)
230 219
 
231 220
 
232 221
         if (flag) {
... ...
@@ -234,7 +223,7 @@ read.stats_beast_internal <- function(beast, tree) {
234 223
         } else {
235 224
             nn <- name
236 225
         }
237
-        
226
+
238 227
         res <- character(length(nn))
239 228
         names(res) <- nn
240 229
 
... ...
@@ -247,7 +236,7 @@ read.stats_beast_internal <- function(beast, tree) {
247 236
                 res[i+j] <- SETS[i]
248 237
             }
249 238
         }
250
-        
239
+
251 240
         return(res)
252 241
     })
253 242
 
... ...
@@ -270,7 +259,7 @@ read.stats_beast_internal <- function(beast, tree) {
270 259
         colnames(stats3) <- nn
271 260
     }
272 261
     colnames(stats3) <- gsub("(\\d+)%", "0.\\1", colnames(stats3))
273
-    
262
+
274 263
     ## stats3$node <- node
275 264
     stats3$node <- names(stats)
276 265
     return(stats3)