Browse code

Commit made by the Bioconductor Git-SVN bridge.

Commit id: e400844df363fc21a38c694f4ccbaf68dcfcb78f

update get.placement



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

g.yu authored on 05/06/2015 06:51:51
Showing 2 changed files

  • NEWS index ff42e86..25c5a38 100644
  • R/jplace.R index 5cb4443..b89d757 100644
... ...
@@ -1,5 +1,6 @@
1 1
 CHANGES IN VERSION 1.1.8
2 2
 ------------------------
3
+ o update get.placement <2015-06-05, Fri>
3 4
  o edgeNum2nodeNum for converting edge number to node number for EPA/pplacer output <2015-06-04, Thu>
4 5
  o mv scale_x_gheatmap to scale_x_ggtree, which also support msaplot <2015-06-02, Tue>
5 6
  o add mask function <2015-06-02, Tue>
... ...
@@ -179,8 +179,10 @@ setMethod("get.fields", signature(object = "jplace"),
179 179
 ##' get.placements(jp, by="all")
180 180
 setMethod("get.placements", signature(object = "jplace"),
181 181
           function(object, by="best", ...) {
182
+
182 183
               placements <- object@placements
183 184
               place <- placements[,1]
185
+              
184 186
               ids <- NULL
185 187
               if (length(placements) == 2) {
186 188
                   ids <- sapply(placements[,2], function(x) x[1])
... ...
@@ -189,12 +191,29 @@ setMethod("get.placements", signature(object = "jplace"),
189 191
               if (by == "best") { ## best hit
190 192
                   place <- lapply(place, function(x) {
191 193
                       if (is(x, "data.frame") || is(x, "matrix")) {
192
-                          return(x[1,])
194
+                          if (nrow(x) == 1) {
195
+                              return(x)
196
+                          }
197
+                          ## http://astrostatistics.psu.edu/su07/R/html/base/html/all.equal.html
198
+                          ## due to precision, number are identical maynot be equal, so use all.equal which can test nearly equal number
199
+                          ## if not equals, the output is a descript string of the differences
200
+                          idx <- sapply(2:nrow(x), function(i) all.equal(x[1,2], x[i,2]))
201
+                          if (any(idx == TRUE)) {
202
+                              return(x[c(1, which(idx==TRUE)),])
203
+                          } else {
204
+                              return(x[1,])
205
+                          }
206
+                          
193 207
                       } else {
208
+                          ## if only 1 row, it may stored as vector
209
+                          ## the edge number, for example 523 can be 523.0000 due to R stored number as real number
210
+                          ## be careful in mapping edge number.
194 211
                           return(x)
195 212
                       }
196 213
                   })
214
+                  
197 215
               }
216
+              
198 217
               place.df <- do.call("rbind", place)
199 218
               row.names(place.df) <- NULL
200 219
               if (!is.null(ids)) {
... ...
@@ -209,8 +228,8 @@ setMethod("get.placements", signature(object = "jplace"),
209 228
               } else {
210 229
                   colnames(place.df) <- object@fields
211 230
               }
212
-              
213 231
               res <- as.data.frame(place.df)
232
+              
214 233
               ## res[] <- lapply(res, as.character)
215 234
               ## for (i in 1:ncol(res)) {
216 235
               ##     if (all(grepl("^[0-9\\.e]+$", res[,i]))) {