Commit id: e400844df363fc21a38c694f4ccbaf68dcfcb78f
update get.placement
git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@104588 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -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]))) { |