Commit 27619157 authored by Midoux Cedric's avatar Midoux Cedric

panels/tree

parent 50f74a41
output$treeUI <- renderUI({
validate(need(phy_tree(data16S(), errorIfNULL = FALSE), ""))
box(
title = "Setting : " ,
width = NULL,
status = "primary",
radioButtons(
"treeRank",
label = "Taxonomic rank captioned : ",
choices = c(aucun = "",
rank_names(data16S()),
OTU = "taxa_names"),
inline = TRUE
),
sliderInput(
"treeTopOtu",
label = "Show the n most abundant OTU : ",
min = 1,
max = ntaxa(data16S()),
value = 20
),
checkboxInput("treeRadial", label = "Radial tree", value = FALSE),
checkboxInput("treeSample", label = "Show samples", value = TRUE),
textInput("treeTitle",
label = "Title : ",
value = "Phylogenetic tree"),
selectInput(
"treeCol",
label = "Color : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"treeShape",
label = "Shape : ",
choices = c("..." = 0, sample_variables(data16S()))
),
collapsedBox(verbatimTextOutput("treeScript"), title = "RCode")
)
})
output$treeScript <- renderText({
scriptArgs <- c(
glue(
"physeq = prune_taxa(names(sort(taxa_sums(data), decreasing = TRUE)[1:{input$treeTopOtu}]), data)"
)
)
if (input$treeSample) {
scriptArgs <- c(scriptArgs, "method = \"sampledodge\"")
} 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"))
})
output$tree <- renderPlot({
validate(
need(data16S(), "Requires an abundance dataset"),
need(
phy_tree(data16S(), errorIfNULL = FALSE),
"Requires a phylogenetic tree"
)
)
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)
}
})
tree <- fluidPage(
......@@ -11,6 +11,7 @@ shinyServer
source("panels/histo-server.R", local = TRUE)
source("panels/histoFocus-server.R", local = TRUE)
source("panels/heatmap-server.R", local = TRUE)
source("panels/tree.R", local = TRUE)
checkNull <- function(x) {
if (!exists(as.character(substitute(x)))) {
......@@ -764,118 +765,6 @@ shinyServer
return(glue_collapse(script, sep = "\n"))
})
output$treeUI <- renderUI({
validate(need(phy_tree(data16S(), errorIfNULL = FALSE), ""))
box(
title = "Setting : " ,
width = NULL,
status = "primary",
radioButtons(
"treeRank",
label = "Taxonomic rank captioned : ",
choices = c(aucun = "",
rank_names(data16S()),
OTU = "taxa_names"),
inline = TRUE
),
sliderInput(
"treeTopOtu",
label = "Show the n most abundant OTU : ",
min = 1,
max = ntaxa(data16S()),
value = 20
),
checkboxInput("treeRadial", label = "Radial tree", value = FALSE),
checkboxInput("treeSample", label = "Show samples", value = TRUE),
textInput("treeTitle",
label = "Title : ",
value = "Phylogenetic tree"),
selectInput(
"treeCol",
label = "Color : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"treeShape",
label = "Shape : ",
choices = c("..." = 0, sample_variables(data16S()))
),
collapsedBox(verbatimTextOutput("treeScript"), title = "RCode")
)
})
output$treeScript <- renderText({
scriptArgs <- c(
glue(
"physeq = prune_taxa(names(sort(taxa_sums(data), decreasing = TRUE)[1:{input$treeTopOtu}]), data)"
)
)
if (input$treeSample) {
scriptArgs <- c(scriptArgs, "method = \"sampledodge\"")
} 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"))
})
output$tree <- renderPlot({
validate(
need(data16S(), "Requires an abundance dataset"),
need(
phy_tree(data16S(), errorIfNULL = FALSE),
"Requires a phylogenetic tree"
)
)
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)
}
})
output$mdsUI <- renderUI({
validate(need(data16S(), ""))
box(
......
......@@ -3,6 +3,7 @@ library(shinycustomloader)
source("panels/histo-ui.R", local = TRUE)
source("panels/histoFocus-ui.R", local = TRUE)
source("panels/heatmap-ui.R", local = TRUE)
source("panels/tree-ui.R", local = TRUE)
shinyUI(dashboardPage(
dashboardHeader(title = "Easy16S"),
......@@ -160,10 +161,8 @@ shinyUI(dashboardPage(
tabPanel("PCA",
withLoader(plotOutput("pca", height = 700)),
uiOutput("pcaUI")),
tabPanel(
"Phylogenetic tree",
withLoader(plotOutput("tree", height = 700)),
uiOutput("treeUI")
tabPanel("Phylogenetic tree",
tree)
),
tabPanel("Clustering",
withLoader(plotOutput("clust", height = 700)),
......
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