diff --git a/R/data.R b/R/data.R index 5716a8a..b1c3d91 100644 --- a/R/data.R +++ b/R/data.R @@ -68,33 +68,7 @@ genes <- geposan::genes[, .( )] # All available methods from [geposan] and additional information on them. -methods <- list( - 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" - ) -) +methods <- geposan::all_methods() # IDs of methods for geposan. method_ids <- sapply(methods, function(method) method$id) diff --git a/R/methods.R b/R/methods.R index 976a0b1..adcf801 100644 --- a/R/methods.R +++ b/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]], - { # nolint - shinyjs::toggleState(sprintf("%s_weight", method$id)) - }, - ignoreInit = TRUE - ) + observeEvent(c(input[[method$id]], input$optimization_target), { + shinyjs::toggleState( + sprintf("%s_weight", method$id), + condition = input$optimization_target == "custom" & + 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[[method$id]]) { - weight <- input[[sprintf("%s_weight", method$id)]] - weights[[method$id]] <- weight + if (input$optimization_target == "custom") { + for (method in methods) { + if (input[[method$id]]) { + 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) }) }) } diff --git a/R/preset_editor.R b/R/preset_editor.R index b4afcf8..8bd8302 100644 --- a/R/preset_editor.R +++ b/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], - optimization_target = "mean" + reference_gene_ids = genes[suggested | verified == TRUE, id] )) 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, - optimization_target = input$optimization_target + reference_gene_ids = reference_gene_ids ) }) diff --git a/R/server.R b/R/server.R index 2298f12..f2ca0c8 100644 --- a/R/server.R +++ b/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,