Commit 9b4f65e5 authored by Midoux Cedric's avatar Midoux Cedric

rework tree with shinymeta

parent 2a09efac
output$treeUI <- renderUI({ output$treeUI <- renderUI({
validate(need(phy_tree(data16S(), errorIfNULL = FALSE), "")) validate(need(phy_tree(physeq(), errorIfNULL = FALSE), ""))
box( box(
title = "Setting : " , title = "Setting : " ,
width = NULL, width = NULL,
...@@ -7,8 +7,8 @@ output$treeUI <- renderUI({ ...@@ -7,8 +7,8 @@ output$treeUI <- renderUI({
radioButtons( radioButtons(
"treeRank", "treeRank",
label = "Taxonomic rank captioned : ", label = "Taxonomic rank captioned : ",
choices = c(aucun = "", choices = c(None = "",
rank_names(data16S()), rank_names(physeq()),
OTU = "taxa_names"), OTU = "taxa_names"),
inline = TRUE inline = TRUE
), ),
...@@ -16,9 +16,16 @@ output$treeUI <- renderUI({ ...@@ -16,9 +16,16 @@ output$treeUI <- renderUI({
"treeTopOtu", "treeTopOtu",
label = "Show the n most abundant OTU : ", label = "Show the n most abundant OTU : ",
min = 1, min = 1,
max = ntaxa(data16S()), max = ntaxa(physeq()),
value = 20 value = 20
), ),
sliderInput(
"treeSize",
label = "Abundance size based on a logarithm basis : ",
min = 2,
max = 10,
value = 5
),
checkboxInput("treeRadial", label = "Radial tree", value = FALSE), checkboxInput("treeRadial", label = "Radial tree", value = FALSE),
checkboxInput("treeSample", label = "Show samples", value = TRUE), checkboxInput("treeSample", label = "Show samples", value = TRUE),
textInput("treeTitle", textInput("treeTitle",
...@@ -27,85 +34,54 @@ output$treeUI <- renderUI({ ...@@ -27,85 +34,54 @@ output$treeUI <- renderUI({
selectInput( selectInput(
"treeCol", "treeCol",
label = "Color : ", label = "Color : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(physeq()), rank_names(physeq()))
), ),
selectInput( selectInput(
"treeShape", "treeShape",
label = "Shape : ", label = "Shape : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(physeq()), rank_names(physeq()))
), )
collapsedBox(verbatimTextOutput("treeScript"), title = "RCode")
) )
}) })
output$treeScript <- renderText({ output$tree <- metaRender2(renderPlot, {
scriptArgs <- c( validate(need(physeq(), "Requires an abundance dataset"),
glue( need(phy_tree(physeq(), errorIfNULL = FALSE), "Requires a phylogenetic tree"))
"physeq = prune_taxa(names(sort(taxa_sums(data), decreasing = TRUE)[1:{input$treeTopOtu}]), data)" data <- physeq()
)
) treeRadial <- if (input$treeRadial) {
if (input$treeSample) { metaExpr({
scriptArgs <- c(scriptArgs, "method = \"sampledodge\"") coord_polar(theta = "y")
} else { })
scriptArgs <- c(scriptArgs, "method = \"treeonly\"")
}
if (!is.null(checkNull(input$treeCol))) {
scriptArgs <- c(scriptArgs, glue("color = \"{input$treeCol}\""))
}
if (!is.null(checkNull(input$treeShape))) {
scriptArgs <- c(scriptArgs, glue("shape = \"{input$treeShape}\""))
}
scriptArgs <- c(scriptArgs, "size = \"abundance\"")
if (!is.null(checkNull(input$treeRank))) {
scriptArgs <-
c(scriptArgs, glue("label.tips = \"{input$treeRank}\""))
}
scriptArgs <- c(scriptArgs,
"sizebase = 5",
"ladderize = \"left\"",
"plot.margin = 0")
if (!is.null(checkNull(input$treeTitle))) {
scriptArgs <- c(scriptArgs, glue("title = \"{input$treeTitle}\""))
}
script <- c(
scriptHead,
"# Plot phylogenetic tree",
glue("p <- plot_tree({glue_collapse(scriptArgs, sep=', ')})")
)
if (input$treeRadial) {
script <- c(script,
"p <- p + coord_polar(theta = \"y\")")
} }
script <- c(script, "", "plot(p)")
return(glue_collapse(script, sep = "\n")) metaExpr({
}) data_select <- prune_taxa(names(sort(taxa_sums(data), decreasing = TRUE)[1:..(input$treeTopOtu)]), data)
p <- plot_tree(
output$tree <- renderPlot({ physeq = data_select,
validate( method = ..(ifelse(input$treeSample, "sampledodge", "treeonly")),
need(data16S(), "Requires an abundance dataset"), color = ..(checkNull(input$treeCol)),
need( shape = ..(checkNull(input$treeShape)),
phy_tree(data16S(), errorIfNULL = FALSE), size = "abundance",
"Requires a phylogenetic tree" label.tips = ..(checkNull(input$treeRank)),
sizebase = ..(checkNull(input$treeSize)),
ladderize = "left",
plot.margin = 0.1,
title = ..(checkNull(input$treeTitle))
) )
) p + ..(treeRadial)
p <- plot_tree( })
physeq = prune_taxa(names(sort(
taxa_sums(data16S()), decreasing = TRUE
)[1:input$treeTopOtu]), data16S()),
method = ifelse(input$treeSample, "sampledodge", "treeonly"),
color = checkNull(input$treeCol),
shape = checkNull(input$treeShape),
size = "abundance",
label.tips = checkNull(input$treeRank),
sizebase = 5,
ladderize = "left",
plot.margin = 0,
title = checkNull(input$treeTitle)
)
if (checkNull(input$treeRadial)) {
return(p + coord_polar(theta = "y"))
} else {
return(p)
}
}) })
observeEvent(input$tree_output_code,
{
displayCodeModal(
expandChain(
quote(library(phyloseq)),
quote(library(phyloseq.extended)),
"# Replace `data` with you own data.",
output$tree()
)
)
}
)
tree <- fluidPage(withLoader(plotOutput("tree", height = 700)), tree <- fluidPage(outputCodeButton(withLoader(plotOutput("tree", height = 700))),
uiOutput("treeUI")) uiOutput("treeUI"))
...@@ -37,7 +37,7 @@ dashboardHeader(title = "Easy16S"), ...@@ -37,7 +37,7 @@ dashboardHeader(title = "Easy16S"),
menuItem(HTML("&beta;-diversity"), tabName = "richnessB", icon = icon("dashboard")), menuItem(HTML("&beta;-diversity"), tabName = "richnessB", icon = icon("dashboard")),
menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("dot-circle")), menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("dot-circle")),
menuItem("PCA", tabName = "pca", icon = icon("bullseye")), menuItem("PCA", tabName = "pca", icon = icon("bullseye")),
menuItem("Phylogenetic tree", tabName = "tree", icon = icon("dashboard")), menuItem("Phylogenetic tree", tabName = "tree", icon = icon("tree")),
menuItem("Clustering", tabName = "cluster", icon = icon("dashboard")), menuItem("Clustering", tabName = "cluster", icon = icon("dashboard")),
menuItem("Help", tabName = "Help", icon = icon("dashboard")) menuItem("Help", tabName = "Help", icon = icon("dashboard"))
)), )),
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment