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

Add options to configure default gene sets

Browse source
This commit is contained in:
Elias Projahn 2022-05-19 16:24:23 +02:00
parent 22f5e86625
commit 74d7865389
9 changed files with 391 additions and 370 deletions
Download patch file Download diff file Expand all files Collapse all files

33
R/app.R
View file

@ -1,15 +1,40 @@
#' Run the application server.
#'
#' @param gene_sets A list of predefined gene sets. This should be a named list
#' containing vectors of gene IDs for each set. The names will be used to
#' present the gene set throughout the user interface. You have to provide *at
#' least one gene set* which will be selected as the initial reference gene
#' set.
#' @param species_sets A list of predefined species sets. This should be a named
#' list containing vectors of species IDs for each set. The names will be used
#' to present the species set throughout the user interface.
#' @param locked Whether the application should be locked and prohibit
#' performing custom analyses. If this is set to `TRUE`, only the predefined
#' gene and species sets are available for customizing the analysis. This may
#' be useful to limit resource usage on a publicly available instance.
#' @param port The port to serve the application on.
#'
#' @export
run_app <- function(port = 3464) {
# These function calls make the required java scripts available.
run_app <- function(gene_sets,
species_sets = NULL,
locked = FALSE,
port = 3464) {
stopifnot(!is.null(gene_sets) & !is.null(gene_sets[[1]]))
# These function calls make the required java scripts available.
shinyjs::useShinyjs()
rclipboard::rclipboardSetup()
# Actually run the app.
# Bundle of global options to redue broilerplate.
options <- list(
gene_sets = gene_sets,
species_sets = species_sets,
locked = locked
)
shiny::runApp(shiny::shinyApp(ui, server), port = port)
# Actually run the app.
shiny::runApp(
shiny::shinyApp(ui(options), server(options)),
port = port
)
}

52
R/comparison_editor.R
View file

@ -1,22 +1,23 @@
# Create a comparison editor.
comparison_editor_ui <- function(id) {
#' Create a comparison editor.
#'
#' @param options Global application options
#' @noRd
comparison_editor_ui <- function(id, options) {
verticalLayout(
h3("Comparison"),
selectInput(
NS(id, "comparison_genes"),
"Comparison genes",
choices = list(
"None" = "none",
"Random genes" = "random",
"Verified or suggested TPE-OLD genes" = "tpeold",
"Only verified TPE-OLD genes" = "verified",
"Only suggested TPE-OLD genes" = "suggested",
"Customize" = "custom"
choices = c(
"None",
"Random genes",
names(options$gene_sets),
"Customize"
)
),
conditionalPanel(
condition = sprintf(
"input['%s'] == 'custom'",
"input['%s'] == 'Customize'",
NS(id, "comparison_genes")
),
gene_selector_ui(NS(id, "custom_genes"))
@ -24,33 +25,32 @@ comparison_editor_ui <- function(id) {
)
}
# Create a server for the comparison editor.
#
# @param id ID for namespacing the inputs and outputs.
# @param preset A reactive containing the current preset.
#
# @return A reactive containing the comparison gene IDs.
comparison_editor_server <- function(id, preset) {
#' Create a server for the comparison editor.
#'
#' @param id ID for namespacing the inputs and outputs.
#' @param preset A reactive containing the current preset.
#' @param options Global application options
#'
#' @return A reactive containing the comparison gene IDs.
#'
#' @noRd
comparison_editor_server <- function(id, preset, options) {
moduleServer(id, function(input, output, session) {
custom_gene_ids <- gene_selector_server("custom_genes")
reactive({
if (input$comparison_genes == "none") {
if (input$comparison_genes == "None") {
NULL
} else if (input$comparison_genes == "random") {
} else if (input$comparison_genes == "Random genes") {
preset <- preset()
gene_pool <- preset$gene_ids
reference_gene_ids <- preset$reference_gene_ids
gene_pool <- gene_pool[!gene_pool %chin% reference_gene_ids]
gene_pool[sample(length(gene_pool), length(reference_gene_ids))]
} else if (input$comparison_genes == "tpeold") {
genes[verified | suggested == TRUE, id]
} else if (input$comparison_genes == "verified") {
genes[verified == TRUE, id]
} else if (input$comparison_genes == "suggested") {
genes[suggested == TRUE, id]
} else {
} else if (input$comparison_genes == "Customize") {
custom_gene_ids()
} else {
options$gene_sets[[input$comparison_genes]]
}
})
})

62
R/data.R
View file

@ -1,65 +1,3 @@
# Species IDs of known replicatively aging species.
species_ids_replicative <- c(
"bihybrid",
"btaurus",
"bthybrid",
"cfamiliaris",
"chircus",
"cjacchus",
"clfamiliaris",
"csabaeus",
"ecaballus",
"fcatus",
"ggorilla",
"hsapiens",
"lafricana",
"mfascicularis",
"mmulatta",
"mmurinus",
"mnemestrina",
"nleucogenys",
"oaries",
"pabelii",
"panubis",
"ppaniscus",
"ptroglodytes",
"sscrofa",
"tgelada"
)
# Gene names of genes for verified TPE-OLD genes.
genes_verified_tpe_old <- c(
"C1S",
"DSP",
"ISG15",
"SORBS2",
"TERT"
)
# Gene names of genes with a suggested TPE-OLD.
genes_suggested_tpe_old <- c(
"AKAP3",
"ANO2",
"CCND2",
"CD163L1",
"CD9",
"FOXM1",
"GALNT8",
"NDUFA9",
"TEAD4",
"TIGAR",
"TSPAN9"
)
# Genes from [geposan] and their TPE-OLD status.
genes <- geposan::genes[, .(
id,
name,
chromosome,
suggested = name %chin% genes_suggested_tpe_old,
verified = name %chin% genes_verified_tpe_old
)]
# All available methods from [geposan] and additional information on them.
methods <- geposan::all_methods()

7
R/gene_selector.R
View file

@ -7,7 +7,7 @@
#'
#' @noRd
gene_selector_ui <- function(id, default_gene_ids = NULL) {
named_genes <- genes[name != ""]
named_genes <- geposan::genes[name != ""]
named_genes <- unique(named_genes, by = "name")
gene_choices <- named_genes$id
names(gene_choices) <- named_genes$name
@ -42,7 +42,10 @@ gene_selector_ui <- function(id, default_gene_ids = NULL) {
NS(id, "hgnc_names_raw"),
"Enter HGNC symbols",
value = paste(
genes[id %chin% default_gene_ids & name != "", name],
geposan::genes[
id %chin% default_gene_ids & name != "",
name
],
collapse = "\n"
),
height = "250px"

23
R/input_page.R
View file

@ -1,10 +1,13 @@
#' Create the UI for the input page.
#'
#' @param options Global options for the application.
#'
#' @noRd
input_page_ui <- function(id) {
input_page_ui <- function(id, options) {
sidebarLayout(
sidebarPanel(
width = 3,
preset_editor_ui(NS(id, "preset_editor")),
preset_editor_ui(NS(id, "preset_editor"), options),
tabsetPanel(
id = NS(id, "apply_panel"),
type = "hidden",
@ -19,7 +22,7 @@ input_page_ui <- function(id) {
)
)
),
comparison_editor_ui(NS(id, "comparison_editor"))
comparison_editor_ui(NS(id, "comparison_editor"), options)
),
mainPanel(
width = 9,
@ -35,21 +38,21 @@ input_page_ui <- function(id) {
#' Application logic for the input page.
#'
#' @param id ID for namespacing the inputs and outputs.
#' @param options Global options for the application.
#'
#' @return A list containing two reactives: the `preset` for the analysis and
#' the `comparison_gene_ids`.
#'
#' @noRd
input_page_server <- function(id) {
input_page_server <- function(id, options) {
moduleServer(id, function(input, output, session) {
current_preset <- reactiveVal(
geposan::preset(genes[verified | suggested == TRUE, id])
)
potential_preset <- preset_editor_server("preset_editor")
current_preset <- reactiveVal(geposan::preset(options$gene_sets[[1]]))
potential_preset <- preset_editor_server("preset_editor", options)
comparison_gene_ids <- comparison_editor_server(
"comparison_editor",
current_preset
current_preset,
options
)
output$positions_plot <- plotly::renderPlotly({

82
R/preset_editor.R
View file

@ -1,61 +1,82 @@
#' Create the UI for a preset editor.
#'
#' @param id ID for namespacing.
#' @param options Global options for the application.
#'
#' @return The UI elements.
#'
#' @noRd
preset_editor_ui <- function(id) {
preset_editor_ui <- function(id, options) {
species_choices <- c("All species", names(options$species_sets))
gene_choices <- names(options$gene_sets)
if (!options$locked) {
species_choices <- c(species_choices, "Customize")
gene_choices <- c(gene_choices, "Customize")
}
verticalLayout(
h3("Inputs"),
selectInput(
NS(id, "species"),
"Species to include",
choices = list(
"All species" = "all",
"Known replicatively aging species" = "replicative",
"Customize" = "custom"
)
choices = species_choices
),
if (!options$locked) {
conditionalPanel(
condition = sprintf("input['%s'] == 'custom'", NS(id, "species")),
condition = sprintf(
"input['%s'] == 'Customize'",
NS(id, "species")
),
selectizeInput(
inputId = NS(id, "custom_species"),
label = "Select input species",
choices = NULL,
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"
)
choices = gene_choices
),
if (!options$locked) {
conditionalPanel(
condition = sprintf(
"input['%s'] == 'custom'",
"input['%s'] == 'Customize'",
NS(id, "reference_genes")
),
gene_selector_ui(
NS(id, "custom_genes"),
genes[suggested | verified == TRUE, id]
gene_selector_ui(NS(id, "custom_genes"))
)
},
if (options$locked) {
HTML(
"This instance prohibits performing custom analyses ",
"to reduce resource usage. Normally, it is possible ",
"to use this web application for analyzing any set of ",
"reference genes to find patterns in their ",
"chromosomal positions. If you would like to apply ",
"this method for your own research, see ",
"<a href=\"https://code.johrpan.de/johrpan/tpeold\"",
"target=\"_blank\">this page</a> for more information."
)
}
)
}
#' Application logic for the preset editor.
#'
#' @param id ID for namespacing the inputs and outputs.
#' @param options Global application options.
#'
#' @return A reactive containing the preset or `NULL`, if the input data doesn't
#' result in a valid one.
#'
#' @noRd
preset_editor_server <- function(id) {
preset_editor_server <- function(id, options) {
moduleServer(id, function(input, output, session) {
custom_gene_ids <- if (!options$locked) {
species_choices <- geposan::species$id
names(species_choices) <- geposan::species$name
@ -66,23 +87,24 @@ preset_editor_server <- function(id) {
server = TRUE
)
custom_gene_ids <- gene_selector_server("custom_genes")
reactive({
reference_gene_ids <- if (input$reference_genes == "tpeold") {
genes[verified | suggested == TRUE, id]
} else if (input$reference_genes == "verified") {
genes[verified == TRUE, id]
gene_selector_server("custom_genes")
} else {
custom_gene_ids()
NULL
}
species_ids <- if (input$species == "replicative") {
species_ids_replicative
} else if (input$species == "all") {
geposan::species$id
reactive({
reference_gene_ids <- if (input$reference_genes == "Customize") {
custom_gene_ids()
} else {
options$gene_sets[[input$reference_genes]]
}
species_ids <- if (input$species == "All species") {
geposan::species$id
} else if (input$species == "Customize") {
input$custom_species
} else {
options$species_sets[[input$species]]
}
tryCatch(

18
R/server.R
View file

@ -7,8 +7,13 @@ js_link <- DT::JS("function(row, data) {
$('td:eq(1)', row).html(`<a href=\"${url}\" target=\"_blank\">${name}</a>`);
}")
server <- function(input, output, session) {
input_reactives <- input_page_server("input_page")
#' Create a server function for the application.
#'
#' @param options Global application options.
#' @noRd
server <- function(options) {
function(input, output, session) {
input_reactives <- input_page_server("input_page", options)
preset <- input_reactives$preset
comparison_gene_ids <- input_reactives$comparison_gene_ids
@ -164,7 +169,13 @@ server <- function(input, output, session) {
data[, total_ratio := term_size / effective_domain_size]
data[, query_ratio := intersection_size / query_size]
data <- data[, .(source, term_name, total_ratio, query_ratio, p_value)]
data <- data[, .(
source,
term_name,
total_ratio,
query_ratio,
p_value
)]
dt <- DT::datatable(
data,
@ -228,4 +239,5 @@ server <- function(input, output, session) {
}
)
})
}
}

7
R/ui.R
View file

@ -1,6 +1,9 @@
#' Generate the main UI for the application.
#'
#' @param options Global options for the application.
#'
#' @noRd
ui <- function() {
ui <- function(options) {
div(
shinyjs::useShinyjs(),
rclipboard::rclipboardSetup(),
@ -15,7 +18,7 @@ ui <- function() {
selected = "Results",
tabPanel(
"Input data",
input_page_ui("input_page")
input_page_ui("input_page", options)
),
tabPanel(
"Results",

17
man/run_app.Rd
View file

@ -4,9 +4,24 @@
\alias{run_app}
\title{Run the application server.}
\usage{
run_app(port = 3464)
run_app(gene_sets, species_sets = NULL, locked = FALSE, port = 3464)
}
\arguments{
\item{gene_sets}{A list of predefined gene sets. This should be a named list
containing vectors of gene IDs for each set. The names will be used to
present the gene set throughout the user interface. You have to provide \emph{at
least one gene set} which will be selected as the initial reference gene
set.}
\item{species_sets}{A list of predefined species sets. This should be a named
list containing vectors of species IDs for each set. The names will be used
to present the species set throughout the user interface.}
\item{locked}{Whether the application should be locked and prohibit
performing custom analyses. If this is set to \code{TRUE}, only the predefined
gene and species sets are available for customizing the analysis. This may
be useful to limit resource usage on a publicly available instance.}
\item{port}{The port to serve the application on.}
}
\description{