mirror of
https://github.com/johrpan/geposanui.git
synced 2025-10-26 11:17:24 +01:00
preset editor: Simplify and add more options
This commit is contained in:
parent
b5957262a3
commit
9b9109b389
5 changed files with 124 additions and 59 deletions
23
R/data.R
23
R/data.R
|
|
@ -106,26 +106,3 @@ method_ids <- sapply(methods, function(method) method$id)
|
|||
|
||||
# Names of methods for geposan.
|
||||
method_names <- sapply(methods, function(method) method$name)
|
||||
|
||||
# Gene IDs of known or suggested TPE-OLD genes.
|
||||
genes_tpe_old <- genes[suggested | verified == TRUE, id]
|
||||
|
||||
# Species IDs for replicatively aging species.
|
||||
species_replicative <- species[replicative == TRUE, id]
|
||||
|
||||
# Preset for [geposan] including all species and TPE-OLD genes for reference.
|
||||
preset_all_species <- geposan::preset(
|
||||
methods = method_ids,
|
||||
species_ids = species$id,
|
||||
gene_ids = genes$id,
|
||||
reference_gene_ids = genes_tpe_old
|
||||
)
|
||||
|
||||
# Preset for [geposan] including only replicatively aging species as well as
|
||||
# TPE-OLD genes for reference.
|
||||
preset_replicative_species <- geposan::preset(
|
||||
methods = method_ids,
|
||||
species_ids = species_replicative,
|
||||
gene_ids = genes$id,
|
||||
reference_gene_ids = genes_tpe_old
|
||||
)
|
||||
|
|
|
|||
|
|
@ -53,6 +53,7 @@ methods_ui <- function(id) {
|
|||
methods_server <- function(id, analysis, min_n_species) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
observeEvent(input$optimize_button, {
|
||||
analysis <- analysis()
|
||||
method_ids <- NULL
|
||||
|
||||
# Only include activated methods.
|
||||
|
|
@ -63,9 +64,9 @@ methods_server <- function(id, analysis, min_n_species) {
|
|||
}
|
||||
|
||||
weights <- geposan::optimal_weights(
|
||||
analysis(),
|
||||
analysis,
|
||||
method_ids,
|
||||
genes_tpe_old,
|
||||
analysis$preset$reference_gene_ids,
|
||||
target = input$target,
|
||||
min_n_species = min_n_species()
|
||||
)
|
||||
|
|
|
|||
|
|
@ -8,10 +8,10 @@ preset_editor_ui <- function(id) {
|
|||
names(gene_choices) <- known_genes$name
|
||||
|
||||
verticalLayout(
|
||||
h3("Preset"),
|
||||
h3("Inputs"),
|
||||
selectInput(
|
||||
NS(id, "preset"),
|
||||
"Default presets",
|
||||
NS(id, "species"),
|
||||
"Species to include",
|
||||
choices = list(
|
||||
"Replicatively aging species" = "replicative",
|
||||
"All species" = "all",
|
||||
|
|
@ -19,33 +19,54 @@ preset_editor_ui <- function(id) {
|
|||
)
|
||||
),
|
||||
tabsetPanel(
|
||||
id = NS(id, "customization"),
|
||||
id = NS(id, "custom_species_panel"),
|
||||
type = "hidden",
|
||||
tabPanelBody(value = "none"),
|
||||
tabPanelBody(value = "hide"),
|
||||
tabPanelBody(
|
||||
value = "custom",
|
||||
value = "show",
|
||||
shinyWidgets::pickerInput(
|
||||
inputId = NS(id, "species"),
|
||||
label = "Included species",
|
||||
inputId = NS(id, "custom_species"),
|
||||
choices = species_choices,
|
||||
selected = species_replicative,
|
||||
options = list(
|
||||
"actions-box" = TRUE,
|
||||
"live-search" = TRUE
|
||||
),
|
||||
multiple = TRUE
|
||||
)
|
||||
)
|
||||
),
|
||||
selectInput(
|
||||
NS(id, "reference_genes"),
|
||||
"Reference genes",
|
||||
choices = list(
|
||||
"Verified or suggested TPE-OLD genes" = "tpeold",
|
||||
"Only verified TPE-OLD genes" = "verified",
|
||||
"Customize" = "custom"
|
||||
)
|
||||
),
|
||||
tabsetPanel(
|
||||
id = NS(id, "custom_reference_genes_panel"),
|
||||
type = "hidden",
|
||||
tabPanelBody(value = "hide"),
|
||||
tabPanelBody(
|
||||
value = "show",
|
||||
shinyWidgets::pickerInput(
|
||||
inputId = NS(id, "reference_genes"),
|
||||
label = "Reference genes",
|
||||
inputId = NS(id, "custom_reference_genes"),
|
||||
choices = gene_choices,
|
||||
selected = genes_tpe_old,
|
||||
options = list(
|
||||
"actions-box" = TRUE,
|
||||
"live-search" = TRUE
|
||||
),
|
||||
multiple = TRUE
|
||||
)
|
||||
)
|
||||
),
|
||||
tabsetPanel(
|
||||
id = NS(id, "apply_panel"),
|
||||
type = "hidden",
|
||||
tabPanelBody(value = "hide"),
|
||||
tabPanelBody(
|
||||
value = "show",
|
||||
actionButton(
|
||||
NS(id, "apply_button"),
|
||||
"Perform analysis",
|
||||
|
|
@ -64,31 +85,97 @@ preset_editor_ui <- function(id) {
|
|||
# @return A reactive containing the preset.
|
||||
preset_editor_server <- function(id) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
result <- reactiveVal(preset_replicative_species)
|
||||
current_preset <- reactiveVal(geposan::preset(
|
||||
methods = method_ids,
|
||||
species_ids = species[replicative == TRUE, id],
|
||||
gene_ids = genes$id,
|
||||
reference_gene_ids = genes[suggested | verified == TRUE, id]
|
||||
))
|
||||
|
||||
observeEvent(input$preset, {
|
||||
panel <- if (input$preset == "replicative") {
|
||||
result(preset_replicative_species)
|
||||
"none"
|
||||
} else if (input$preset == "all") {
|
||||
result(preset_all_species)
|
||||
"none"
|
||||
observeEvent(input$species, {
|
||||
if (input$species == "custom") {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"custom_species_panel",
|
||||
selected = "show"
|
||||
)
|
||||
} else {
|
||||
"custom"
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"custom_species_panel",
|
||||
selected = "hide"
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
observeEvent(input$reference_genes, {
|
||||
if (input$reference_genes == "custom") {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"custom_reference_genes_panel",
|
||||
selected = "show"
|
||||
)
|
||||
} else {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"custom_reference_genes_panel",
|
||||
selected = "hide"
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
new_preset <- reactive({
|
||||
species_ids <- if (input$species == "replicative") {
|
||||
species[replicative == TRUE, id]
|
||||
} else if (input$species == "all") {
|
||||
species$id
|
||||
} else {
|
||||
input$custom_species
|
||||
}
|
||||
|
||||
updateTabsetPanel(session, "customization", selected = panel)
|
||||
reference_gene_ids <- if (input$reference_genes == "tpeold") {
|
||||
genes[verified | suggested == TRUE, id]
|
||||
} else if (input$reference_genes == "verified") {
|
||||
genes[verified == TRUE, id]
|
||||
} else {
|
||||
input$custom_reference_genes
|
||||
}
|
||||
|
||||
geposan::preset(
|
||||
methods = method_ids,
|
||||
species_ids = species_ids,
|
||||
gene_ids = genes$id,
|
||||
reference_gene_ids = reference_gene_ids
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(
|
||||
{ # nolint
|
||||
current_preset()
|
||||
new_preset()
|
||||
},
|
||||
{ # nolint
|
||||
if (rlang::hash(new_preset()) !=
|
||||
rlang::hash(current_preset())) {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"apply_panel",
|
||||
selected = "show"
|
||||
)
|
||||
} else {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"apply_panel",
|
||||
selected = "hide"
|
||||
)
|
||||
}
|
||||
}
|
||||
)
|
||||
|
||||
observeEvent(input$apply_button, {
|
||||
result(geposan::preset(
|
||||
methods = method_ids,
|
||||
species_ids = input$species,
|
||||
gene_ids = genes$id,
|
||||
reference_gene_ids = input$reference_genes
|
||||
))
|
||||
current_preset(new_preset())
|
||||
})
|
||||
|
||||
result
|
||||
current_preset
|
||||
})
|
||||
}
|
||||
|
|
|
|||
|
|
@ -157,7 +157,7 @@ server <- function(input, output, session) {
|
|||
geposan::plot_scores(
|
||||
ranking(),
|
||||
gene_sets = list(preset()$reference_gene_ids),
|
||||
labels = "TPE-OLD genes",
|
||||
labels = "Reference genes",
|
||||
max_rank = results_filtered()[, max(rank)]
|
||||
)
|
||||
})
|
||||
|
|
@ -166,7 +166,7 @@ server <- function(input, output, session) {
|
|||
geposan::plot_boxplot(
|
||||
ranking(),
|
||||
gene_sets = list(preset()$reference_gene_ids),
|
||||
labels = "TPE-OLD genes"
|
||||
labels = "Reference genes"
|
||||
)
|
||||
})
|
||||
|
||||
|
|
|
|||
2
R/ui.R
2
R/ui.R
|
|
@ -6,6 +6,7 @@ ui <- fluidPage(
|
|||
sidebarPanel(
|
||||
width = 3,
|
||||
preset_editor_ui("preset_editor"),
|
||||
filters_ui("filters"),
|
||||
sliderInput(
|
||||
"n_species",
|
||||
"Required number of species per gene",
|
||||
|
|
@ -14,7 +15,6 @@ ui <- fluidPage(
|
|||
step = 1,
|
||||
value = 10
|
||||
),
|
||||
filters_ui("filters"),
|
||||
methods_ui("methods")
|
||||
),
|
||||
mainPanel(
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue