R/server_2_page.R

In ArthurPERE/RNASeqDE:

#' @importFrom cowplot plot_grid
twoPlot_server <- function(input, output, session, plot1, plot2) {
  observe({
    if (is.ggplot(plot1()) && is.ggplot(plot2())) {
      output$plot <- renderPlot(plot_grid(plot1(), plot2(), nrow = 1, align = "v"))
    } else {
      output$plot <- renderPlot("error")
    }
  })
}

comparison_box_server <- function(input, output, session, data, plot_list) {
  observeEvent(ignoreInit = T, {
    data
    input$pvalue
  }, {

    feedbackDanger(session$ns("pvalue"), is.na(input$pvalue), "It return a NA value")

    if (!is.na(input$pvalue)) {
      # update the table with the Pvalue you want
      output$table <- renderTable({
        data()[pval_adj <= input$pvalue, .(total = .N, up = sum(logFC > 0), down = sum(logFC < 0)), by = comp_name ]
      })


      # update the heatmap
      # keep the rows that have at least one of the Pvalue is down to the Pvalue they want
      keep.row <- data()[, sum(pval_adj <= input$pvalue) >= 1, by = rn][(V1)]
      if (nrow(keep.row) >= 1) {
        plot_list$heatmap_non_contrast <- heatmap_ggplot(data()[
          keep.row,
          on = "rn"
        ], "heatmap non contrasted")

        plot_list$heatmap_contrast <- heatmap_ggplot(
          data()[pval_adj <= input$pvalue],
          "heatmap contrasted"
        )
      }
      output$plot_HEATMAP <- renderPlot(plot_grid(plot_list$heatmap_non_contrast, plot_list$heatmap_contrast, nrow = 1, align = "v"))
    }
  })

  observeEvent(ignoreInit = T, {
    data
    input$comparison
    input$pvalue
  }, {
    if (!is.na(input$pvalue)) {

      graph = plot_volcano_smear(data(), input$pvalue, input$comparison)

      plot_list$Smear_plot = graph[[paste0(input$comparison, "_Smear")]]
      plot_list$volcano_plot = graph[[paste0(input$comparison, "_volcano")]]
    }
  })

  return(plot_list)
}