DeseqResults

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, {
+# }
+# )