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

53
R/methods.R
View file

@ -69,24 +69,21 @@ methods_server <- function(id, analysis, comparison_gene_ids) {
})
})
reactive({
analysis <- analysis()
weights <- NULL
# This reactive will always contain the currently selected optimization
# gene IDs in a normalized form.
optimization_gene_ids <- reactive({
gene_ids <- if (input$optimization_genes == "comparison") {
comparison_gene_ids()
} else {
analysis$preset$reference_gene_ids
analysis()$preset$reference_gene_ids
}
if (length(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 {
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)
@ -98,12 +95,33 @@ methods_server <- function(id, analysis, comparison_gene_ids) {
}
}
weights <- geposan::optimal_weights(
analysis,
geposan::optimal_weights(
analysis(),
included_methods,
gene_ids,
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) {
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)) {
updateSliderInput(
@ -112,10 +130,9 @@ methods_server <- function(id, analysis, comparison_gene_ids) {
value = weights[[method_id]]
)
}
})
}
geposan::ranking(analysis, weights)
geposan::ranking(analysis(), weights)
})
})
}