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

Move optimization to preset editor

Browse source
This commit is contained in:
Elias Projahn 2021-11-19 15:38:46 +01:00
parent 0d1070cc19
commit d2d1e09858
2 changed files with 38 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

65
R/methods.R
View file

@ -23,18 +23,9 @@ methods_ui <- function(id) {
)
)
}),
radioButtons(
NS(id, "target"),
"Optimization target",
choices = list(
"Mean rank of reference genes" = "mean",
"First rank of reference genes" = "min",
"Last rank of reference genes" = "max"
)
),
actionButton(
NS(id, "optimize_button"),
"Optimize weights",
NS(id, "reset_button"),
"Reset weights",
class = "btn-primary"
)
)
@ -47,33 +38,6 @@ methods_ui <- function(id) {
# @return A reactive containing the weighted results.
methods_server <- function(id, analysis) {
moduleServer(id, function(input, output, session) {
observeEvent(input$optimize_button, {
analysis <- analysis()
method_ids <- NULL
# Only include activated methods.
for (method in methods) {
if (input[[method$id]]) {
method_ids <- c(method_ids, method$id)
}
}
weights <- geposan::optimal_weights(
analysis,
method_ids,
analysis$preset$reference_gene_ids,
target = input$target
)
for (method_id in method_ids) {
updateSliderInput(
session,
sprintf("%s_weight", method_id),
value = weights[[method_id]]
)
}
})
# Observe each method's enable button and synchronise the slider state.
lapply(methods, function(method) {
observeEvent(input[[method$id]],
@ -84,9 +48,30 @@ methods_server <- function(id, analysis) {
)
})
reactive({
# Take the actual weights from the sliders.
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({
weights <- NULL
for (method in methods) {

15
R/preset_editor.R
View file

@ -61,6 +61,15 @@ preset_editor_ui <- function(id) {
)
)
),
selectInput(
NS(id, "optimization_target"),
"Optimization target",
choices = list(
"Mean rank of reference genes" = "mean",
"First rank of reference genes" = "min",
"Last rank of reference genes" = "max"
)
),
tabsetPanel(
id = NS(id, "apply_panel"),
type = "hidden",
@ -89,7 +98,8 @@ preset_editor_server <- function(id) {
methods = method_ids,
species_ids = species[replicative == TRUE, id],
gene_ids = genes$id,
reference_gene_ids = genes[suggested | verified == TRUE, id]
reference_gene_ids = genes[suggested | verified == TRUE, id],
optimization_target = "mean"
))
observeEvent(input$species, {
@ -145,7 +155,8 @@ preset_editor_server <- function(id) {
methods = method_ids,
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
)
})