From e56f1d6bfc73f676a6969aed3f62167aa6d04841 Mon Sep 17 00:00:00 2001 From: Midoux Cedric <cedric.midoux@irstea.fr> Date: Thu, 27 Feb 2020 17:33:55 +0100 Subject: [PATCH] modalDialog pour selection des data --- panels/Summary-server.R | 6 +- panels/dataInput.R | 165 ++++++++++++++++++++++++++++++++++++++++ server.R | 66 ++-------------- ui.R | 6 +- 4 files changed, 179 insertions(+), 64 deletions(-) create mode 100644 panels/dataInput.R diff --git a/panels/Summary-server.R b/panels/Summary-server.R index bb9499c..6b1e208 100644 --- a/panels/Summary-server.R +++ b/panels/Summary-server.R @@ -1,11 +1,11 @@ output$phyloseqPrint <- renderPrint({ validate( need( - data16S(), + physeq(), "Firstly, you should select a demo dataset or upload an abundance BIOM file.\nFor example, with Galaxy, a BIOM file can be obtained at the end of FROGS workflow with the 'FROGS BIOM to std BIOM' tool. \nMake sure that the phyloseq object in the RData file is called 'data'." ) ) - data16S() + physeq() }) output$sampledataTable <- renderUI({ @@ -66,3 +66,5 @@ output$tableGlom <- DT::renderDataTable(server = FALSE, { dplyr::select(-rowname) beautifulTable(joinGlom) }) + +uiOutput("downloadUI") diff --git a/panels/dataInput.R b/panels/dataInput.R new file mode 100644 index 0000000..d1ea368 --- /dev/null +++ b/panels/dataInput.R @@ -0,0 +1,165 @@ +dataInput <- function(failed = FALSE) { + modalDialog( + title = "Select your data", + + if (failed) + { + div( + "Invalide dataset. \n Please try again \n", + style = "font-weight: bold; color: red; text-align: center; white-space: pre-line" + ) + }, + + "Firstly, you should select a demo dataset or upload an abundance BIOM file. For example, with Galaxy, a BIOM file can be obtained at the end of FROGS workflow with the `FROGS BIOM to std BIOM` tool. Make sure that the phyloseq object in the RData file is called `data`.", + + radioButtons( + inputId = "dataset", + label = "Select dataset : ", + inline = TRUE, + choices = list( + "Demo" = "demo", + "Input data" = "input", + "Rdata" = "rdata" + ), + selected = "demo" + ), + + wellPanel(uiOutput("dataUI")), + + footer = tagList(modalButton("Cancel"), + actionButton(inputId = "okData", label = "OK")) + ) +} + +output$dataUI <- renderUI({ + if (is.null(input$dataset)) + return() + + switch( + input$dataset, + "demo" = selectInput( + inputId = "demo", + label = "Select a demo dataset", + choices = c("Chaillou et al., 2015" = "food", + # "Mach et al., 2015" = "kinetic", + # "Morton et al., 2017" = "soil", + # "Ravel et al., 2011" = "ravel", + # "biorare" = "biorare", + "toto" = "toto", + "GlobalPatterns" = "GlobalPatterns") + ), + "input" = tags$div( + tags$div( + title = "Abundance BIOM file come from FROGS with 'FROGS BIOM to std BIOM', Qiime or another metagenomic tool.", + fileInput( + inputId = "fileBiom", + label = "Abundance BIOM file : ", + placeholder = "data.biom" + ) + ), + radioButtons( + inputId = "biomFormat", + label = NULL, + inline = TRUE, + choices = c("STD BIOM" = "std", + "FROGS BIOM" = "frogs"), + selected = "std" + ), + # tags$div( + # style = "text-align:center", + # title = "Resample dataset such that all samples have the same library size. \nIt's using an random sampling without replacement.", + checkboxInput( + inputId = "rareData", + label = "Rarefy dataset", + value = TRUE + ), + # textOutput("rarefactionMin") + # ), + tags$div( + title = "Metadata table with variables (in columns) and samples (in rows). \nMake sure you follow the exact spelling of the sample names (1st column). \nThe import of an excel table is possible but not recommended.", + fileInput( + inputId = "fileMeta", + label = "Metadata table : ", + placeholder = "data.csv" + ) + ), + radioButtons( + inputId = "CSVsep", + label = "CSV separator : ", + inline = TRUE, + choices = c("<tab>" = "\t", + "," = ",", + ";" = ";", + excel = "excel" + ) + ), + fileInput( + inputId = "fileTree", + label = "Phylogenetic tree : ", + placeholder = "data.nwk"), + fileInput( + inputId = "fileSeq", + label = "Representative FASTA sequences of OTU : ", + placeholder = "data.fasta" + ) + ), + "rdata" = fileInput( + inputId = "fileRData", + label = "RData where 'data' is a phyloseq object : ", + placeholder = "data.RData" + ) + ) +}) + +observeEvent(input$okData, { + physeq(NULL) + try( + physeq( + switch( + input$dataset, + "demo" = + { + data(GlobalPatterns) + load("demo/demo.RData") + get(input$demo) + }, + "input" = + { + d <- .import_biom(input) + ## Format tax table + tax_table(d) <- .format_tax_table(tax_table(d)) + + ## import metadata and store it in phyloseq object + sample_data(d) <- .import_sample_data(input, d) + + ## Rarefy data + if (input$rareData) + { + d <- rarefy_even_depth( + d, + replace = FALSE, + rngseed = as.integer(Sys.time()), + verbose = FALSE + ) + } + d + }, + "rdata" = + { + ne <- new.env() + if (!is.null(input$fileRData)) + {load(input$fileRData$datapath, envir = ne)} + ne$data + } + ) + ), + silent = TRUE, + outFile = showModal(dataInput(failed = TRUE)) + ) + + if (class(physeq()) == "phyloseq") { + removeModal() + } else { + showModal(dataInput(failed = TRUE)) + } +}) diff --git a/server.R b/server.R index b91ec4f..1593d07 100644 --- a/server.R +++ b/server.R @@ -24,65 +24,13 @@ shinyServer source("panels/pca-server.R", local = TRUE) source("panels/tree-server.R", local = TRUE) source("panels/cluster-server.R", local = TRUE) - - data16S <- reactive({ - ## BIOM input - if (input$dataset == "input") - { - ## Unhappy path - if (is.null(input$fileBiom)) - return() - - ## Happy path - ## Import biom - d <- .import_biom(input) - - ## Format tax table - tax_table(d) <- .format_tax_table(tax_table(d)) - - ## import metadata and store it in phyloseq object - sample_data(d) <- .import_sample_data(input, d) - - ## Rarefy data - if (input$rareData) { - d <- rarefy_even_depth( - d, - replace = FALSE, - rngseed = as.integer(Sys.time()), - verbose = FALSE - ) - } - return(d) - } - - ## Rdata input - if (input$dataset == "rdata") - { - ## .import_from_rdata(input) ## does not work as a function for some reason - - ## Happy path - ne <- - new.env() ## new env to store RData content and avoid border effects - if (!is.null(input$fileRData)) - load(input$fileRData$datapath, envir = ne) - if (class(ne$data) == "phyloseq") - return(ne$data) - - ## Unhappy paths: everything else - return() - } - - ## Default case - load("demo/demo.RData") - return(get(input$dataset)) - + + physeq <- reactiveVal() + + showModal(dataInput()) + + observeEvent(input$dataButton, { + showModal(dataInput()) }) - data <- reactiveValues() - { - observe({ - if (!is.null(data16S())) - isolate(data <<- data16S()) - }) - } }) diff --git a/ui.R b/ui.R index 2b0db45..af18903 100644 --- a/ui.R +++ b/ui.R @@ -1,6 +1,6 @@ library(shinydashboard) library(shinycustomloader) -source("panels/Sidebar-ui.R", local = TRUE) +#source("panels/Sidebar-ui.R", local = TRUE) source("panels/Summary-ui.R", local = TRUE) source("panels/barplot-ui.R", local = TRUE) source("panels/heatmap-ui.R", local = TRUE) @@ -18,7 +18,7 @@ dashboardHeader(title = "Easy16S"), dashboardSidebar( actionButton("dataButton", "Select your data"), sidebarMenu( - menuItem("Data", tabName = "Data", icon = icon("dashboard")), + #menuItem("Data", tabName = "Data", icon = icon("dashboard")), menuItem("Summary", tabName = "Summary", icon = icon("dashboard")), menuItem("Barplot", tabName = "barplot", icon = icon("dashboard")), menuItem("Heatmap", tabName = "heatmap", icon = icon("dashboard")), @@ -33,7 +33,7 @@ dashboardHeader(title = "Easy16S"), )), dashboardBody( tabItems( - tabItem(tabName = "Data", Sidebar), + #tabItem(tabName = "Data", Sidebar), tabItem(tabName = "Summary", Summary), tabItem(tabName = "barplot", barplot), tabItem(tabName = "heatmap", heatmap), -- GitLab