Add options to configure default gene sets

R/app.R

@@ -1,15 +1,40 @@
 #' Run the application server.
 #'
+#' @param gene_sets A list of predefined gene sets. This should be a named list
+#'   containing vectors of gene IDs for each set. The names will be used to
+#'   present the gene set throughout the user interface. You have to provide *at
+#'   least one gene set* which will be selected as the initial reference gene
+#'   set.
+#' @param species_sets A list of predefined species sets. This should be a named
+#'   list containing vectors of species IDs for each set. The names will be used
+#'   to present the species set throughout the user interface.
+#' @param locked Whether the application should be locked and prohibit
+#'   performing custom analyses. If this is set to `TRUE`, only the predefined
+#'   gene and species sets are available for customizing the analysis. This may
+#'   be useful to limit resource usage on a publicly available instance.
 #' @param port The port to serve the application on.
 #'
 #' @export
-run_app <- function(port = 3464) {
+run_app <- function(gene_sets,
-    # These function calls make the required java scripts available.
+                    species_sets = NULL,
+                    locked = FALSE,
+                    port = 3464) {
+    stopifnot(!is.null(gene_sets) & !is.null(gene_sets[[1]]))
 
+    # These function calls make the required java scripts available.
     shinyjs::useShinyjs()
     rclipboard::rclipboardSetup()
 
-    # Actually run the app.
+    # Bundle of global options to redue broilerplate.
+    options <- list(
+        gene_sets = gene_sets,
+        species_sets = species_sets,
+        locked = locked
+    )
 
-    shiny::runApp(shiny::shinyApp(ui, server), port = port)
+    # Actually run the app.
+    shiny::runApp(
+        shiny::shinyApp(ui(options), server(options)),
+        port = port
+    )
 }

R/comparison_editor.R

@@ -1,22 +1,23 @@
-# Create a comparison editor.
+#' Create a comparison editor.
-comparison_editor_ui <- function(id) {
+#'
+#' @param options Global application options
+#' @noRd
+comparison_editor_ui <- function(id, options) {
     verticalLayout(
         h3("Comparison"),
         selectInput(
             NS(id, "comparison_genes"),
             "Comparison genes",
-            choices = list(
+            choices = c(
-                "None" = "none",
+                "None",
-                "Random genes" = "random",
+                "Random genes",
-                "Verified or suggested TPE-OLD genes" = "tpeold",
+                names(options$gene_sets),
-                "Only verified TPE-OLD genes" = "verified",
+                "Customize"
-                "Only suggested TPE-OLD genes" = "suggested",
-                "Customize" = "custom"
             )
         ),
         conditionalPanel(
             condition = sprintf(
-                "input['%s'] == 'custom'",
+                "input['%s'] == 'Customize'",
                 NS(id, "comparison_genes")
             ),
             gene_selector_ui(NS(id, "custom_genes"))
@@ -24,33 +25,32 @@ comparison_editor_ui <- function(id) {
     )
 }
 
-# Create a server for the comparison editor.
+#' Create a server for the comparison editor.
-#
+#'
-# @param id ID for namespacing the inputs and outputs.
+#' @param id ID for namespacing the inputs and outputs.
-# @param preset A reactive containing the current preset.
+#' @param preset A reactive containing the current preset.
-#
+#' @param options Global application options
-# @return A reactive containing the comparison gene IDs.
+#'
-comparison_editor_server <- function(id, preset) {
+#' @return A reactive containing the comparison gene IDs.
+#'
+#' @noRd
+comparison_editor_server <- function(id, preset, options) {
     moduleServer(id, function(input, output, session) {
         custom_gene_ids <- gene_selector_server("custom_genes")
 
         reactive({
-            if (input$comparison_genes == "none") {
+            if (input$comparison_genes == "None") {
                 NULL
-            } else if (input$comparison_genes == "random") {
+            } else if (input$comparison_genes == "Random genes") {
                 preset <- preset()
                 gene_pool <- preset$gene_ids
                 reference_gene_ids <- preset$reference_gene_ids
                 gene_pool <- gene_pool[!gene_pool %chin% reference_gene_ids]
                 gene_pool[sample(length(gene_pool), length(reference_gene_ids))]
-            } else if (input$comparison_genes == "tpeold") {
+            } else if (input$comparison_genes == "Customize") {
-                genes[verified | suggested == TRUE, id]
-            } else if (input$comparison_genes == "verified") {
-                genes[verified == TRUE, id]
-            } else if (input$comparison_genes == "suggested") {
-                genes[suggested == TRUE, id]
-            } else {
                 custom_gene_ids()
+            } else {
+                options$gene_sets[[input$comparison_genes]]
             }
         })
     })

R/data.R

@@ -1,65 +1,3 @@
-# Species IDs of known replicatively aging species.
-species_ids_replicative <- c(
-    "bihybrid",
-    "btaurus",
-    "bthybrid",
-    "cfamiliaris",
-    "chircus",
-    "cjacchus",
-    "clfamiliaris",
-    "csabaeus",
-    "ecaballus",
-    "fcatus",
-    "ggorilla",
-    "hsapiens",
-    "lafricana",
-    "mfascicularis",
-    "mmulatta",
-    "mmurinus",
-    "mnemestrina",
-    "nleucogenys",
-    "oaries",
-    "pabelii",
-    "panubis",
-    "ppaniscus",
-    "ptroglodytes",
-    "sscrofa",
-    "tgelada"
-)
-
-# Gene names of genes for verified TPE-OLD genes.
-genes_verified_tpe_old <- c(
-    "C1S",
-    "DSP",
-    "ISG15",
-    "SORBS2",
-    "TERT"
-)
-
-# Gene names of genes with a suggested TPE-OLD.
-genes_suggested_tpe_old <- c(
-    "AKAP3",
-    "ANO2",
-    "CCND2",
-    "CD163L1",
-    "CD9",
-    "FOXM1",
-    "GALNT8",
-    "NDUFA9",
-    "TEAD4",
-    "TIGAR",
-    "TSPAN9"
-)
-
-# Genes from [geposan] and their TPE-OLD status.
-genes <- geposan::genes[, .(
-    id,
-    name,
-    chromosome,
-    suggested = name %chin% genes_suggested_tpe_old,
-    verified = name %chin% genes_verified_tpe_old
-)]
-
 # All available methods from [geposan] and additional information on them.
 methods <- geposan::all_methods()
 

R/gene_selector.R

@@ -7,7 +7,7 @@
 #'
 #' @noRd
 gene_selector_ui <- function(id, default_gene_ids = NULL) {
-    named_genes <- genes[name != ""]
+    named_genes <- geposan::genes[name != ""]
     named_genes <- unique(named_genes, by = "name")
     gene_choices <- named_genes$id
     names(gene_choices) <- named_genes$name
@@ -42,7 +42,10 @@ gene_selector_ui <- function(id, default_gene_ids = NULL) {
                     NS(id, "hgnc_names_raw"),
                     "Enter HGNC symbols",
                     value = paste(
-                        genes[id %chin% default_gene_ids & name != "", name],
+                        geposan::genes[
+                            id %chin% default_gene_ids & name != "",
+                            name
+                        ],
                         collapse = "\n"
                     ),
                     height = "250px"

R/input_page.R

@@ -1,10 +1,13 @@
 #' Create the UI for the input page.
+#'
+#' @param options Global options for the application.
+#'
 #' @noRd
-input_page_ui <- function(id) {
+input_page_ui <- function(id, options) {
     sidebarLayout(
         sidebarPanel(
             width = 3,
-            preset_editor_ui(NS(id, "preset_editor")),
+            preset_editor_ui(NS(id, "preset_editor"), options),
             tabsetPanel(
                 id = NS(id, "apply_panel"),
                 type = "hidden",
@@ -19,7 +22,7 @@ input_page_ui <- function(id) {
                     )
                 )
             ),
-            comparison_editor_ui(NS(id, "comparison_editor"))
+            comparison_editor_ui(NS(id, "comparison_editor"), options)
         ),
         mainPanel(
             width = 9,
@@ -35,21 +38,21 @@ input_page_ui <- function(id) {
 #' Application logic for the input page.
 #'
 #' @param id ID for namespacing the inputs and outputs.
+#' @param options Global options for the application.
+#'
 #' @return A list containing two reactives: the `preset` for the analysis and
 #'   the `comparison_gene_ids`.
 #'
 #' @noRd
-input_page_server <- function(id) {
+input_page_server <- function(id, options) {
     moduleServer(id, function(input, output, session) {
-        current_preset <- reactiveVal(
+        current_preset <- reactiveVal(geposan::preset(options$gene_sets[[1]]))
-            geposan::preset(genes[verified | suggested == TRUE, id])
+        potential_preset <- preset_editor_server("preset_editor", options)
-        )
-
-        potential_preset <- preset_editor_server("preset_editor")
 
         comparison_gene_ids <- comparison_editor_server(
             "comparison_editor",
-            current_preset
+            current_preset,
+            options
         )
 
         output$positions_plot <- plotly::renderPlotly({

R/preset_editor.R

@@ -1,61 +1,82 @@
 #' Create the UI for a preset editor.
 #'
 #' @param id ID for namespacing.
+#' @param options Global options for the application.
+#'
 #' @return The UI elements.
 #'
 #' @noRd
-preset_editor_ui <- function(id) {
+preset_editor_ui <- function(id, options) {
+    species_choices <- c("All species", names(options$species_sets))
+    gene_choices <- names(options$gene_sets)
+
+    if (!options$locked) {
+        species_choices <- c(species_choices, "Customize")
+        gene_choices <- c(gene_choices, "Customize")
+    }
+
     verticalLayout(
         h3("Inputs"),
         selectInput(
             NS(id, "species"),
             "Species to include",
-            choices = list(
+            choices = species_choices
-                "All species" = "all",
-                "Known replicatively aging species" = "replicative",
-                "Customize" = "custom"
-            )
         ),
+        if (!options$locked) {
             conditionalPanel(
-            condition = sprintf("input['%s'] == 'custom'", NS(id, "species")),
+                condition = sprintf(
+                    "input['%s'] == 'Customize'",
+                    NS(id, "species")
+                ),
                 selectizeInput(
                     inputId = NS(id, "custom_species"),
                     label = "Select input species",
                     choices = NULL,
                     multiple = TRUE
                 ),
-        ),
+            )
+        },
         selectInput(
             NS(id, "reference_genes"),
             "Reference genes",
-            choices = list(
+            choices = gene_choices
-                "Verified or suggested TPE-OLD genes" = "tpeold",
-                "Only verified TPE-OLD genes" = "verified",
-                "Customize" = "custom"
-            )
         ),
+        if (!options$locked) {
             conditionalPanel(
                 condition = sprintf(
-                "input['%s'] == 'custom'",
+                    "input['%s'] == 'Customize'",
                     NS(id, "reference_genes")
                 ),
-            gene_selector_ui(
+                gene_selector_ui(NS(id, "custom_genes"))
-                NS(id, "custom_genes"),
-                genes[suggested | verified == TRUE, id]
             )
+        },
+        if (options$locked) {
+            HTML(
+                "This instance prohibits performing custom analyses ",
+                "to reduce resource usage. Normally, it is possible ",
+                "to use this web application for analyzing any set of ",
+                "reference genes to find patterns in their ",
+                "chromosomal positions. If you would like to apply ",
+                "this method for your own research, see ",
+                "<a href=\"https://code.johrpan.de/johrpan/tpeold\"",
+                "target=\"_blank\">this page</a> for more information."
             )
+        }
     )
 }
 
 #' Application logic for the preset editor.
 #'
 #' @param id ID for namespacing the inputs and outputs.
+#' @param options Global application options.
+#'
 #' @return A reactive containing the preset or `NULL`, if the input data doesn't
 #'   result in a valid one.
 #'
 #' @noRd
-preset_editor_server <- function(id) {
+preset_editor_server <- function(id, options) {
     moduleServer(id, function(input, output, session) {
+        custom_gene_ids <- if (!options$locked) {
             species_choices <- geposan::species$id
             names(species_choices) <- geposan::species$name
 
@@ -66,23 +87,24 @@ preset_editor_server <- function(id) {
                 server = TRUE
             )
 
-        custom_gene_ids <- gene_selector_server("custom_genes")
+            gene_selector_server("custom_genes")
-
-        reactive({
-            reference_gene_ids <- if (input$reference_genes == "tpeold") {
-                genes[verified | suggested == TRUE, id]
-            } else if (input$reference_genes == "verified") {
-                genes[verified == TRUE, id]
         } else {
-                custom_gene_ids()
+            NULL
         }
 
-            species_ids <- if (input$species == "replicative") {
+        reactive({
-                species_ids_replicative
+            reference_gene_ids <- if (input$reference_genes == "Customize") {
-            } else if (input$species == "all") {
+                custom_gene_ids()
-                geposan::species$id
             } else {
+                options$gene_sets[[input$reference_genes]]
+            }
+
+            species_ids <- if (input$species == "All species") {
+                geposan::species$id
+            } else if (input$species == "Customize") {
                 input$custom_species
+            } else {
+                options$species_sets[[input$species]]
             }
 
             tryCatch(

R/server.R

@@ -7,8 +7,13 @@ js_link <- DT::JS("function(row, data) {
     $('td:eq(1)', row).html(`<a href=\"${url}\" target=\"_blank\">${name}</a>`);
 }")
 
-server <- function(input, output, session) {
+#' Create a server function for the application.
-    input_reactives <- input_page_server("input_page")
+#'
+#' @param options Global application options.
+#' @noRd
+server <- function(options) {
+    function(input, output, session) {
+        input_reactives <- input_page_server("input_page", options)
         preset <- input_reactives$preset
         comparison_gene_ids <- input_reactives$comparison_gene_ids
 
@@ -164,7 +169,13 @@ server <- function(input, output, session) {
             data[, total_ratio := term_size / effective_domain_size]
             data[, query_ratio := intersection_size / query_size]
 
-        data <- data[, .(source, term_name, total_ratio, query_ratio, p_value)]
+            data <- data[, .(
+                source,
+                term_name,
+                total_ratio,
+                query_ratio,
+                p_value
+            )]
 
             dt <- DT::datatable(
                 data,
@@ -228,4 +239,5 @@ server <- function(input, output, session) {
                 }
             )
         })
+    }
 }

R/ui.R

@@ -1,6 +1,9 @@
 #' Generate the main UI for the application.
+#'
+#' @param options Global options for the application.
+#'
 #' @noRd
-ui <- function() {
+ui <- function(options) {
     div(
         shinyjs::useShinyjs(),
         rclipboard::rclipboardSetup(),
@@ -15,7 +18,7 @@ ui <- function() {
             selected = "Results",
             tabPanel(
                 "Input data",
-                input_page_ui("input_page")
+                input_page_ui("input_page", options)
             ),
             tabPanel(
                 "Results",

man/run_app.Rd

@@ -4,9 +4,24 @@
 \alias{run_app}
 \title{Run the application server.}
 \usage{
-run_app(port = 3464)
+run_app(gene_sets, species_sets = NULL, locked = FALSE, port = 3464)
 }
 \arguments{
+\item{gene_sets}{A list of predefined gene sets. This should be a named list
+containing vectors of gene IDs for each set. The names will be used to
+present the gene set throughout the user interface. You have to provide \emph{at
+least one gene set} which will be selected as the initial reference gene
+set.}
+
+\item{species_sets}{A list of predefined species sets. This should be a named
+list containing vectors of species IDs for each set. The names will be used
+to present the species set throughout the user interface.}
+
+\item{locked}{Whether the application should be locked and prohibit
+performing custom analyses. If this is set to \code{TRUE}, only the predefined
+gene and species sets are available for customizing the analysis. This may
+be useful to limit resource usage on a publicly available instance.}
+
 \item{port}{The port to serve the application on.}
 }
 \description{