Move methods to separate module

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

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, {
+    #' Compute the results according to the preset.
-        results <- isolate(results())
+    analysis <- reactive({
-        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({
         # 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]
+        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)
     })
 
+    # 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]

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"),
+            methods_ui("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
-                    )
-                )
-            })
         ),
         mainPanel(
             tabsetPanel(