Improve gene results tables

DESCRIPTION

@@ -26,5 +26,6 @@ Imports:
     plotly,
     glue,
     gprofiler2,
+    rclipboard,
     shiny,
     shinyWidgets

R/genes_table.R

@@ -0,0 +1,108 @@
+#' Construct UI for the genes table.
+#' @noRd
+genes_table_ui <- function(id) {
+  verticalLayout(
+    div(
+      style = "margin-top: 16px",
+      splitLayout(
+        cellWidths = "auto",
+        uiOutput(NS(id, "copy")),
+        downloadButton(
+          NS(id, "download"),
+          "Download CSV",
+          class = "btn-outline-primary"
+        )
+      )
+    ),
+    div(
+      style = "margin-top: 16px; margin-bottom: 8px;",
+      DT::DTOutput(NS(id, "genes"))
+    )
+  )
+}
+
+#' Server for the genes table.
+#'
+#' @param data A reactive containing the results to be displayed.
+#'
+#' @noRd
+genes_table_server <- function(id, data) {
+  moduleServer(id, function(input, output, session) {
+    output$copy <- renderUI({
+      data <- data()
+
+      gene_ids <- data[, gene]
+      names <- data[hgnc_name != "", hgnc_name]
+
+      genes_text <- paste(gene_ids, collapse = "\n")
+      names_text <- paste(names, collapse = "\n")
+
+      splitLayout(
+        cellWidths = "auto",
+        rclipboard::rclipButton(
+          "copy_ids_button",
+          "Copy gene IDs",
+          genes_text,
+          icon = icon("clipboard"),
+          class = "btn-outline-primary"
+        ),
+        rclipboard::rclipButton(
+          "copy_names_button",
+          "Copy HGNC symbols",
+          names_text,
+          icon = icon("clipboard"),
+          class = "btn-outline-primary"
+        )
+      )
+    })
+
+    output$download <- downloadHandler(
+      filename = "ubigen.csv",
+      content = \(file) fwrite(data(), file = file),
+      contentType = "text/csv"
+    )
+
+    output$genes <- DT::renderDT({
+      DT::datatable(
+        data()[, .(
+          "Gene" = glue::glue_data(
+            data(),
+            "<a href=\"https://gtexportal.org/home/gene/{hgnc_name}\" ",
+            "target=\"_blank\">{hgnc_name}</a>"
+          ),
+          "Rank" = rank,
+          "Percentile" = percentile,
+          "Score" = score,
+          "Median" = median_expression,
+          "Mean" = mean_expression,
+          "Standard deviation" = sd_expression,
+          "Expressed" = above_zero,
+          "Above median" = above_median,
+          "Above 95%" = above_95
+        )],
+        options = list(
+          dom = "frtip",
+          pageLength = 100
+        ),
+        rownames = FALSE,
+        escape = FALSE,
+        selection = "none"
+      ) |>
+        DT::formatPercentage(
+          c(
+            "Percentile",
+            "Score",
+            "Expressed",
+            "Above median",
+            "Above 95%"
+          ),
+          digits = 2,
+        ) |>
+        DT::formatRound(c(
+          "Median",
+          "Mean",
+          "Standard deviation"
+        ))
+    })
+  })
+}

R/server.R

@@ -77,9 +77,9 @@ server <- function(input, output, session) {
     box_plot(ranked_data(), custom_genes())
   )
 
-  output$custom_genes_details <- DT::renderDT({
+  genes_table_server("custom_genes", reactive({
-    genes_table(ranked_data()[gene %chin% custom_genes()])
+    ranked_data()[gene %chin% custom_genes()]
-  })
+  }))
 
   output$scores_plot <- plotly::renderPlotly(scores_plot(
     ranked_data(),
@@ -91,15 +91,13 @@ server <- function(input, output, session) {
     ranked_data()[rank %in% selected_points$x]
   })
 
-  output$selected_genes <- DT::renderDataTable({
+  genes_table_server("selected_genes", reactive({
-    data <- if (nrow(selected_genes()) > 0) {
+    if (nrow(selected_genes()) > 0) {
       selected_genes()
     } else {
       ranked_data()
     }
-
+  }))
-    genes_table(data)
-  })
 
   gsea_genes <- reactive({
     sort(if (input$gsea_set == "top") {
@@ -169,61 +167,3 @@ server <- function(input, output, session) {
 
   output$gsea_plot_ranking <- plotly::renderPlotly(gsea_plot_ranking)
 }
-
-#' Create a displayable data table from the gene results data.
-#' @noRd
-genes_table <- function(data) {
-  data <- data[, .(
-    "Gene" = glue::glue_data(
-      data,
-      "<a href=\"https://gtexportal.org/home/gene/{hgnc_name}\" ",
-      "target=\"_blank\">{hgnc_name}</a>"
-    ),
-    "Rank" = rank,
-    "Percentile" = percentile,
-    "Score" = score,
-    "Median" = median_expression,
-    "Mean" = mean_expression,
-    "Standard deviation" = sd_expression,
-    "Expressed" = above_zero,
-    "Above median" = above_median,
-    "Above 95%" = above_95
-  )]
-
-  DT::datatable(
-    data,
-    options = list(
-      buttons = list(
-        list(
-          extend = "copy",
-          text = "Copy to clipboard"
-        ),
-        list(
-          extend = "csv",
-          text = "Download CSV"
-        )
-      ),
-      dom = "fBrtip",
-      pageLength = 100
-    ),
-    rownames = FALSE,
-    escape = FALSE,
-    selection = "none",
-    extensions = "Buttons"
-  ) |>
-    DT::formatPercentage(
-      c(
-        "Percentile",
-        "Score",
-        "Expressed",
-        "Above median",
-        "Above 95%"
-      ),
-      digits = 2,
-    ) |>
-    DT::formatRound(c(
-      "Median",
-      "Mean",
-      "Standard deviation"
-    ))
-}

R/ui.R

@@ -3,6 +3,7 @@
 ui <- function() {
   div(
     custom_css(),
+    rclipboard::rclipboardSetup(),
     navbarPage(
       theme = bslib::bs_theme(
         version = 5,
@@ -81,7 +82,7 @@ ui <- function() {
                 htmlOutput("custom_genes_synopsis"),
                 plotly::plotlyOutput("custom_genes_boxplot"),
                 div(class = "p-1"),
-                DT::dataTableOutput("custom_genes_details")
+                genes_table_ui("custom_genes")
               ),
               tabPanel(
                 "Top genes",
@@ -91,6 +92,7 @@ ui <- function() {
                   "or drag within the figure to select genes of interest."
                 )),
                 plotly::plotlyOutput("scores_plot"),
+                div(class = "p-1"),
                 div(paste0(
                   "Click on gene names to view them using the GTEx website. ",
                   "There, you can see the tissue specific expression behavior ",
@@ -98,7 +100,7 @@ ui <- function() {
                   "on."
                 )),
                 div(class = "p-1"),
-                DT::dataTableOutput("selected_genes")
+                genes_table_ui("selected_genes")
               ),
               tabPanel(
                 "GSEA",