methods: Allow to optimize for comparison genes

This commit is contained in:
Elias Projahn 2022-01-25 13:05:04 +01:00
parent 11c125465d
commit 2faaeb869a
2 changed files with 22 additions and 8 deletions

View file

@ -2,14 +2,22 @@
methods_ui <- function(id) { methods_ui <- function(id) {
verticalLayout( verticalLayout(
h3("Methods"), h3("Methods"),
selectInput(
NS(id, "optimization_genes"),
"Genes to optimize for",
choices = list(
"Reference genes" = "reference",
"Comparison genes" = "comparison"
)
),
selectInput( selectInput(
NS(id, "optimization_target"), NS(id, "optimization_target"),
"Optimization target", "Optimization target",
choices = list( choices = list(
"Mean rank of reference genes" = "mean", "Mean rank" = "mean",
"Median rank of reference genes" = "median", "Median rank" = "median",
"First rank of reference genes" = "min", "First rank" = "min",
"Last rank of reference genes" = "max", "Last rank" = "max",
"Customize weights" = "custom" "Customize weights" = "custom"
) )
), ),
@ -41,7 +49,7 @@ methods_ui <- function(id) {
# @param analysis The reactive containing the results to be weighted. # @param analysis The reactive containing the results to be weighted.
# #
# @return A reactive containing the weighted results. # @return A reactive containing the weighted results.
methods_server <- function(id, analysis) { methods_server <- function(id, analysis, comparison_gene_ids) {
moduleServer(id, function(input, output, session) { moduleServer(id, function(input, output, session) {
# Observe each method's enable button and synchronise the slider state. # Observe each method's enable button and synchronise the slider state.
lapply(methods, function(method) { lapply(methods, function(method) {
@ -65,7 +73,13 @@ methods_server <- function(id, analysis) {
analysis <- analysis() analysis <- analysis()
weights <- NULL weights <- NULL
if (input$optimization_target == "custom") { gene_ids <- if (input$optimization_genes == "comparison") {
comparison_gene_ids()
} else {
analysis$preset$reference_gene_ids
}
if (length(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,7 +101,7 @@ methods_server <- function(id, analysis) {
weights <- geposan::optimal_weights( weights <- geposan::optimal_weights(
analysis, analysis,
included_methods, included_methods,
analysis$preset$reference_gene_ids, gene_ids,
target = input$optimization_target target = input$optimization_target
) )

View file

@ -31,7 +31,7 @@ server <- function(input, output, session) {
}) })
# Rank the results. # Rank the results.
ranking <- methods_server("methods", analysis) ranking <- methods_server("methods", analysis, comparison_gene_ids)
# Add gene information to the results. # Add gene information to the results.
results <- reactive({ results <- reactive({