diff --git a/R/app.R b/R/app.R index 3612932..c46d037 100644 --- a/R/app.R +++ b/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 diff --git a/R/details.R b/R/details.R index 1872c15..c58b9d6 100644 --- a/R/details.R +++ b/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) diff --git a/R/input_page.R b/R/input_page.R index 7d3cbbc..d20796d 100644 --- a/R/input_page.R +++ b/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) diff --git a/R/methods.R b/R/methods.R index 0775f8d..e56d8cd 100644 --- a/R/methods.R +++ b/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 diff --git a/R/preset_editor.R b/R/preset_editor.R index 216c182..466cf38 100644 --- a/R/preset_editor.R +++ b/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 ) diff --git a/R/results.R b/R/results.R index fb0e190..899d5f9 100644 --- a/R/results.R +++ b/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 diff --git a/man/run_app.Rd b/man/run_app.Rd index 02b9add..dfc7a69 100644 --- a/man/run_app.Rd +++ b/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.}