#' phylowidget Phylogeny widget
#'
#' An interactive phylogeny viewer using D3.js, based on phylotree.js. Just supply
#' a \code{Newick} string or \code{phylo} data as the parameter.
#'
#' @param nwk Newick string or \code{phylo} from the \code{\link[ape]{ape}} package.
#' @param width Integer in px to override the default width. The default width fills the browser window.
#' @param height Integer in px to override the default height. The default height fills the browser window.
#'
#' @note
#' This displays a phylogeny in a browser window; by default, the viewer is disabled.
#'
#' @references
#' \code{phylotree.js} \url{http://github.com/veg/phylotree.js}
#'
#' @examples
#' \dontrun{
#' # A stand-alone example
#' library(ape)
#' data(bird.orders)
#' phylowidget(bird.orders)
#' }
#'
#' @import htmlwidgets
#' @export
phylowidget <- function(nwk, width = NULL, height = NULL) {
# try to convert if not character (assuming not Newick)
if(class(nwk) %in% c("phylo","multiPhylo")){
warning( "attempting conversion to Newick format", call. = F)
if (requireNamespace("ape")) {
nwk = ape::write.tree( nwk )
} else {
stop("If input is not a Newick string, phylowidget requires ape package. Please install ape.")
}
}
# forward options using x
x = list(
nwk=nwk
)
# create widget
htmlwidgets::createWidget(
name = 'phylowidget',
x,
width = width,
height = height,
sizingPolicy = htmlwidgets::sizingPolicy(viewer.suppress = TRUE,
browser.fill = TRUE,
browser.padding = 0),
package = 'phylowidget'
)
}
#' phylowidgetOutput Helper function for phyloshiny
#' @param outputId The output identifier.
#' @param width The width of the device.
#' @param height The height of the device.
#'
#' @seealso renderPhylowidget
#' @export
phylowidgetOutput <- function(outputId, width = '100%', height = '400px'){
shinyWidgetOutput(outputId, 'phylowidget', width, height, package = 'phylowidget')
}
#' renderPhylowidget Helper function for phyloshiny
#' @param expr The function to be rendered
#' @param env The environment for rendering.
#' @param quoted Should the output be quoted?
#'
#' @seealso phylowidgetOutput
#' @export
renderPhylowidget <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) { expr <- substitute(expr) } # force quoted
shinyRenderWidget(expr, phylowidgetOutput, env, quoted = TRUE)
}
#' phylowidget get data into D3 structure so that key 'name' matches D3 tip labels
#' @import RJSONIO plyr
phylowidget.with_tip_data.formatter <- function(tipdata)
{
tmp <- dlply(as.data.frame(tipdata), .(LABEL), .fun=function(d){ list(name=d[['LABEL']][1], DATA=list(X=d[['X']], Y=d[['Y']])) })
names(tmp) <- NULL
#cat(toJSON(tmp))
tmp
}
#' phylowidget Phylogeny widget with tip data
#'
#' An interactive phylogeny viewer using D3.js, based on phylotree.js. Just supply
#' a \code{Newick} string and a data frame with tip data as shown in the Example.
#' @import data.table
#' @example example/phylowidget_with_tip_data_ex.R
#' @export
phylowidget.with_tip_data <- function(nwk, tipdata=NULL, width = NULL, height = NULL) {
# forward options using x
x = list(
nwk=nwk,
tipdata= phylowidget.with_tip_data.formatter(tipdata)
)
# create widget
htmlwidgets::createWidget(
name = 'phylowidget_with_tip_data',
x,
width = width,
height = height,
sizingPolicy = htmlwidgets::sizingPolicy(viewer.suppress = TRUE,
browser.fill = TRUE,
browser.padding = 0),
package = 'phylowidget'
)
}
#' phyloshiny A phylowidget as a Shiny app
#' @param nwk Either a Newick string or a \code{phylo} or \code{multiPhylo} object.
#'
#' @examples
#' \dontrun{
#' library(ape)
#' data(bird.orders)
#' phyloshiny(bird.orders)
#' }
#'
#' @seealso phylowidget
#' @export
phyloshiny <- function(nwk) {
require(shiny)
shinyApp(
ui = fluidPage(
phylowidgetOutput("phylowidget")
),
server = function(input, output) {
output$phylowidget <- renderPhylowidget(
phylowidget(nwk)
)
observe({
if(is.null(input$close)){
return()
}
else{
if (input$close>0){
tree <<- input$tree
print(tree)
stopApp()
}
}
})
}
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.