Add rankings comparison plot

This commit is contained in:
Elias Projahn 2024-04-26 20:52:45 +02:00
parent 1503924f80
commit 8439066921
3 changed files with 137 additions and 0 deletions

View file

@ -4,6 +4,7 @@ export(analyze)
export(box_plot) export(box_plot)
export(overview_plot) export(overview_plot)
export(rank_genes) export(rank_genes)
export(rankings_comparison_plot)
export(run_api) export(run_api)
export(run_app) export(run_app)
export(scores_plot) export(scores_plot)

102
R/plots.R
View file

@ -178,6 +178,90 @@ scores_plot <- function(ranked_data, highlighted_genes = NULL, ranks = 1000) {
) )
} }
#' Create a scatter plot for comparing two different rankings.
#'
#' @param ranking_x The ranking to be shown on the X-axis.
#' @param ranking_y The ranking to be shown on the Y-axis.
#' @param label_x Axis title for the X-axis.
#' @param label_y Axis title for the Y-axis.
#' @param highlighted_genes Gene IDs for genes that should be highlighted
#' @param use_percentiles Display percentiles instead of scores.
#'
#' @return A `plotly` figure for rendering.
#'
#' @export
rankings_comparison_plot <- function(ranking_x,
ranking_y,
label_x = "Ranking X",
label_y = "Ranking Y",
highlighted_genes = NULL,
use_percentiles = FALSE) {
data <- merge(
ranking_x[, .(gene, score, percentile)],
ranking_y[, .(gene, score, percentile)],
by = "gene",
suffixes = c(x = "_x", y = "_y")
)
data <- merge(
data,
ubigen::genes,
by = "gene"
)
data[, group := data.table::fifelse(
gene %chin% highlighted_genes,
"Your genes",
"All genes"
)]
data[, color := data.table::fifelse(
gene %chin% highlighted_genes,
highlight_color(),
base_color()
)]
data[, size := data.table::fifelse(
gene %chin% highlighted_genes,
8,
4
)]
# Draw "Your genes" on top of "All genes".
setorder(data, group)
plotly::plot_ly() |>
plotly::add_markers(
data = data,
x = if (use_percentiles) ~percentile_x else ~score_x,
y = if (use_percentiles) ~percentile_y else ~score_y,
name = ~group,
marker = ~ list(
color = color,
size = size,
opacity = 1,
line = list(width = 0)
),
text = ~hgnc_name,
hoverinfo = "text",
customdata = ~gene,
showlegend = FALSE
) |>
plotly::layout(
xaxis = list(
title = label_x,
tickformat = if (use_percentiles) ".1%" else NULL
),
yaxis = list(title = label_y),
shapes = list(
vline(0.5),
hline(0.5)
),
clickmode = "event+select",
dragmode = "lasso"
)
}
#' Helper function for creating a vertical line for plotly. #' Helper function for creating a vertical line for plotly.
#' @noRd #' @noRd
vline <- function(x) { vline <- function(x) {
@ -196,6 +280,24 @@ vline <- function(x) {
) )
} }
#' Helper function for creating a horizontal line for plotly.
#' @noRd
hline <- function(y) {
list(
type = "line",
y0 = y,
y1 = y,
x0 = 0,
x1 = 1,
xref = "paper",
line = list(
color = "#00000080",
opacity = 0.5,
dash = "dot"
)
)
}
#' Helper function for creating annotations for lines created using [vline()]. #' Helper function for creating annotations for lines created using [vline()].
#' @noRd #' @noRd
vlineannotation <- function(x) { vlineannotation <- function(x) {

View file

@ -0,0 +1,34 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/plots.R
\name{rankings_comparison_plot}
\alias{rankings_comparison_plot}
\title{Create a scatter plot for comparing two different rankings.}
\usage{
rankings_comparison_plot(
ranking_x,
ranking_y,
label_x = "Ranking X",
label_y = "Ranking Y",
highlighted_genes = NULL,
use_percentiles = FALSE
)
}
\arguments{
\item{ranking_x}{The ranking to be shown on the X-axis.}
\item{ranking_y}{The ranking to be shown on the Y-axis.}
\item{label_x}{Axis title for the X-axis.}
\item{label_y}{Axis title for the Y-axis.}
\item{highlighted_genes}{Gene IDs for genes that should be highlighted}
\item{use_percentiles}{Display percentiles instead of scores.}
}
\value{
A \code{plotly} figure for rendering.
}
\description{
Create a scatter plot for comparing two different rankings.
}