Commit 232c0c2e authored by Midoux Cedric's avatar Midoux Cedric

rework heatmap with shinymeta

parent e2854cd6
barplot <-fluidPage(outputCodeButton(withLoader(plotOutput("barplot", height = 700))), barplot <- fluidPage(outputCodeButton(withLoader(plotOutput("barplot", height = 700))),
uiOutput("barplotUI")) uiOutput("barplotUI"))
output$HeatmapUI <- renderUI({ output$heatmapUI <- renderUI({
validate(need(data16S(), "")) validate(need(physeq(), ""))
box( box(
title = "Setting : " , title = "Setting : " ,
width = NULL, width = NULL,
...@@ -10,18 +10,18 @@ output$HeatmapUI <- renderUI({ ...@@ -10,18 +10,18 @@ output$HeatmapUI <- renderUI({
selectInput( selectInput(
"heatmapGrid", "heatmapGrid",
label = "Subplot : ", label = "Subplot : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(physeq()))
), ),
selectInput( selectInput(
"heatmapX", "heatmapX",
label = "X : ", label = "X : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(physeq()))
), ),
sliderInput( sliderInput(
"heatmapTopOtu", "heatmapTopOtu",
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 = 250 value = 250
), ),
selectInput( selectInput(
...@@ -53,68 +53,45 @@ output$HeatmapUI <- renderUI({ ...@@ -53,68 +53,45 @@ output$HeatmapUI <- renderUI({
"median", "median",
"centroid" "centroid"
) )
), )
collapsedBox(verbatimTextOutput("heatmapScript"), title = "RCode")
) )
}) })
output$heatmapScript <- renderText({ output$heatmap <- metaRender2(renderPlot, {
scriptArgs <- validate(need(physeq(), "Requires an abundance dataset"))
c(
glue(
"prune_taxa(names(sort(taxa_sums(data), decreasing = TRUE)[1:{input$heatmapTopOtu}]), data)"
),
glue("distance = \"{input$heatmapDist}\""),
glue("method = \"{input$heatmapMethod}\""),
"low = \"yellow\"",
"high = \"red\"",
"na.value = \"white\""
)
if (!is.null(checkNull(input$heatmapX))) {
scriptArgs <-
c(scriptArgs, glue("sample.order = \"{input$heatmapX}\""))
}
if (!is.null(checkNull(input$heatmapTitle))) {
scriptArgs <-
c(scriptArgs, glue("title = \"{input$heatmapTitle}\""))
}
script <- c( heatmapGrid <- if (!is.null(checkNull(input$heatmapGrid))) {
scriptHead, metaExpr({
"# Plot heatmap", facet_grid(..(paste(".", "~", input$heatmapGrid)), scales = "free_x")
glue("p <- plot_heatmap({glue_collapse(scriptArgs, sep=', ')})") })
)
if (!is.null(checkNull(input$heatmapGrid))) {
script <- c(
script,
glue(
"p <- p + facet_grid(\". ~ {input$heatmapGrid}\", scales = \"free_x\")"
)
)
} }
script <- c(script, "", "plot(p)")
return(glue_collapse(script, sep = "\n")) metaExpr({
physeq_data <- physeq()
physeq_select <- prune_taxa(names(sort(taxa_sums(physeq_data), decreasing = TRUE)[1:..(input$heatmapTopOtu)]), physeq_data)
p <- plot_heatmap(
physeq = physeq_select,
distance = ..(input$heatmapDist),
method = ..(input$heatmapMethod),
title = ..(checkNull(input$heatmapTitle)),
sample.order = ..(checkNull(input$heatmapX)),
low = "yellow",
high = "red",
na.value = "white"
)
p + ..(heatmapGrid)
})
}) })
output$Heatmap <- renderPlot({ observeEvent(input$heatmap_output_code,
validate(need(data16S(), {
"Requires an abundance dataset")) displayCodeModal(
p <- plot_heatmap( expandChain(
physeq = prune_taxa(names(sort( quote(library(phyloseq)),
taxa_sums(data16S()), decreasing = TRUE quote(library(phyloseq.extended)),
)[1:input$heatmapTopOtu]), data16S()), "# Replace `physeq_data` with you own data.",
distance = input$heatmapDist, output$heatmap()
method = input$heatmapMethod, )
title = checkNull(input$heatmapTitle), )
sample.order = checkNull(input$heatmapX), }
low = "yellow", )
high = "red",
na.value = "white"
)
if (!is.null(checkNull(input$heatmapGrid))) {
p <-
p + facet_grid(paste(".", "~", input$heatmapGrid), scales = "free_x")
}
return(p)
})
heatmap <- fluidPage(withLoader(plotOutput("Heatmap", height = 700)), heatmap <- fluidPage(outputCodeButton(withLoader(plotOutput("heatmap", height = 700))),
uiOutput("HeatmapUI")) 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