Commit 34cdaede authored by Midoux Cedric's avatar Midoux Cedric

panel/histoFocus

parent a8a1caf3
output$histFocusUIfocusRank <- renderUI({
validate(need(data16S(), ""))
radioButtons(
"focusRank",
label = "Taxonomic rank : ",
choices = rank_names(data16S())[-length(rank_names(data16S()))],
inline = TRUE
)
})
output$histFocusUIfocusTaxa <- renderUI({
validate(need(data16S(), ""),
need(input$focusRank, ""))
selectInput(
"focusTaxa",
label = "Selected taxa : ",
choices = unique(as.vector(tax_table(data16S(
))[, input$focusRank])),
selected = TRUE
)
})
output$histFocusUIfocusNbTaxa <- renderUI({
validate(need(data16S(), ""))
sliderInput(
"focusNbTaxa",
label = "Number of sub-taxa : ",
min = 0,
#max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$focusRank)]))[, as.integer(input$focusRank)]==input$focusTaxa)
max = 30,
value = 10
)
})
output$histFocusUIfocusGrid <- renderUI({
validate(need(data16S(), ""))
selectInput("focusGrid",
label = "Subplot : ",
choices = c("..." = 0, sample_variables(data16S())))
})
output$histFocusUIfocusX <- renderUI({
validate(need(data16S(), ""))
selectInput("focusX",
label = "X : ",
choices = c("..." = 0, sample_variables(data16S())))
})
output$histFocusUI <- renderUI({
validate(need(data16S(), ""))
box(
title = "Setting : ",
width = NULL,
status = "primary",
uiOutput("histFocusUIfocusRank"),
uiOutput("histFocusUIfocusTaxa"),
uiOutput("histFocusUIfocusNbTaxa"),
uiOutput("histFocusUIfocusGrid"),
uiOutput("histFocusUIfocusX"),
collapsedBox(verbatimTextOutput("histFocusScript"), title = "RCode")
)
})
output$histFocusScript <- renderText({
scriptArgs <- c(
"physeq = data",
glue("taxaRank1 = \"{input$focusRank}\""),
glue("taxaSet1 = \"{input$focusTaxa}\""),
glue(
"taxaRank2 = \"{rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1]}\""
),
glue("numberOfTaxa = {input$focusNbTaxa}"),
glue(
"fill = \"{rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1]}\""
)
)
if (!is.null(checkNull(input$focusX))) {
scriptArgs <- c(scriptArgs, glue("x = \"{input$focusX}\""))
}
script <- c(
scriptHead,
"# Plot filtered barplot",
glue(
"p <- plot_composition({glue_collapse(scriptArgs, sep=', ')})"
)
)
if (!is.null(checkNull(input$focusGrid))) {
script <- c(
script,
glue(
"p <- p + facet_grid(\". ~ {input$focusGrid}\", scales = \"free_x\")"
)
)
}
script <- c(script, "", "plot(p)")
return(glue_collapse(script, sep = "\n"))
})
output$histFocus <- renderPlot({
validate(
need(data16S(),
"Requires an abundance dataset"),
need(input$focusRank, ""),
need(input$focusTaxa, "")
)
p <- plot_composition(
physeq = data16S(),
taxaRank1 = input$focusRank,
taxaSet1 = input$focusTaxa,
taxaRank2 = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
numberOfTaxa = input$focusNbTaxa,
fill = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
x = ifelse(is.null(checkNull(input$focusX)), "Sample", input$focusX)
)
if (!is.null(checkNull(input$focusGrid))) {
p <-
p + facet_grid(paste(".", "~", input$focusGrid), scales = "free_x")
}
return(p)
})
histFocus <-fluidPage(withLoader(plotOutput("histFocus", height = 700)),
uiOutput("histFocusUI"))
......@@ -9,6 +9,7 @@ shinyServer
(function(input, output, session)
{
source("panels/histo-server.R", local = TRUE)
source("panels/histoFocus-server.R", local = TRUE)
checkNull <- function(x) {
if (!exists(as.character(substitute(x)))) {
......@@ -241,129 +242,6 @@ shinyServer
beautifulTable(joinGlom)
})
output$histFocusUIfocusRank <- renderUI({
validate(need(data16S(), ""))
radioButtons(
"focusRank",
label = "Taxonomic rank : ",
choices = rank_names(data16S())[-length(rank_names(data16S()))],
inline = TRUE
)
})
output$histFocusUIfocusTaxa <- renderUI({
validate(need(data16S(), ""),
need(input$focusRank, ""))
selectInput(
"focusTaxa",
label = "Selected taxa : ",
choices = unique(as.vector(tax_table(data16S(
))[, input$focusRank])),
selected = TRUE
)
})
output$histFocusUIfocusNbTaxa <- renderUI({
validate(need(data16S(), ""))
sliderInput(
"focusNbTaxa",
label = "Number of sub-taxa : ",
min = 0,
#max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$focusRank)]))[, as.integer(input$focusRank)]==input$focusTaxa)
max = 30,
value = 10
)
})
output$histFocusUIfocusGrid <- renderUI({
validate(need(data16S(), ""))
selectInput("focusGrid",
label = "Subplot : ",
choices = c("..." = 0, sample_variables(data16S())))
})
output$histFocusUIfocusX <- renderUI({
validate(need(data16S(), ""))
selectInput("focusX",
label = "X : ",
choices = c("..." = 0, sample_variables(data16S())))
})
output$histFocusUI <- renderUI({
validate(need(data16S(), ""))
box(
title = "Setting : ",
width = NULL,
status = "primary",
uiOutput("histFocusUIfocusRank"),
uiOutput("histFocusUIfocusTaxa"),
uiOutput("histFocusUIfocusNbTaxa"),
uiOutput("histFocusUIfocusGrid"),
uiOutput("histFocusUIfocusX"),
collapsedBox(verbatimTextOutput("histFocusScript"), title = "RCode")
)
})
output$histFocusScript <- renderText({
scriptArgs <- c(
"physeq = data",
glue("taxaRank1 = \"{input$focusRank}\""),
glue("taxaSet1 = \"{input$focusTaxa}\""),
glue(
"taxaRank2 = \"{rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1]}\""
),
glue("numberOfTaxa = {input$focusNbTaxa}"),
glue(
"fill = \"{rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1]}\""
)
)
if (!is.null(checkNull(input$focusX))) {
scriptArgs <- c(scriptArgs, glue("x = \"{input$focusX}\""))
}
script <- c(
scriptHead,
"# Plot filtered barplot",
glue(
"p <- plot_composition({glue_collapse(scriptArgs, sep=', ')})"
)
)
if (!is.null(checkNull(input$focusGrid))) {
script <- c(
script,
glue(
"p <- p + facet_grid(\". ~ {input$focusGrid}\", scales = \"free_x\")"
)
)
}
script <- c(script, "", "plot(p)")
return(glue_collapse(script, sep = "\n"))
})
output$histFocus <- renderPlot({
validate(
need(data16S(),
"Requires an abundance dataset"),
need(input$focusRank, ""),
need(input$focusTaxa, "")
)
p <- plot_composition(
physeq = data16S(),
taxaRank1 = input$focusRank,
taxaSet1 = input$focusTaxa,
taxaRank2 = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
numberOfTaxa = input$focusNbTaxa,
fill = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
x = ifelse(is.null(checkNull(input$focusX)), "Sample", input$focusX)
)
if (!is.null(checkNull(input$focusGrid))) {
p <-
p + facet_grid(paste(".", "~", input$focusGrid), scales = "free_x")
}
return(p)
})
output$clustUI <- renderUI({
validate(need(data16S(), ""))
box(
......
library(shinydashboard)
library(shinycustomloader)
source("panels/histo-ui.R", local = TRUE)
source("panels/histoFocus-ui.R", local = TRUE)
shinyUI(dashboardPage(
dashboardHeader(title = "Easy16S"),
......@@ -103,11 +104,8 @@ shinyUI(dashboardPage(
),
tabPanel("Global barplot",
histo),
tabPanel(
"Filtered barplot",
withLoader(plotOutput("histFocus", height = 700)),
uiOutput("histFocusUI")
),
tabPanel("Filtered barplot",
histFocus),
tabPanel("Heatmap",
withLoader(plotOutput("Heatmap", height = 700)),
uiOutput("HeatmapUI")),
......
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