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 methods to separate module

Browse source
This commit is contained in:
Elias Projahn 2021-10-19 16:44:29 +02:00
parent 079deb0faf
commit bf6df6af86
3 changed files with 105 additions and 77 deletions
Download patch file Download diff file Expand all files Collapse all files

95
methods.R Normal file
View file

@ -0,0 +1,95 @@
library(shiny)
#' Construct UI for the methods editor.
methods_ui <- function(id) {
initial_weight <- 100 / length(methods)
verticalLayout(
h3("Methods"),
actionButton(
NS(id, "optimize_button"),
"Find optimal weights",
icon = icon("check-double")
),
div(style = "margin-top: 16px"),
lapply(methods, function(method) {
verticalLayout(
checkboxInput(
NS(id, method$id),
span(
method$description,
style = "font-weight: bold"
),
value = TRUE
),
sliderInput(
NS(id, sprintf("%s_weight", method$id)),
NULL,
post = "%",
min = 0,
max = 100,
step = 1,
value = initial_weight
)
)
})
)
}
#' Construct server for the methods editor.
#'
#' @param analysis The reactive containing the results to be weighted.
#'
#' @return A reactive containing the weighted results.
methods_server <- function(id, analysis) {
moduleServer(id, function(input, output, session) {
observeEvent(input$optimize_button, {
method_ids <- NULL
# Only include activated methods.
for (method in methods) {
if (input[[method$id]]) {
method_ids <- c(method_ids, method$id)
}
}
weights <- geposan::optimize_weights(
analysis(),
method_ids,
genes_tpe_old
)
for (method_id in method_ids) {
updateSliderInput(
session,
sprintf("%s_weight", method_id),
value = weights[[method_id]] * 100
)
}
})
# Observe each method's enable button and synchronise the slider state.
lapply(methods, function(method) {
observeEvent(input[[method$id]], {
shinyjs::toggleState(
session$ns(sprintf("%s_weight", method$id))
)
}, ignoreInit = TRUE)
})
reactive({
# Take the actual weights from the sliders.
weights <- NULL
for (method in methods) {
if (input[[method$id]]) {
weight <- input[[sprintf("%s_weight", method$id)]]
weights[[method$id]] <- weight
}
}
geposan::ranking(analysis(), weights)
})
})
}

56
server.R
View file

@ -6,6 +6,7 @@ library(plotly)
library(rclipboard)
library(shiny)
source("methods.R")
source("rank_plot.R")
source("scatter_plot.R")
source("utils.R")
@ -36,41 +37,8 @@ server <- function(input, output, session) {
)
})
observeEvent(input$optimize_button, {
results <- isolate(results())
method_ids <- NULL
for (method in methods) {
if (isolate(input[[method$id]])) {
method_ids <- c(method_ids, method$id)
}
}
weights <- geposan::optimize_weights(
results,
method_ids,
genes_tpe_old
)
for (method_id in method_ids) {
updateSliderInput(
session,
sprintf("%s_weight", method_id),
value = weights[[method_id]] * 100
)
}
})
# Observe each method's enable button.
lapply(methods, function(method) {
observeEvent(input[[method$id]], {
shinyjs::toggleState(sprintf("%s_weight", method$id))
}, ignoreInit = TRUE)
})
#' Rank the results based on the specified weights. Filter out genes with
#' too few species but don't apply the cut-off score.
results <- reactive({
#' Compute the results according to the preset.
analysis <- reactive({
# Select the preset.
preset <- if (input$species == "all") {
preset_all_species
@ -102,22 +70,12 @@ server <- function(input, output, session) {
)
# Exclude genes with too few species.
results <- results[n_species >= input$n_species]
# Rank the results based on the weights.
weights <- NULL
for (method in methods) {
if (input[[method$id]]) {
weight <- input[[sprintf("%s_weight", method$id)]]
weights[[method$id]] <- weight
}
}
geposan::ranking(results, weights)
results[n_species >= input$n_species]
})
# Rank the results.
results <- methods_server("methods", analysis)
#' Apply the cut-off score to the ranked results.
results_filtered <- reactive({
results()[score >= input$cutoff / 100]

31
ui.R
View file

@ -3,6 +3,8 @@ library(plotly)
library(rclipboard)
library(shiny)
source("methods.R")
ui <- fluidPage(
shinyjs::useShinyjs(),
rclipboardSetup(),
@ -29,34 +31,7 @@ ui <- fluidPage(
step = 1,
value = 50
),
h3("Methods"),
actionButton(
"optimize_button",
"Find optimal weights",
icon = icon("check-double")
),
div(style = "margin-top: 16px"),
lapply(methods, function(method) {
verticalLayout(
checkboxInput(
method$id,
span(
method$description,
style = "font-weight: bold"
),
value = TRUE
),
sliderInput(
sprintf("%s_weight", method$id),
NULL,
post = "%",
min = 0,
max = 100,
step = 1,
value = 100
)
)
})
methods_ui("methods")
),
mainPanel(
tabsetPanel(