## ##' read jplace file
## ##'
## ##'
## ##' @title read.jplace
## ##' @param file jplace file
## ##' @return \code{jplace} instance
## ##' @importFrom jsonlite fromJSON
## ##' @export
## ##' @author ygc
## ##' @examples
## ##' jp <- system.file("extdata", "sample.jplace", package="ggtree")
## ##' read.jplace(jp)
## read.jplace <- function(file) {
## fields <- tree <- placements <- NULL
## version <- metadata <- NULL
## with(fromJSON(file),
## new("jplace",
## fields = fields,
## treetext = tree,
## phylo = jplace_treetext_to_phylo(tree),
## placements = placements,
## version = version,
## metadata = metadata,
## file = filename(file)
## )
## )
## }
## ##' @rdname scale_color-methods
## ##' @exportMethod scale_color
## setMethod("scale_color", signature(object="jplace"),
## function(object, by, ...) {
## scale_color_(object, by, ...)
## })
## ##' get.treeinfo method
## ##'
## ##'
## ##' @docType methods
## ##' @name get.treeinfo
## ##' @rdname get.treeinfo-methods
## ##' @aliases get.treeinfo,jplace,ANY-method
## ##' @exportMethod get.treeinfo
## ##' @author Guangchuang Yu \url{http://ygc.name}
## ##' @usage get.treeinfo(object, layout, ladderize, right, ...)
## ##' @examples
## ##' jp <- system.file("extdata", "sample.jplace", package="ggtree")
## ##' jp <- read.jplace(jp)
## ##' get.treeinfo(jp)
## setMethod("get.treeinfo", signature(object = "jplace"),
## function(object, layout="phylogram",
## ladderize=TRUE, right=FALSE, ...) {
## get.treeinfo.jplace(object, layout,
## ladderize, right, ...)
## }
## )
## ##' get.treetext method
## ##'
## ##'
## ##' @docType methods
## ##' @name get.treetext
## ##' @rdname get.treetext-methods
## ##' @aliases get.treetext,jplace,ANY-method
## ##' @exportMethod get.treetext
## ##' @author Guangchuang Yu \url{http://ygc.name}
## ##' @usage get.treetext(object, ...)
## ##' @examples
## ##' jp <- system.file("extdata", "sample.jplace", package="ggtree")
## ##' jp <- read.jplace(jp)
## ##' get.treetext(jp)
## setMethod("get.treetext", signature(object = "jplace"),
## function(object, ...) {
## get.treetext.jplace(object, ...)
## }
## )
## ##' get.fields method
## ##'
## ##'
## ##' @docType methods
## ##' @name get.fields
## ##' @rdname get.fields-methods
## ##' @aliases get.fields,jplace,ANY-method
## ##' @exportMethod get.fields
## ##' @author Guangchuang Yu \url{http://ygc.name}
## ##' @usage get.fields(object, ...)
## ##' @examples
## ##' jp <- system.file("extdata", "sample.jplace", package="ggtree")
## ##' jp <- read.jplace(jp)
## ##' get.fields(jp)
## setMethod("get.fields", signature(object = "jplace"),
## function(object, ...) {
## get.fields.tree(object)
## }
## )
## ##' get.placement method
## ##'
## ##'
## ##' @docType methods
## ##' @name get.placements
## ##' @rdname get.placements-methods
## ##' @aliases get.placements,jplace,ANY-method
## ##' @exportMethod get.placements
## ##' @author Guangchuang Yu \url{http://ygc.name}
## ##' @usage get.placements(object, by, ...)
## ##' @examples
## ##' jp <- system.file("extdata", "sample.jplace", package="ggtree")
## ##' jp <- read.jplace(jp)
## ##' get.placements(jp, by="all")
## setMethod("get.placements", signature(object = "jplace"),
## function(object, by="best", ...) {
## placements <- object@placements
## place <- placements[,1]
## ids <- NULL
## if (length(placements) == 2) {
## ids <- sapply(placements[,2], function(x) x[1])
## names(place) <- ids
## }
## if (by == "best") { ## best hit
## place <- lapply(place, function(x) {
## if (is(x, "data.frame") || is(x, "matrix")) {
## if (nrow(x) == 1) {
## return(x)
## }
## ## http://astrostatistics.psu.edu/su07/R/html/base/html/all.equal.html
## ## due to precision, number are identical maynot be equal, so use all.equal which can test nearly equal number
## ## if not equals, the output is a descript string of the differences
## idx <- sapply(2:nrow(x), function(i) all.equal(x[1,2], x[i,2]))
## if (any(idx == TRUE)) {
## return(x[c(1, which(idx==TRUE)+1),])
## } else {
## return(x[1,])
## }
## } else {
## ## if only 1 row, it may stored as vector
## ## the edge number, for example 523 can be 523.0000 due to R stored number as real number
## ## be careful in mapping edge number.
## return(x)
## }
## })
## }
## place.df <- do.call("rbind", place)
## row.names(place.df) <- NULL
## if (!is.null(ids)) {
## nn <- rep(ids, sapply(place, function(x) {
## nr <- nrow(x)
## if (is.null(nr))
## return(1)
## return(nr)
## }))
## place.df <- data.frame(name=nn, place.df)
## colnames(place.df) <- c("name", object@fields)
## } else {
## colnames(place.df) <- object@fields
## }
## res <- as.data.frame(place.df, stringsAsFactor=FALSE)
## ## res[] <- lapply(res, as.character)
## ## for (i in 1:ncol(res)) {
## ## if (all(grepl("^[0-9\\.e]+$", res[,i]))) {
## ## res[,i] <- as.numeric(res[,i])
## ## }
## ## }
## return(res)
## })
## get.treetext.jplace <- function(object, ...) {
## object@treetext
## }
## get.fields.jplace <- function(object, ...) {
## object@fields
## }
## get.treeinfo.jplace <- function(object, layout,
## ladderize, right, ...) {
## extract.treeinfo.jplace(object, layout,
## ladderize, right, ...)
## }
## ##' generate jplace file
## ##'
## ##'
## ##' @title write.jplace
## ##' @param nwk tree in newick format
## ##' @param data annotation data
## ##' @param outfile jplace output file
## ##' @return jplace file
## ##' @export
## ##' @author ygc
## ##' @examples
## ##' tree <- system.file("extdata", "pa.nwk", package="ggtree")
## ##' data <- read.csv(system.file("extdata", "pa_subs.csv", package="ggtree"),
## ##' stringsAsFactor=FALSE)
## ##' outfile <- tempfile()
## ##' write.jplace(tree, data, outfile)
## write.jplace <- function(nwk, data, outfile) {
## out <- file(outfile, "w")
## data[] = lapply(data, as.character) ## remove factor
## writeLines("{", out)
## writeLines(paste0('\t"tree": "', readLines(nwk), '",'), out)
## writeLines('\t"placements": [', out)
## for (i in 1:nrow(data)) {
## writeLines(paste0('\t{"p":["', paste(data[i,], collapse = '", "'), '"]}'), out, sep="")
## if (i != nrow(data)) {
## writeLines(',', out)
## }
## }
## writeLines('],', out)
## writeLines('\t"metadata": {"info": "generated by ggtree package"},',
## out)
## writeLines('\t"version": 2,', out)
## writeLines(paste0('\t"fields": [', '"',
## paste(colnames(data), collapse='", "'),
## '"'),
## out)
## writeLines('\t]\n}', out)
## close(out)
## }
