diff --git a/panels/deseq-server.R b/panels/deseq-server.R index 7522154081ff9d7698888d05cb1e471e8ae5ce36..ddb3e73dcb98e7684e5cc25b84bf1542cf88189d 100644 --- a/panels/deseq-server.R +++ b/panels/deseq-server.R @@ -38,16 +38,6 @@ output$deseqTitleUI <- renderUI({ value = "Volcano Plot") }) -output$deseqPadjUI <- renderUI({ - validate(need(physeq(), "")) - sliderInput("deseqPadj", - label = "Adjusted p-value threshold (recommended 0.05 ):", - min = 0, - max = 1, - value = 0.05, - step = 0.01) -}) - output$deseqUI <- renderUI({ validate(need(physeq(), "")) box( @@ -56,27 +46,42 @@ output$deseqUI <- renderUI({ status = "primary", uiOutput("deseqContrastVarUI"), uiOutput("deseqContrastModUI"), - uiOutput("deseqTitleUI"), - uiOutput("deseqPadjUI") + # actionButton("deseqButton", label = "Execute", icon = icon("check"), class = "btn-primary"), + uiOutput("deseqTitleUI") ) }) -output$deseq <- metaRender2(renderPlot, { - validate( - need(physeq(), "Requires an abundance dataset"), - need(class(get_variable(physeq(), input$deseqContrastVar)) != "numeric" || - length(input$deseqContrastMod) == 2, "Requires a continuous design or a selection of two modalities for a discrete design.") - ) +design <- metaReactive2({ + req(input$deseqContrastVar) + metaExpr({as.formula(..(paste("~", input$deseqContrastVar)))}) +}) + +cds <- metaReactive2({ + req(design()) + req(physeq()) + data <- physeq() + metaExpr({phyloseq_to_deseq2(data, design = ..(design()))}) + }) + +dds <- metaReactive2({ + req(cds()) + + metaExpr({DESeq2::DESeq(..(cds()), sfType = "poscounts")}) +}) - design <- metaExpr({as.formula(..(paste("~", input$deseqContrastVar)))}) - cds <- metaExpr({phyloseq_to_deseq2(data, design = design)}) - dds <- metaExpr({DESeq2::DESeq(cds, sfType = "poscounts")}) +results <- metaReactive2({ + req(input$deseqContrastVar) + req(dds()) + req(physeq()) + req({class(get_variable(physeq(), input$deseqContrastVar)) == "numeric" || length(input$deseqContrastMod) == 2}) - results <- if (class(get_variable(data, input$deseqContrastVar)) == "numeric") { + data <- physeq() + + if (class(get_variable(data, input$deseqContrastVar)) == "numeric") { # First case: regression against a continuous variable metaExpr({ - DESeq2::results(object = dds, + DESeq2::results(object = ..(dds()), name = ..(input$deseqContrastVar), tidy = TRUE) %>% as_tibble() %>% @@ -84,28 +89,34 @@ output$deseq <- metaRender2(renderPlot, { inner_join(tax_table(data) %>% as("matrix") %>% as_tibble(rownames = "OTU"), by = "OTU") }) } else { + validate(need(length(input$deseqContrastMod) == 2, "Invalid input.")) + if (length(levels(get_variable(data, input$deseqContrastVar))) == 2) { # Second case: regression against a binary variable metaExpr({ - DESeq2::results(object = dds, - name = ..(DESeq2::resultsNames(dds)[-1]), + DESeq2::results(object = ..(dds()), + name = ..(DESeq2::resultsNames(..(dds()))[-1]), tidy = TRUE) %>% as_tibble() %>% rename(OTU = row) %>% inner_join(tax_table(data) %>% as("matrix") %>% as_tibble(rownames = "OTU"), by = "OTU") }) - } else { - # Third case: regression against a qualiative variable with three or more levels - metaExpr({ - DESeq2::results(object = dds, - contrast = ..(c(input$deseqContrastVar, input$deseqContrastMod[1], input$deseqContrastMod[2])), - tidy = TRUE) %>% - as_tibble() %>% rename(OTU = row) %>% - inner_join(tax_table(data) %>% as("matrix") %>% as_tibble(rownames = "OTU"), by = "OTU") - }) - } + } else { + # Third case: regression against a qualiative variable with three or more levels + metaExpr({ + DESeq2::results(object = ..(dds()), + contrast = ..(c(input$deseqContrastVar, input$deseqContrastMod[1], input$deseqContrastMod[2])), + tidy = TRUE) %>% + as_tibble() %>% rename(OTU = row) %>% + inner_join(tax_table(data) %>% as("matrix") %>% as_tibble(rownames = "OTU"), by = "OTU") + }) + } } +}) + +detail <-metaReactive2({ + data <- physeq() - detail <- if (class(get_variable(data, input$deseqContrastVar)) == "numeric") { + if (class(get_variable(data, input$deseqContrastVar)) == "numeric") { # First case metaExpr({ ..(paste0("You compare low and high values of the continuous variable ", input$deseqContrastVar, ".\nA positive log2FoldChange means more abundant for high values of ", input$deseqContrastVar, ".")) @@ -123,16 +134,22 @@ output$deseq <- metaRender2(renderPlot, { }) } } - - deseqTable <- metaExpr({ - - }) +}) + +output$deseq <- metaRender2(renderPlot, { + validate( + need(physeq(), "Requires an abundance dataset"), + need(class(get_variable(physeq(), input$deseqContrastVar)) == "numeric" || + length(input$deseqContrastMod) == 2, "Requires a continuous design or a selection of two modalities for a discrete design.")#, + #need(class(results()) == "DESeqResults", "Invalid input.") + ) + data <- physeq() deseqPlot <- metaExpr({ - ggplot(results %>% mutate(evidence = -log10(padj), + ggplot(..(results()) %>% mutate(evidence = -log10(padj), evolution = case_when( - padj <= ..(input$deseqPadj) & log2FoldChange < 0 ~ "Down", - padj <= ..(input$deseqPadj) & log2FoldChange > 0 ~ "Up", + padj <= 0.05 & log2FoldChange < 0 ~ "Down", + padj <= 0.05 & log2FoldChange > 0 ~ "Up", TRUE ~ "Not DA" )), aes(x = log2FoldChange, y = evidence)) + @@ -140,20 +157,15 @@ output$deseq <- metaRender2(renderPlot, { theme_bw(base_size = 16) + # clean up theme theme(legend.position = "none", # remove legend plot.subtitle = element_text(size = 12)) + # add subtitle - ggtitle(label = ..(input$deseqTitle), subtitle = detail) + # add informative title + ggtitle(label = ..(input$deseqTitle), subtitle = ..(detail())) + # add informative title xlab(expression(log[2]("FoldChange"))) + # x-axis label ylab(expression(-log[10]("adjusted p-value"))) + # y-axis label geom_vline(xintercept = 0, colour = "grey80", linetype = 2) + # add line at 0 - geom_hline(yintercept = -log10(..(input$deseqPadj)), colour = "grey80", linetype = 2) + + geom_hline(yintercept = -log10(0.05), colour = "grey80", linetype = 2) + scale_color_manual(values = c("Down" = "red", "Not DA" = "grey20", "Up" = "green")) # change colors }) metaExpr({ - design <- ..(design) - cds <- ..(cds) - dds <- ..(dds) - results <- ..(results) - detail <- ..(detail) p <- ..(deseqPlot) p }) @@ -176,3 +188,7 @@ observeEvent(input$deseq_output_code, ) } ) + +# output$deseqTable <- metaRender2(renderTable, { +# } +# )