diff --git a/server.R b/server.R index c0f43f60bb469766508c639c8811eb426872f103..d57748a10ae3f81d26ad76eb4edaed5250cf58ad 100644 --- a/server.R +++ b/server.R @@ -17,7 +17,7 @@ shinyServer return(x) } } - + beautifulTable <- function(data) { DT::datatable( data = data, @@ -44,13 +44,13 @@ shinyServer height = "auto" ) } - + source({ "https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R" }) - + source("internals.R") - + data16S <- reactive({ ## BIOM input if (input$dataset == "input") @@ -58,17 +58,17 @@ shinyServer ## 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( @@ -80,12 +80,12 @@ shinyServer } 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 @@ -93,17 +93,17 @@ shinyServer 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)) - + }) - + data <- reactiveValues() { observe({ @@ -111,7 +111,7 @@ shinyServer isolate(data <<- data16S()) }) } - + output$downloadData <- { downloadHandler( filename = function() { @@ -122,7 +122,7 @@ shinyServer } ) } - + output$downloadUI <- renderUI({ validate(need(data16S(), "")) tags$div( @@ -131,15 +131,15 @@ shinyServer downloadButton("downloadData", "Download", style = "color: black; background-color: gray90") ) }) - + output$rarefactionMin <- renderText({ validate(need(input$fileBiom, ""), need(input$dataset == "input", "")) paste("(min sample =", format(min(sample_sums(data16S( - + ))), big.mark = " "), "reads)") }) - + output$phyloseqPrint <- renderPrint({ validate( need( @@ -149,12 +149,12 @@ shinyServer ) data16S() }) - + output$sampledataTable <- renderTable({ validate(need(sample_data(data16S(), errorIfNULL = FALSE), "")) sapply(sample_data(data16S()), class) }, rownames = TRUE, colnames = FALSE, caption = "Class of sample_data", caption.placement = "top") - + output$summaryTable <- renderUI({ validate(need(data16S(), "")) box( @@ -178,7 +178,7 @@ shinyServer ) ) }) - + output$histUI <- renderUI({ validate(need(data16S(), "")) box( @@ -207,7 +207,7 @@ shinyServer ) ) }) - + output$histo <- renderPlot({ validate(need(data16S(), "Requires an abundance dataset")) @@ -223,7 +223,7 @@ shinyServer } return(p) }) - + output$histFocusUIfocusRank <- renderUI({ validate(need(data16S(), "")) radioButtons( @@ -233,19 +233,19 @@ shinyServer inline = TRUE ) }) - + output$histFocusUIfocusTaxa <- renderUI({ validate(need(data16S(), "")) selectInput( "focusTaxa", label = "Selected taxa : ", choices = unique(as.vector(tax_table(data16S( - + ))[, input$focusRank])), selected = TRUE ) }) - + output$histFocusUIfocusNbTaxa <- renderUI({ validate(need(data16S(), "")) sliderInput( @@ -257,21 +257,21 @@ shinyServer 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$histoFocus <- renderPlot({ validate(need(data16S(), "Requires an abundance dataset")) @@ -290,7 +290,7 @@ shinyServer } return(p) }) - + output$clustUI <- renderUI({ validate(need(data16S(), "")) box( @@ -331,7 +331,7 @@ shinyServer ) ) }) - + output$clust <- renderPlot({ validate(need(data16S(), "Requires an abundance dataset")) @@ -342,7 +342,7 @@ shinyServer color = checkNull(input$clustCol) ) }) - + output$richnessAUI <- renderUI({ validate(need(data16S(), "")) box( @@ -403,7 +403,7 @@ shinyServer ) ) }) - + output$richnessA <- renderPlot({ validate(need(data16S(), "Requires an abundance dataset")) @@ -425,7 +425,7 @@ shinyServer } return(p) }) - + output$richnessATable <- renderUI({ validate(need(data16S(), "Requires an abundance dataset")) @@ -433,7 +433,7 @@ shinyServer SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2) ))) }) - + output$richnessBUI <- renderUI({ box( title = "Setting : " , @@ -449,7 +449,7 @@ shinyServer value = "Beta diversity heatmap") ) }) - + output$richnessB <- renderPlot({ validate(need(data16S(), "Requires an abundance dataset")) @@ -482,7 +482,7 @@ shinyServer ) return(p + scale_fill_gradient2()) }) - + output$networkBUI <- renderUI({ validate(need(data16S(), "")) box( @@ -523,7 +523,7 @@ shinyServer ) ) }) - + output$networkB <- renderPlot({ validate(need(data16S(), "Requires an abundance dataset")) @@ -544,7 +544,7 @@ shinyServer ) return(p) }) - + output$richnessBTable <- renderUI({ validate(need(data16S(), "Requires an abundance dataset")) @@ -554,7 +554,7 @@ shinyServer ), digits = 2) ))) }) - + output$rarefactionCurve <- renderPlot({ validate(need(data16S(), "Requires an abundance dataset")) @@ -569,16 +569,16 @@ shinyServer if (!is.null(checkNull(input$rarefactionGrid))) { p <- p + facet_grid(paste(".", "~", input$rarefactionGrid)) } - + if (input$rarefactionMin) { p <- p + geom_vline(xintercept = min(sample_sums(data16S())), color = "gray60") } return(p + ggtitle(input$rarefactionTitle)) - + }) - + output$rarefactionCurveUI <- renderUI({ validate(need(data16S(), "")) box( @@ -613,7 +613,7 @@ shinyServer ) ) }) - + output$HeatmapUI <- renderUI({ validate(need(data16S(), "")) box( @@ -672,7 +672,7 @@ shinyServer ) ) }) - + output$Heatmap <- renderPlot({ validate(need(data16S(), "Requires an abundance dataset")) @@ -694,7 +694,7 @@ shinyServer } return(p) }) - + output$treeUI <- renderUI({ validate(need(data16S(), "")) box( @@ -733,7 +733,7 @@ shinyServer ) ) }) - + output$tree <- renderPlot({ validate( need(data16S(), "Requires an abundance dataset"), @@ -762,7 +762,7 @@ shinyServer return(p) } }) - + output$acpUI <- renderUI({ validate(need(data16S(), "")) box( @@ -826,7 +826,7 @@ shinyServer ) ) }) - + output$acp <- renderPlot({ validate( need(data16S(), "Requires an abundance dataset"), @@ -842,7 +842,7 @@ shinyServer axes = as.numeric(input$acpAxes), title = checkNull(input$acpTitle), color = checkNull(input$acpCol), - replicate = checkNull(input$acpRep), + replicate = if (is.null(checkNull(input$acpRep))) { NULL } else { checkNull(input$acpRep) }, shape = checkNull(input$acpShape), label = checkNull(input$acpLabel) )