diff --git a/methods.R b/methods.R new file mode 100644 index 0000000..6e64db1 --- /dev/null +++ b/methods.R @@ -0,0 +1,95 @@ +library(shiny) + +#' Construct UI for the methods editor. +methods_ui <- function(id) { + initial_weight <- 100 / length(methods) + + verticalLayout( + h3("Methods"), + actionButton( + NS(id, "optimize_button"), + "Find optimal weights", + icon = icon("check-double") + ), + div(style = "margin-top: 16px"), + lapply(methods, function(method) { + verticalLayout( + checkboxInput( + NS(id, method$id), + span( + method$description, + style = "font-weight: bold" + ), + value = TRUE + ), + sliderInput( + NS(id, sprintf("%s_weight", method$id)), + NULL, + post = "%", + min = 0, + max = 100, + step = 1, + value = initial_weight + ) + ) + }) + ) +} + +#' 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) { + moduleServer(id, function(input, output, session) { + observeEvent(input$optimize_button, { + method_ids <- NULL + + # Only include activated methods. + for (method in methods) { + if (input[[method$id]]) { + method_ids <- c(method_ids, method$id) + } + } + + weights <- geposan::optimize_weights( + analysis(), + method_ids, + genes_tpe_old + ) + + for (method_id in method_ids) { + updateSliderInput( + session, + sprintf("%s_weight", method_id), + value = weights[[method_id]] * 100 + ) + } + }) + + # Observe each method's enable button and synchronise the slider state. + lapply(methods, function(method) { + observeEvent(input[[method$id]], { + shinyjs::toggleState( + session$ns(sprintf("%s_weight", method$id)) + ) + }, ignoreInit = TRUE) + }) + + reactive({ + # Take the actual weights from the sliders. + + weights <- NULL + + for (method in methods) { + if (input[[method$id]]) { + weight <- input[[sprintf("%s_weight", method$id)]] + weights[[method$id]] <- weight + } + } + + geposan::ranking(analysis(), weights) + }) + }) +} diff --git a/server.R b/server.R index b6199b1..a102e15 100644 --- a/server.R +++ b/server.R @@ -6,6 +6,7 @@ library(plotly) library(rclipboard) library(shiny) +source("methods.R") source("rank_plot.R") source("scatter_plot.R") source("utils.R") @@ -36,41 +37,8 @@ server <- function(input, output, session) { ) }) - observeEvent(input$optimize_button, { - results <- isolate(results()) - method_ids <- NULL - - for (method in methods) { - if (isolate(input[[method$id]])) { - method_ids <- c(method_ids, method$id) - } - } - - weights <- geposan::optimize_weights( - results, - method_ids, - genes_tpe_old - ) - - for (method_id in method_ids) { - updateSliderInput( - session, - sprintf("%s_weight", method_id), - value = weights[[method_id]] * 100 - ) - } - }) - - # Observe each method's enable button. - lapply(methods, function(method) { - observeEvent(input[[method$id]], { - shinyjs::toggleState(sprintf("%s_weight", method$id)) - }, ignoreInit = TRUE) - }) - - #' Rank the results based on the specified weights. Filter out genes with - #' too few species but don't apply the cut-off score. - results <- reactive({ + #' Compute the results according to the preset. + analysis <- reactive({ # Select the preset. preset <- if (input$species == "all") { preset_all_species @@ -102,22 +70,12 @@ server <- function(input, output, session) { ) # Exclude genes with too few species. - results <- results[n_species >= input$n_species] - - # Rank the results based on the weights. - - weights <- NULL - - for (method in methods) { - if (input[[method$id]]) { - weight <- input[[sprintf("%s_weight", method$id)]] - weights[[method$id]] <- weight - } - } - - geposan::ranking(results, weights) + results[n_species >= input$n_species] }) + # Rank the results. + results <- methods_server("methods", analysis) + #' Apply the cut-off score to the ranked results. results_filtered <- reactive({ results()[score >= input$cutoff / 100] diff --git a/ui.R b/ui.R index 690937c..d734d86 100644 --- a/ui.R +++ b/ui.R @@ -3,6 +3,8 @@ library(plotly) library(rclipboard) library(shiny) +source("methods.R") + ui <- fluidPage( shinyjs::useShinyjs(), rclipboardSetup(), @@ -29,34 +31,7 @@ ui <- fluidPage( step = 1, value = 50 ), - h3("Methods"), - actionButton( - "optimize_button", - "Find optimal weights", - icon = icon("check-double") - ), - div(style = "margin-top: 16px"), - lapply(methods, function(method) { - verticalLayout( - checkboxInput( - method$id, - span( - method$description, - style = "font-weight: bold" - ), - value = TRUE - ), - sliderInput( - sprintf("%s_weight", method$id), - NULL, - post = "%", - min = 0, - max = 100, - step = 1, - value = 100 - ) - ) - }) + methods_ui("methods") ), mainPanel( tabsetPanel(