Adapt to changes in geposan

R/data.R

@@ -68,33 +68,7 @@ genes <- geposan::genes[, .(
 )]
 
 # All available methods from [geposan] and additional information on them.
-methods <- list(
+methods <- geposan::all_methods()
-    list(
-        id = "clusteriness",
-        name = "Clustering",
-        description = "Clustering of genes"
-    ),
-    list(
-        id = "correlation",
-        name = "Correlation",
-        description = "Correlation with known genes"
-    ),
-    list(
-        id = "neural",
-        name = "Neural",
-        description = "Assessment by neural network"
-    ),
-    list(
-        id = "adjacency",
-        name = "Adjacency",
-        description = "Adjacency to reference genes"
-    ),
-    list(
-        id = "proximity",
-        name = "Proximity",
-        description = "Proximity to telomeres"
-    )
-)
 
 # IDs of methods for geposan.
 method_ids <- sapply(methods, function(method) method$id)

R/methods.R

@@ -2,7 +2,17 @@
 methods_ui <- function(id) {
     verticalLayout(
         h3("Methods"),
-        div(style = "margin-top: 16px"),
+        selectInput(
+            NS(id, "optimization_target"),
+            "Optimization target",
+            choices = list(
+                "Mean rank of reference genes" = "mean",
+                "Median rank of reference genes" = "median",
+                "First rank of reference genes" = "min",
+                "Last rank of reference genes" = "max",
+                "Customize weights" = "custom"
+            )
+        ),
         lapply(methods, function(method) {
             verticalLayout(
                 checkboxInput(
@@ -22,12 +32,7 @@ methods_ui <- function(id) {
                     value = 1.0
                 )
             )
-        }),
+        })
-        actionButton(
-            NS(id, "reset_button"),
-            "Reset weights",
-            class = "btn-primary"
-        )
     )
 }
 
@@ -40,48 +45,56 @@ methods_server <- function(id, analysis) {
     moduleServer(id, function(input, output, session) {
         # Observe each method's enable button and synchronise the slider state.
         lapply(methods, function(method) {
-            observeEvent(input[[method$id]],
+            observeEvent(c(input[[method$id]], input$optimization_target), {
-                { # nolint
+                shinyjs::toggleState(
-                    shinyjs::toggleState(sprintf("%s_weight", method$id))
+                    sprintf("%s_weight", method$id),
-                },
+                    condition = input$optimization_target == "custom" &
-                ignoreInit = TRUE
+                        input[[method$id]]
-            )
+                )
+            })
         })
 
-        observeEvent(
-            { # nolint
-                analysis()
-                input$reset_button
-            },
-            { # nolint
-                for (method in methods) {
-                    updateCheckboxInput(
-                        session,
-                        method$id,
-                        value = TRUE
-                    )
-
-                    updateSliderInput(
-                        session,
-                        sprintf("%s_weight", method$id),
-                        value = analysis()$weights[[method$id]]
-                    )
-                }
-            },
-            ignoreNULL = FALSE
-        )
-
         reactive({
+            analysis <- analysis()
             weights <- NULL
 
-            for (method in methods) {
+            if (input$optimization_target == "custom") {
-                if (input[[method$id]]) {
+                for (method in methods) {
-                    weight <- input[[sprintf("%s_weight", method$id)]]
+                    if (input[[method$id]]) {
-                    weights[[method$id]] <- weight
+                        weight <- input[[sprintf("%s_weight", method$id)]]
+                        weights[[method$id]] <- weight
+                    }
                 }
+            } else {
+                withProgress(message = "Optimizing weights", {
+                    setProgress(0.2)
+
+                    included_methods <- NULL
+
+                    for (method in methods) {
+                        if (input[[method$id]]) {
+                            included_methods <- c(included_methods, method$id)
+                        }
+                    }
+
+                    weights <- geposan::optimal_weights(
+                        analysis,
+                        included_methods,
+                        analysis$preset$reference_gene_ids,
+                        target = input$optimization_target
+                    )
+
+                    for (method_id in names(weights)) {
+                        updateSliderInput(
+                            session,
+                            sprintf("%s_weight", method_id),
+                            value = weights[[method_id]]
+                        )
+                    }
+                })
             }
 
-            geposan::ranking(analysis(), weights)
+            geposan::ranking(analysis, weights)
         })
     })
 }

R/preset_editor.R

@@ -48,16 +48,6 @@ preset_editor_ui <- function(id) {
                 height = "250px"
             )
         ),
-        selectInput(
-            NS(id, "optimization_target"),
-            "Optimization target",
-            choices = list(
-                "Mean rank of reference genes" = "mean",
-                "Median rank of reference genes" = "median",
-                "First rank of reference genes" = "min",
-                "Last rank of reference genes" = "max"
-            )
-        ),
         tabsetPanel(
             id = NS(id, "apply_panel"),
             type = "hidden",
@@ -93,11 +83,10 @@ preset_editor_server <- function(id) {
         )
 
         current_preset <- reactiveVal(geposan::preset(
-            methods = method_ids,
+            methods = methods,
             species_ids = species$id,
             gene_ids = genes$id,
-            reference_gene_ids = genes[suggested | verified == TRUE, id],
+            reference_gene_ids = genes[suggested | verified == TRUE, id]
-            optimization_target = "mean"
         ))
 
         new_preset <- reactive({
@@ -123,11 +112,10 @@ preset_editor_server <- function(id) {
             }
 
             geposan::preset(
-                methods = method_ids,
+                methods = methods,
                 species_ids = species_ids,
                 gene_ids = genes$id,
-                reference_gene_ids = reference_gene_ids,
+                reference_gene_ids = reference_gene_ids
-                optimization_target = input$optimization_target
             )
         })
 

R/server.R

@@ -139,14 +139,14 @@ server <- function(input, output, session) {
         }
 
         all <- ranking()
-        clusteriness <- geposan::ranking(all, list(clusteriness = 1))
+        clustering <- geposan::ranking(all, list(clustering = 1))
         correlation <- geposan::ranking(all, list(correlation = 1))
         neural <- geposan::ranking(all, list(neural = 1))
         adjacency <- geposan::ranking(all, list(adjacency = 1))
         proximity <- geposan::ranking(all, list(proximity = 1))
 
         rankings <- list(
-            "Clusteriness" = clusteriness,
+            "Clustering" = clustering,
             "Correlation" = correlation,
             "Neural" = neural,
             "Adjacency" = adjacency,