mirror of
https://github.com/johrpan/geposanui.git
synced 2025-10-26 11:17:24 +01:00
Add preset editor
This commit is contained in:
parent
365cf13dcb
commit
ca1d0e442a
4 changed files with 102 additions and 28 deletions
|
|
@ -23,4 +23,5 @@ Imports:
|
||||||
rlang,
|
rlang,
|
||||||
rclipboard,
|
rclipboard,
|
||||||
shiny,
|
shiny,
|
||||||
shinyjs
|
shinyjs,
|
||||||
|
shinyWidgets
|
||||||
|
|
|
||||||
92
R/preset_editor.R
Normal file
92
R/preset_editor.R
Normal file
|
|
@ -0,0 +1,92 @@
|
||||||
|
# Create a preset editor.
|
||||||
|
preset_editor_ui <- function(id) {
|
||||||
|
species_choices <- species$id
|
||||||
|
names(species_choices) <- species$name
|
||||||
|
|
||||||
|
species_selected <- species_ids_replicative
|
||||||
|
|
||||||
|
known_genes <- genes[name != ""]
|
||||||
|
gene_choices <- known_genes$id
|
||||||
|
names(gene_choices) <- known_genes$name
|
||||||
|
|
||||||
|
genes_selected <- genes[suggested | verified == TRUE, id]
|
||||||
|
|
||||||
|
verticalLayout(
|
||||||
|
h3("Preset"),
|
||||||
|
selectInput(
|
||||||
|
NS(id, "preset"),
|
||||||
|
"Default presets",
|
||||||
|
choices = list(
|
||||||
|
"Replicatively aging species" = "replicative",
|
||||||
|
"All species" = "all",
|
||||||
|
"Customize" = "custom"
|
||||||
|
)
|
||||||
|
),
|
||||||
|
conditionalPanel(
|
||||||
|
sprintf("input['%s'] == 'custom'", NS(id, "preset")),
|
||||||
|
shinyWidgets::pickerInput(
|
||||||
|
inputId = NS(id, "species"),
|
||||||
|
label = "Included species",
|
||||||
|
choices = species_choices,
|
||||||
|
selected = species_selected,
|
||||||
|
options = list(
|
||||||
|
"actions-box" = TRUE,
|
||||||
|
"live-search" = TRUE
|
||||||
|
),
|
||||||
|
multiple = TRUE
|
||||||
|
),
|
||||||
|
shinyWidgets::pickerInput(
|
||||||
|
inputId = NS(id, "reference_genes"),
|
||||||
|
label = "Reference genes",
|
||||||
|
choices = gene_choices,
|
||||||
|
selected = genes_selected,
|
||||||
|
options = list(
|
||||||
|
"actions-box" = TRUE,
|
||||||
|
"live-search" = TRUE
|
||||||
|
),
|
||||||
|
multiple = TRUE
|
||||||
|
),
|
||||||
|
actionButton(
|
||||||
|
NS(id, "apply_button"),
|
||||||
|
"Perform analysis",
|
||||||
|
class = "btn-primary",
|
||||||
|
style = "margin-top: 16px; margin-bottom: 16px"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
# Create a server for the preset editor.
|
||||||
|
#
|
||||||
|
# @param id ID for namespacing the inputs and outputs.
|
||||||
|
#
|
||||||
|
# @return A reactive containing the preset.
|
||||||
|
preset_editor_server <- function(id) {
|
||||||
|
moduleServer(id, function(input, output, session) {
|
||||||
|
result <- reactiveVal(preset_replicative_species)
|
||||||
|
|
||||||
|
observeEvent(input$preset, {
|
||||||
|
if (input$preset == "replicative") {
|
||||||
|
result(preset_replicative_species)
|
||||||
|
} else if (input$preset == "all") {
|
||||||
|
result(preset_all_species)
|
||||||
|
}
|
||||||
|
})
|
||||||
|
|
||||||
|
observeEvent(input$apply_button, {
|
||||||
|
result(geposan::preset(
|
||||||
|
methods <- c(
|
||||||
|
"clusteriness",
|
||||||
|
"correlation",
|
||||||
|
"proximity",
|
||||||
|
"neural"
|
||||||
|
),
|
||||||
|
species = input$species,
|
||||||
|
genes = genes$id,
|
||||||
|
reference_genes = input$reference_genes
|
||||||
|
))
|
||||||
|
})
|
||||||
|
|
||||||
|
result
|
||||||
|
})
|
||||||
|
}
|
||||||
26
R/server.R
26
R/server.R
|
|
@ -8,17 +8,15 @@ js_link <- DT::JS("function(row, data) {
|
||||||
}")
|
}")
|
||||||
|
|
||||||
server <- function(input, output, session) {
|
server <- function(input, output, session) {
|
||||||
|
preset <- preset_editor_server("preset_editor")
|
||||||
|
|
||||||
# Show the customized slider for setting the required number of species.
|
# Show the customized slider for setting the required number of species.
|
||||||
output$n_species_slider <- renderUI({
|
output$n_species_slider <- renderUI({
|
||||||
sliderInput(
|
sliderInput(
|
||||||
"n_species",
|
"n_species",
|
||||||
"Required number of species per gene",
|
"Required number of species per gene",
|
||||||
min = 0,
|
min = 0,
|
||||||
max = if (input$species == "all") {
|
max = length(preset()$species_ids),
|
||||||
nrow(species)
|
|
||||||
} else {
|
|
||||||
length(species_ids_replicative)
|
|
||||||
},
|
|
||||||
step = 1,
|
step = 1,
|
||||||
value = 10
|
value = 10
|
||||||
)
|
)
|
||||||
|
|
@ -26,12 +24,7 @@ server <- function(input, output, session) {
|
||||||
|
|
||||||
# Compute the results according to the preset.
|
# Compute the results according to the preset.
|
||||||
analysis <- reactive({
|
analysis <- reactive({
|
||||||
# Select the preset.
|
preset <- preset()
|
||||||
preset <- if (input$species == "all") {
|
|
||||||
preset_all_species
|
|
||||||
} else {
|
|
||||||
preset_replicative_species
|
|
||||||
}
|
|
||||||
|
|
||||||
# Perform the analysis cached based on the preset's hash.
|
# Perform the analysis cached based on the preset's hash.
|
||||||
results <- withProgress(
|
results <- withProgress(
|
||||||
|
|
@ -133,18 +126,13 @@ server <- function(input, output, session) {
|
||||||
|
|
||||||
gene_ids <- results[input$genes_rows_selected, gene]
|
gene_ids <- results[input$genes_rows_selected, gene]
|
||||||
genes <- genes[id %chin% gene_ids]
|
genes <- genes[id %chin% gene_ids]
|
||||||
|
species <- species[id %chin% preset()$species_ids]
|
||||||
species <- if (input$species == "all") {
|
|
||||||
species
|
|
||||||
} else {
|
|
||||||
species[replicative == TRUE]
|
|
||||||
}
|
|
||||||
|
|
||||||
scatter_plot(results, species, genes)
|
scatter_plot(results, species, genes)
|
||||||
})
|
})
|
||||||
|
|
||||||
output$assessment_synopsis <- renderText({
|
output$assessment_synopsis <- renderText({
|
||||||
reference_gene_ids <- genes[suggested | verified == TRUE, id]
|
reference_gene_ids <- preset()$reference_gene_ids
|
||||||
|
|
||||||
included_reference_count <- results_filtered()[
|
included_reference_count <- results_filtered()[
|
||||||
gene %chin% reference_gene_ids,
|
gene %chin% reference_gene_ids,
|
||||||
|
|
@ -184,7 +172,7 @@ server <- function(input, output, session) {
|
||||||
output$rank_plot <- plotly::renderPlotly({
|
output$rank_plot <- plotly::renderPlotly({
|
||||||
rank_plot(
|
rank_plot(
|
||||||
results(),
|
results(),
|
||||||
genes[suggested | verified == TRUE, id],
|
preset()$reference_gene_ids,
|
||||||
input$cutoff / 100
|
input$cutoff / 100
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
|
|
|
||||||
9
R/ui.R
9
R/ui.R
|
|
@ -5,15 +5,8 @@ ui <- fluidPage(
|
||||||
sidebarLayout(
|
sidebarLayout(
|
||||||
sidebarPanel(
|
sidebarPanel(
|
||||||
width = 3,
|
width = 3,
|
||||||
|
preset_editor_ui("preset_editor"),
|
||||||
h3("Filter criteria"),
|
h3("Filter criteria"),
|
||||||
selectInput(
|
|
||||||
"species",
|
|
||||||
"Species to include",
|
|
||||||
choices = list(
|
|
||||||
"Replicatively aging" = "replicative",
|
|
||||||
"All qualified" = "all"
|
|
||||||
)
|
|
||||||
),
|
|
||||||
uiOutput("n_species_slider"),
|
uiOutput("n_species_slider"),
|
||||||
sliderInput(
|
sliderInput(
|
||||||
"cutoff",
|
"cutoff",
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue