From 28cd7b47c66d24649697c9e172f8e04416dfaa4d Mon Sep 17 00:00:00 2001
From: Midoux Cedric <cedric.midoux@irstea.fr>
Date: Tue, 24 Mar 2020 18:18:09 +0100
Subject: [PATCH] rework barplot with shinymeta
---
panels/barplot-server.R | 104 +++++++++++++++++-----------------------
panels/barplot-ui.R | 4 +-
server.R | 1 +
ui.R | 1 +
4 files changed, 48 insertions(+), 62 deletions(-)
diff --git a/panels/barplot-server.R b/panels/barplot-server.R
index 86a7751..cf09c42 100644
--- a/panels/barplot-server.R
+++ b/panels/barplot-server.R
@@ -1,64 +1,64 @@
output$barplotShowRankUI <- renderUI({
- validate(need(data16S(), ""))
+ validate(need(physeq(), ""))
radioButtons(
"barplotShowRank",
label = "Taxonomic rank used for coloring : ",
- choices = c(rank_names(data16S()), "OTU"),
+ choices = c(rank_names(physeq()), "OTU"),
selected = "Phylum",
inline = TRUE
)
})
output$barplotFilterRankUI <- renderUI({
- validate(need(data16S(), ""))
+ validate(need(physeq(), ""))
radioButtons(
"barplotFilterRank",
label = "Taxonomic rank used for filtering : ",
- choices = c("NULL" = 0, rank_names(data16S())),
+ choices = c("NULL" = 0, rank_names(physeq())),
inline = TRUE
)
})
output$barplotTaxaUI <- renderUI({
- validate(need(data16S(), ""),
+ validate(need(physeq(), ""),
need(input$barplotFilterRank, ""),
need(input$barplotFilterRank!=0, ""))
selectInput(
"barplotTaxa",
label = "Selected filter taxa : ",
- choices = unique(as.vector(tax_table(data16S())[, input$barplotFilterRank])),
+ choices = unique(as.vector(tax_table(physeq())[, input$barplotFilterRank])),
selected = TRUE
)
})
output$barplotNbTaxaUI <- renderUI({
- validate(need(data16S(), ""))
+ validate(need(physeq(), ""))
sliderInput(
"barplotNbTaxa",
label = "Number of sub-taxa : ",
min = 1,
- #max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$barplotFilterRank)]))[, as.integer(input$barplotFilterRank)]==input$barplotTaxa)
+ #max = sum(tax_table(tax_glom(physeq(), rank_names(physeq())[1+as.integer(input$barplotFilterRank)]))[, as.integer(input$barplotFilterRank)]==input$barplotTaxa)
max = 30,
value = 10
)
})
output$barplotGridUI <- renderUI({
- validate(need(data16S(), ""))
+ validate(need(physeq(), ""))
selectInput("barplotGrid",
label = "Subplot : ",
- choices = c("..." = 0, sample_variables(data16S())))
+ choices = c("..." = 0, sample_variables(physeq())))
})
output$barplotXUI <- renderUI({
- validate(need(data16S(), ""))
+ validate(need(physeq(), ""))
selectInput("barplotX",
label = "X : ",
- choices = c("..." = 0, sample_variables(data16S())))
+ choices = c("..." = "Sample", sample_variables(physeq())))
})
output$barplotUI <- renderUI({
- validate(need(data16S(), ""))
+ validate(need(physeq(), ""))
box(
title = "Setting : ",
width = NULL,
@@ -68,57 +68,41 @@ output$barplotUI <- renderUI({
uiOutput("barplotTaxaUI"),
uiOutput("barplotNbTaxaUI"),
uiOutput("barplotGridUI"),
- uiOutput("barplotXUI"),
- collapsedBox(verbatimTextOutput("barplotScript"), title = "RCode")
+ uiOutput("barplotXUI")
)
})
-output$barplotScript <- renderText({
- scriptArgs <- c(
- "physeq = data",
- glue("taxaRank1 = \"{input$barplotFilterRank}\""),
- glue("taxaSet1 = \"{input$barplotTaxa}\""),
- glue("taxaRank2 = \"{input$barplotShowRank}\""),
- glue("numberOfTaxa = {input$barplotNbTaxa}")
- )
- if (!is.null(checkNull(input$barplotX))) {
- scriptArgs <- c(scriptArgs, glue("x = \"{input$barplotX}\""))
+output$barplot <- metaRender2(renderPlot, {
+ validate(need(physeq(), "Requires an abundance dataset"),
+ need(input$barplotShowRank, ""))
+
+ barplotGrid <- if (!is.null(checkNull(input$barplotGrid))) {
+ metaExpr({
+ facet_grid(..(paste(".", "~", input$barplotGrid)), scales = "free_x")
+ })
}
- script <- c(
- scriptHead,
- "# Plot filtered barplot",
- glue(
- "p <- plot_composition({glue_collapse(scriptArgs, sep=', ')})"
- )
- )
- if (!is.null(checkNull(input$barplotGrid))) {
- script <- c(
- script,
- glue(
- "p <- p + facet_grid(\". ~ {input$barplotGrid}\", scales = \"free_x\")"
- )
+
+ metaExpr({
+ p <- plot_composition(
+ physeq = physeq(),
+ taxaRank1 = ..(checkNull(input$barplotFilterRank)),
+ taxaSet1 = ..(input$barplotTaxa),
+ taxaRank2 = ..(input$barplotShowRank),
+ numberOfTaxa = ..(input$barplotNbTaxa),
+ x = ..(input$barplotX)
)
- }
- script <- c(script, "", "plot(p)")
-
- return(glue_collapse(script, sep = "\n"))
+ p + ..(barplotGrid)
+ })
})
-output$barplot <- renderPlot({
- validate(
- need(data16S(), "Requires an abundance dataset"),
- need(input$barplotShowRank, "")
- )
- p <- plot_composition(
- physeq = data16S(),
- taxaRank1 = checkNull(input$barplotFilterRank),
- taxaSet1 = input$barplotTaxa,
- taxaRank2 = input$barplotShowRank,
- numberOfTaxa = input$barplotNbTaxa,
- x = ifelse(is.null(checkNull(input$barplotX)), "Sample", input$barplotX)
- )
- if (!is.null(checkNull(input$barplotGrid))) {
- p <- p + facet_grid(paste(".", "~", input$barplotGrid), scales = "free_x")
- }
- return(p)
-})
+observeEvent(input$barplot_output_code,
+ {
+ displayCodeModal(
+ expandChain(
+ quote(library(phyloseq)),
+ quote(library(phyloseq.extended)),
+ output$barplot()
+ )
+ )
+ }
+)
diff --git a/panels/barplot-ui.R b/panels/barplot-ui.R
index 0e47c82..e6233c9 100644
--- a/panels/barplot-ui.R
+++ b/panels/barplot-ui.R
@@ -1,2 +1,2 @@
-barplot <-fluidPage(withLoader(plotOutput("barplot", height = 700)),
- uiOutput("barplotUI"))
+barplot <-fluidPage(outputCodeButton(withLoader(plotOutput("barplot", height = 700))),
+ uiOutput("barplotUI"))
diff --git a/server.R b/server.R
index 2f8fd37..a8732bb 100644
--- a/server.R
+++ b/server.R
@@ -1,6 +1,7 @@
options(shiny.maxRequestSize = 30 * 1024 ^ 2)
library(shinydashboard)
+library(shinymeta)
library(phyloseq)
library(phyloseq.extended)
library(ggplot2)
diff --git a/ui.R b/ui.R
index d39b4af..af66624 100644
--- a/ui.R
+++ b/ui.R
@@ -1,4 +1,5 @@
library(shinydashboard)
+library(shinymeta)
library(shinycustomloader)
source("panels/Summary-ui.R", local = TRUE)
source("panels/barplot-ui.R", local = TRUE)
--
GitLab