Improve gene results tables

This commit is contained in:
Elias Projahn 2022-08-22 16:22:17 +02:00
parent e621761fd6
commit c97ee1ca30
4 changed files with 119 additions and 68 deletions

108
R/genes_table.R Normal file
View file

@ -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"
))
})
})
}

View file

@ -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,
"<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"
))
}

6
R/ui.R
View file

@ -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",