Add gene selector for custom genes

DESCRIPTION

@@ -25,4 +25,5 @@ Imports:
     DT,
     plotly,
     glue,
-    shiny
+    shiny,
+    shinyvs

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)

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
+      }
+    })
+  })
+}

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(
+          "<b>{hgnc_name}</b><br>",
+          "Score: {round(score, digits = 2)}<br>",
+          "Rank: {rank}<br>",
+          "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(
-        "<b>%{text}</b><br>",
-        "Rank: %{x}<br>",
-        "Score: %{y:.2}<br>",
-        "Percentile: %{customdata:.2%}",
-        "<extra></extra>"
-      )
+      name = ~group,
+      text = ~ glue::glue(
+        "<b>{hgnc_name}</b><br>",
+        "Score: {round(score, digits = 2)}<br>",
+        "Rank: {rank}<br>",
+        "Percentile: {round(percentile * 100, digits = 2)}%"
+      ),
+      hoverinfo = "text",
+      showlegend = FALSE
     ) |>
     plotly::layout(
       xaxis = list(title = ranks_label),

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

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

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(

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