johrpan/geposanui
1
0
Fork 0
mirror of https://github.com/johrpan/geposanui.git synced 2025-10-26 11:17:24 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

methods: Cache optimization transiently

Browse source
This commit is contained in:
Elias Projahn 2022-02-24 15:04:04 +01:00
parent e61546b53c
commit 0ca4063429
1 changed files with 48 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

79
R/methods.R
View file

@ -69,17 +69,51 @@ 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))
})
# This reactive will always contain the optimal weights according to
# the selected parameters.
optimal_weights <- reactive({
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)
}
}
geposan::optimal_weights(
analysis(),
included_methods,
optimization_gene_ids(),
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) { for (method in methods) {
if (input[[method$id]]) { if (input[[method$id]]) {
weight <- input[[sprintf("%s_weight", method$id)]] weight <- input[[sprintf("%s_weight", method$id)]]
@ -87,35 +121,18 @@ methods_server <- function(id, analysis, comparison_gene_ids) {
} }
} }
} else { } else {
withProgress(message = "Optimizing weights", { weights <- optimal_weights()
setProgress(0.2)
included_methods <- NULL for (method_id in names(weights)) {
updateSliderInput(
for (method in methods) { session,
if (input[[method$id]]) { sprintf("%s_weight", method_id),
included_methods <- c(included_methods, method$id) value = weights[[method_id]]
}
}
weights <- geposan::optimal_weights(
analysis,
included_methods,
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)
}) })
}) })
} }