Add outputs for custom genes

This commit is contained in:
Elias Projahn 2022-05-30 21:59:40 +02:00
parent 5f5670171d
commit 7f69b26a49
3 changed files with 95 additions and 11 deletions

View file

@ -24,7 +24,7 @@ overview_plot <- function(ranked_data,
yaxis = list(title = "Score")
)
if (!is.null(highlighted_genes)) {
if (length(highlighted_genes) > 0) {
figure <- figure |>
plotly::add_markers(
data = ranked_data[gene %chin% highlighted_genes],
@ -44,6 +44,33 @@ overview_plot <- function(ranked_data,
figure
}
#' Create a plot comparing some genes with the overall ranking.
#'
#' @param ranked_data The ranking to visualize.
#' @param highlighted_genes Genes that will be compared.
#'
#' @return A `plotly` figure.
#' @noRd
box_plot <- function(ranked_data, highlighted_genes) {
data <- data.table::copy(ranked_data)
data[, group := data.table::fifelse(
gene %chin% highlighted_genes,
"Your genes",
"Other genes"
)]
plotly::plot_ly() |>
plotly::add_boxplot(
data = data,
x = ~score,
y = ~group,
boxpoints = FALSE
) |> plotly::layout(
xaxis = list(title = "Score"),
yaxis = list(title = "")
)
}
#' Create plot showing the distribution of scores using `plotly`.
#'
#' @param ranked_data Data on genes with precomputed ranks.

View file

@ -1,6 +1,6 @@
#' Server implementing the main user interface.
#' @noRd
server <- function(input, output) {
server <- function(input, output, session) {
ranked_data <- reactive({
total_weight <- abs(input$cross_sample_weight) + abs(input$sd_expression)
data <- data.table::copy(ubigen::genes)
@ -10,6 +10,9 @@ server <- function(input, output) {
input$sd_expression * sd_expression_normalized) /
total_weight]
# Normalize scores to be between 0.0 and 1.0.
data[, score := (score - min(score)) / (max(score) - min(score))]
data.table::setorder(data, -score)
data[, rank := .I]
data[, percentile := 1 - rank / max(rank)]
@ -24,6 +27,50 @@ server <- function(input, output) {
highlighted_genes = custom_genes()
))
observeEvent(custom_genes(),
{ # nolint
if (length(custom_genes()) > 0) {
updateTabsetPanel(session, "custom_genes_panel", selected = "show")
} else {
updateTabsetPanel(session, "custom_genes_panel", selected = "hide")
}
},
ignoreNULL = FALSE
)
output$custom_genes_synopsis <- renderText({
comparison_gene_ids <- custom_genes()
if (length(comparison_gene_ids) > 1) {
reference <- ranked_data()[!gene %chin% comparison_gene_ids, score]
comparison <- ranked_data()[gene %chin% comparison_gene_ids, score]
p_value <- stats::wilcox.test(
x = comparison,
y = reference,
alternative = "greater"
)$p.value
reference_median <- stats::median(reference)
comparison_median <- stats::median(comparison)
HTML(glue::glue(
"The p-value for the alternative hypothesis that your genes have ",
"higher scores than other genes is <b>{format(round(p_value, ",
"digits = 4), nsmall = 4, scientific = FALSE)}</b>. This value was ",
"computed using a Wilcoxon rank sum test. The median score of your ",
"genes is <b>{format(round(comparison_median, digits = 2), ",
"nsmall = 2, scientific = FALSE)}</b> compared to a median score of ",
"<b>{format(round(reference_median, digits = 2), nsmall = 2, ",
"scientific = FALSE)}</b> of the other genes."
))
}
})
output$custom_genes_boxplot <- plotly::renderPlotly(
box_plot(ranked_data(), custom_genes())
)
output$scores_plot <- plotly::renderPlotly(scores_plot(
ranked_data(),
highlighted_genes = custom_genes()

16
R/ui.R
View file

@ -55,10 +55,20 @@ ui <- function() {
),
mainPanel(
width = 9,
h3("Distribution of scores"),
h4("Overview"),
h3("Overview"),
plotly::plotlyOutput("overview_plot", height = "200px"),
h4("Focus on top genes"),
tabsetPanel(
id = "custom_genes_panel",
type = "hidden",
tabPanelBody("hide"),
tabPanelBody(
"show",
h3("Your genes"),
htmlOutput("custom_genes_synopsis"),
plotly::plotlyOutput("custom_genes_boxplot")
)
),
h3("Focus on top genes"),
div(paste0(
"Click or drag within the figure to select genes of ",
"interest."