methods: Cache optimization transiently

This commit is contained in:
Elias Projahn 2022-02-24 15:04:04 +01:00
parent e61546b53c
commit 0ca4063429

View file

@ -69,24 +69,21 @@ methods_server <- function(id, analysis, comparison_gene_ids) {
}) })
}) })
reactive({ # This reactive will always contain the currently selected optimization
analysis <- analysis() # gene IDs in a normalized form.
weights <- NULL optimization_gene_ids <- reactive({
gene_ids <- if (input$optimization_genes == "comparison") { gene_ids <- if (input$optimization_genes == "comparison") {
comparison_gene_ids() comparison_gene_ids()
} else { } else {
analysis$preset$reference_gene_ids analysis()$preset$reference_gene_ids
} }
if (length(gene_ids) < 1 | input$optimization_target == "custom") { sort(unique(gene_ids))
for (method in methods) { })
if (input[[method$id]]) {
weight <- input[[sprintf("%s_weight", method$id)]] # This reactive will always contain the optimal weights according to
weights[[method$id]] <- weight # the selected parameters.
} optimal_weights <- reactive({
}
} else {
withProgress(message = "Optimizing weights", { withProgress(message = "Optimizing weights", {
setProgress(0.2) setProgress(0.2)
@ -98,12 +95,33 @@ methods_server <- function(id, analysis, comparison_gene_ids) {
} }
} }
weights <- geposan::optimal_weights( geposan::optimal_weights(
analysis, analysis(),
included_methods, included_methods,
gene_ids, optimization_gene_ids(),
target = input$optimization_target target = input$optimization_target
) )
})
}) |> bindCache(
analysis(),
optimization_gene_ids(),
sapply(methods, function(method) input[[method$id]]),
input$optimization_target
)
reactive({
weights <- NULL
if (length(optimization_gene_ids()) < 1 |
input$optimization_target == "custom") {
for (method in methods) {
if (input[[method$id]]) {
weight <- input[[sprintf("%s_weight", method$id)]]
weights[[method$id]] <- weight
}
}
} else {
weights <- optimal_weights()
for (method_id in names(weights)) { for (method_id in names(weights)) {
updateSliderInput( updateSliderInput(
@ -112,10 +130,9 @@ methods_server <- function(id, analysis, comparison_gene_ids) {
value = weights[[method_id]] value = weights[[method_id]]
) )
} }
})
} }
geposan::ranking(analysis, weights) geposan::ranking(analysis(), weights)
}) })
}) })
} }