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