diff --git a/DESCRIPTION b/DESCRIPTION index c732b2a..6793809 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,5 +26,6 @@ Imports: plotly, glue, gprofiler2, + rclipboard, shiny, shinyWidgets diff --git a/R/genes_table.R b/R/genes_table.R new file mode 100644 index 0000000..d8b54a2 --- /dev/null +++ b/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(), + "{hgnc_name}" + ), + "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" + )) + }) + }) +} diff --git a/R/server.R b/R/server.R index 78505d6..f02f504 100644 --- a/R/server.R +++ b/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(ranked_data()[gene %chin% custom_genes()]) - }) + genes_table_server("custom_genes", reactive({ + 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({ - data <- if (nrow(selected_genes()) > 0) { + genes_table_server("selected_genes", reactive({ + 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, - "{hgnc_name}" - ), - "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" - )) -} diff --git a/R/ui.R b/R/ui.R index 5ecf9b4..8880886 100644 --- a/R/ui.R +++ b/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",