diff --git a/DESCRIPTION b/DESCRIPTION index 15ec548..12c3576 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,4 +25,5 @@ Imports: DT, plotly, glue, - shiny + shiny, + shinyvs diff --git a/NAMESPACE b/NAMESPACE index 04c72bb..20fc17a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,13 +1,5 @@ # Generated by roxygen2: do not edit by hand export(run_app) +import(data.table) import(shiny) -importFrom(data.table,":=") -importFrom(data.table,.BY) -importFrom(data.table,.EACHI) -importFrom(data.table,.GRP) -importFrom(data.table,.I) -importFrom(data.table,.N) -importFrom(data.table,.NGRP) -importFrom(data.table,.SD) -importFrom(data.table,data.table) diff --git a/R/gene_selector.R b/R/gene_selector.R new file mode 100644 index 0000000..9bf34b0 --- /dev/null +++ b/R/gene_selector.R @@ -0,0 +1,99 @@ +#' Create the UI for a gene selector. +#' +#' @param id ID for namespacing. +#' +#' @return The user interface +#' @noRd +gene_selector_ui <- function(id) { + named_genes <- ubigen::genes[hgnc_name != ""] + named_genes <- unique(named_genes, by = "hgnc_name") + gene_choices <- named_genes$gene + names(gene_choices) <- named_genes$hgnc_name + + verticalLayout( + selectInput( + NS(id, "identifier_type"), + verticalLayout( + strong("Gene identifiers"), + paste0( + "Select whether you want to pick or enter custom genes to assess ", + "how ubiquitous they are." + ) + ), + choices = list( + "Select from list" = "list", + "Enter HGNC symbols" = "hgnc", + "Enter Ensembl gene IDs" = "ensembl" + ) + ), + tabsetPanel( + id = NS(id, "custom_input"), + type = "hidden", + tabPanelBody( + "list", + shinyvs::virtualSelectInput( + NS(id, "selected_genes"), + label = NULL, + choices = gene_choices, + multiple = TRUE, + search = TRUE, + selectAllOnlyVisible = TRUE + ), + ), + tabPanelBody( + "hgnc", + textAreaInput( + NS(id, "hgnc_names_raw"), + label = NULL, + height = "250px" + ) + ), + tabPanelBody( + "ensembl", + textAreaInput( + NS(id, "gene_ids_raw"), + label = NULL, + height = "250px" + ) + ) + ) + ) +} + +#' Application logic for the gene selector. +#' +#' @param id ID for namespacing. +#' +#' @return A reactive containing the selected gene IDs. +#' @noRd +gene_selector_server <- function(id) { + moduleServer(id, function(input, output, session) { + observe({ + updateTabsetPanel( + session, + "custom_input", + selected = input$identifier_type + ) + }) + + reactive({ + gene_ids <- if (input$identifier_type == "list") { + input$selected_genes + } else if (input$identifier_type == "hgnc") { + inputs <- unique(strsplit(input$hgnc_names_raw, "\\s+")[[1]]) + inputs <- inputs[inputs != ""] + ubigen::genes[hgnc_name %chin% inputs, gene] + } else { + inputs <- unique(strsplit(input$gene_ids_raw, "\\s+")[[1]]) + inputs <- inputs[inputs != ""] + ubigen::genes[gene %chin% inputs, gene] + } + + if (length(gene_ids > 100)) { + gene_ids[seq_len(100)] + } else { + gene_ids + } + }) + }) +} diff --git a/R/plots.R b/R/plots.R index fb21ee9..897ccd9 100644 --- a/R/plots.R +++ b/R/plots.R @@ -1,35 +1,59 @@ #' Create a plot showing an overview over the provided ranking. #' #' @param ranked_data The ranking to visualize. +#' @param highlighted_genes Genes that will be marked. #' @param sample_proportion Proportion of rows to use as the shown sample. #' #' @return A `plotly` figure. #' @noRd -overview_plot <- function(ranked_data, sample_proportion = 0.05) { - plotly::plot_ly() |> +overview_plot <- function(ranked_data, + highlighted_genes = NULL, + sample_proportion = 0.05) { + figure <- plotly::plot_ly() |> plotly::add_lines( data = ranked_data[sample( nrow(ranked_data), sample_proportion * nrow(ranked_data) )], x = ~rank, - y = ~score + y = ~score, + hoverinfo = "skip" ) |> plotly::layout( xaxis = list(title = "Ranks"), yaxis = list(title = "Score") ) + + if (!is.null(highlighted_genes)) { + figure <- figure |> + plotly::add_markers( + data = ranked_data[gene %chin% highlighted_genes], + x = ~rank, + y = ~score, + text = ~ glue::glue( + "{hgnc_name}
", + "Score: {round(score, digits = 2)}
", + "Rank: {rank}
", + "Percentile: {round(percentile * 100, digits = 2)}%" + ), + hoverinfo = "text", + showlegend = FALSE + ) + } + + figure } #' Create plot showing the distribution of scores using `plotly`. #' #' @param ranked_data Data on genes with precomputed ranks. +#' @param highlighted_genes Genes that will be marked. #' @param ranks How may ranks the x-axis should include. If this parameter is #' `NULL`, all ranks will be shown. #' #' @return A `plotly` figure for rendering. #' @noRd -scores_plot <- function(ranked_data, ranks = 1000) { +scores_plot <- function(ranked_data, highlighted_genes = NULL, ranks = 1000) { data <- if (is.null(ranks)) { ranked_data } else { @@ -42,20 +66,26 @@ scores_plot <- function(ranked_data, ranks = 1000) { glue::glue("Ranks (1 to {ranks})") } + data[, group := data.table::fifelse( + gene %chin% highlighted_genes, + "Your genes", + "All genes" + )] + plotly::plot_ly() |> plotly::add_markers( data = data, x = ~rank, y = ~score, - text = ~hgnc_name, - customdata = ~percentile, - hovertemplate = paste0( - "%{text}
", - "Rank: %{x}
", - "Score: %{y:.2}
", - "Percentile: %{customdata:.2%}", - "" - ) + name = ~group, + text = ~ glue::glue( + "{hgnc_name}
", + "Score: {round(score, digits = 2)}
", + "Rank: {rank}
", + "Percentile: {round(percentile * 100, digits = 2)}%" + ), + hoverinfo = "text", + showlegend = FALSE ) |> plotly::layout( xaxis = list(title = ranks_label), diff --git a/R/server.R b/R/server.R index db4b527..2ca7e05 100644 --- a/R/server.R +++ b/R/server.R @@ -17,8 +17,17 @@ server <- function(input, output) { data }) - output$overview_plot <- plotly::renderPlotly(overview_plot(ranked_data())) - output$scores_plot <- plotly::renderPlotly(scores_plot(ranked_data())) + custom_genes <- gene_selector_server("custom_genes") + + output$overview_plot <- plotly::renderPlotly(overview_plot( + ranked_data(), + highlighted_genes = custom_genes() + )) + + output$scores_plot <- plotly::renderPlotly(scores_plot( + ranked_data(), + highlighted_genes = custom_genes() + )) output$selected_genes <- DT::renderDataTable({ selected_points <- plotly::event_data("plotly_selected") diff --git a/R/style.R b/R/style.R new file mode 100644 index 0000000..2bf4c58 --- /dev/null +++ b/R/style.R @@ -0,0 +1,7 @@ +#' Custom CSS to tweak the rendering. +#' @noRd +custom_css <- function() { + tags$head( + tags$style(".nav-hidden { height: 0 }") + ) +} diff --git a/R/ui.R b/R/ui.R index e62217b..889ab44 100644 --- a/R/ui.R +++ b/R/ui.R @@ -8,12 +8,15 @@ ui <- function() { primary = "#7d19bf" ), title = "Ubigen", + header = custom_css(), tabPanel( "Explore", sidebarLayout( sidebarPanel( width = 3, - h3("Features"), + h3("My genes"), + gene_selector_ui("custom_genes"), + h3("Scoring"), selectInput( "cross_sample_metric", verticalLayout( diff --git a/R/utils.R b/R/utils.R index c58fbf3..b9afa66 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,13 +1,4 @@ # Various things that should be imported into the package namespace. -#' @importFrom data.table := -#' @importFrom data.table .BY -#' @importFrom data.table .EACHI -#' @importFrom data.table .GRP -#' @importFrom data.table .I -#' @importFrom data.table .N -#' @importFrom data.table .NGRP -#' @importFrom data.table .SD -#' @importFrom data.table data.table -#' +#' @import data.table #' @import shiny NULL