Make preset methods configurable

R/app.R

@@ -7,6 +7,8 @@
 #' @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 methods A list of [`geposan::method`] objects to be used for all
+#'   presets. By default, all available methods will be used.
 #' @param comparison_gene_sets A named list of predefined gene sets to be used
 #'   as comparison genes.
 #' @param locked Whether the application should be locked and prohibit
@@ -19,6 +21,7 @@
 #' @export
 run_app <- function(reference_gene_sets,
                     species_sets = NULL,
+                    methods = geposan::all_methods(),
                     comparison_gene_sets = NULL,
                     locked = FALSE,
                     title = "Gene Position Analysis",
@@ -33,6 +36,7 @@ run_app <- function(reference_gene_sets,
   options <- list(
     reference_gene_sets = reference_gene_sets,
     species_sets = species_sets,
+    methods = methods,
     comparison_gene_sets = comparison_gene_sets,
     locked = locked,
     title = title

R/details.R

@@ -19,11 +19,12 @@ details_ui <- function(id) {
 
 #' Server for the detailed results panel.
 #'
+#' @param options Global options for the application.
 #' @param filtered_results A reactive containing the prefiltered results to be
 #'   displayed.
 #'
 #' @noRd
-details_server <- function(id, filtered_results) {
+details_server <- function(id, options, filtered_results) {
   moduleServer(id, function(input, output, session) {
     output$copy <- renderUI({
       results <- filtered_results()
@@ -51,7 +52,7 @@ details_server <- function(id, filtered_results) {
       )
     })
 
-    methods <- geposan::all_methods()
+    methods <- options$methods
     method_ids <- sapply(methods, function(method) method$id)
     method_names <- sapply(methods, function(method) method$name)
 

R/input_page.R

@@ -44,9 +44,10 @@ input_page_ui <- function(id, options) {
 #' @noRd
 input_page_server <- function(id, options) {
   moduleServer(id, function(input, output, session) {
-    current_preset <- reactiveVal(
-      geposan::preset(options$reference_gene_sets[[1]])
-    )
+    current_preset <- reactiveVal(geposan::preset(
+      options$reference_gene_sets[[1]],
+      methods = options$methods
+    ))
 
     potential_preset <- preset_editor_server("preset_editor", options)
 

R/methods.R

@@ -1,5 +1,5 @@
 # Construct UI for the methods editor.
-methods_ui <- function(id) {
+methods_ui <- function(id, options) {
   verticalLayout(
     h3("Methods"),
     selectInput(
@@ -21,7 +21,7 @@ methods_ui <- function(id) {
         "Customize weights" = "custom"
       )
     ),
-    lapply(geposan::all_methods(), function(method) {
+    lapply(options$methods, function(method) {
       verticalLayout(
         checkboxInput(
           NS(id, method$id),
@@ -44,15 +44,18 @@ methods_ui <- function(id) {
   )
 }
 
-# Construct server for the methods editor.
-#
-# @param analysis The reactive containing the results to be weighted.
-#
-# @return A reactive containing the weighted results.
-methods_server <- function(id, analysis, comparison_gene_ids) {
+#' Construct server for the methods editor.
+#'
+#' @param options Global options for the application.
+#' @param analysis The reactive containing the results to be weighted.
+#' @param comparison_gene_ids The comparison gene IDs.
+#'
+#' @return A reactive containing the weighted results.
+#' @noRd
+methods_server <- function(id, options, analysis, comparison_gene_ids) {
   moduleServer(id, function(input, output, session) {
     # Observe each method's enable button and synchronise the slider state.
-    lapply(geposan::all_methods(), function(method) {
+    lapply(options$methods, function(method) {
       observeEvent(input[[method$id]], {
         shinyjs::toggleState(
           sprintf("%s_weight", method$id),
@@ -89,7 +92,7 @@ methods_server <- function(id, analysis, comparison_gene_ids) {
 
         included_methods <- NULL
 
-        for (method in geposan::all_methods()) {
+        for (method in options$methods) {
           if (input[[method$id]]) {
             included_methods <- c(included_methods, method$id)
           }
@@ -105,7 +108,7 @@ methods_server <- function(id, analysis, comparison_gene_ids) {
     }) |> bindCache(
       analysis(),
       optimization_gene_ids(),
-      sapply(geposan::all_methods(), function(method) input[[method$id]]),
+      sapply(options$methods, function(method) input[[method$id]]),
       input$optimization_target
     )
 
@@ -114,7 +117,7 @@ methods_server <- function(id, analysis, comparison_gene_ids) {
 
       if (length(optimization_gene_ids()) < 1 |
         input$optimization_target == "custom") {
-        for (method in geposan::all_methods()) {
+        for (method in options$methods) {
           if (input[[method$id]]) {
             weight <- input[[sprintf("%s_weight", method$id)]]
             weights[[method$id]] <- weight

R/preset_editor.R

@@ -111,7 +111,8 @@ preset_editor_server <- function(id, options) {
       tryCatch(
         geposan::preset(
           reference_gene_ids,
-          species_ids = species_ids
+          species_ids = species_ids,
+          methods = options$methods
         ),
         error = function(err) NULL
       )

R/results.R

@@ -7,7 +7,7 @@
 #'
 #' @noRd
 results_ui <- function(id, options) {
-  ranking_choices <- purrr::lmap(geposan::all_methods(), function(method) {
+  ranking_choices <- purrr::lmap(options$methods, function(method) {
     l <- list()
     l[[method[[1]]$name]] <- method[[1]]$id
     l
@@ -19,7 +19,7 @@ results_ui <- function(id, options) {
     sidebarPanel(
       width = 3,
       comparison_editor_ui(NS(id, "comparison_editor"), options),
-      methods_ui(NS(id, "methods")),
+      methods_ui(NS(id, "methods"), options),
       filters_ui(NS(id, "filters"))
     ),
     mainPanel(
@@ -182,7 +182,7 @@ results_server <- function(id, options, analysis) {
     )
 
     # Rank the results.
-    ranking <- methods_server("methods", analysis, comparison_gene_ids)
+    ranking <- methods_server("methods", options, analysis, comparison_gene_ids)
 
     genes_with_distances <- merge(
       geposan::genes,
@@ -206,7 +206,7 @@ results_server <- function(id, options, analysis) {
     results_filtered <- filters_server("filters", results)
 
     # Server for the detailed results panel.
-    details_server("results", results_filtered)
+    details_server("results", options, results_filtered)
 
     output$rank_plot <- plotly::renderPlotly({
       preset <- preset()
@@ -281,7 +281,7 @@ results_server <- function(id, options, analysis) {
         )
       }
 
-      method_names <- geposan::all_methods() |> purrr::lmap(function(method) {
+      method_names <- options$methods |> purrr::lmap(function(method) {
         l <- list()
         l[[method[[1]]$id]] <- method[[1]]$name
         l

man/run_app.Rd

@@ -7,6 +7,7 @@
 run_app(
   reference_gene_sets,
   species_sets = NULL,
+  methods = geposan::all_methods(),
   comparison_gene_sets = NULL,
   locked = FALSE,
   title = "Gene Position Analysis",
@@ -23,6 +24,9 @@ selected as the initial reference gene set.}
 list containing vectors of species IDs for each set. The names will be used
 to present the species set throughout the user interface.}
 
+\item{methods}{A list of \code{\link[geposan:method]{geposan::method}} objects to be used for all
+presets. By default, all available methods will be used.}
+
 \item{comparison_gene_sets}{A named list of predefined gene sets to be used
 as comparison genes.}