## ##' 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)
## }