ubigen/R/gene_selector.R

99 lines
2.4 KiB
R

#' Create the UI for a gene selector.
#'
#' @param id ID for namespacing.
#'
#' @return The user interface
#' @noRd
gene_selector_ui <- function(id) {
named_genes <- ubigen::genes[hgnc_name != ""]
named_genes <- unique(named_genes, by = "hgnc_name")
gene_choices <- named_genes$gene
names(gene_choices) <- named_genes$hgnc_name
verticalLayout(
selectInput(
NS(id, "identifier_type"),
verticalLayout(
strong("Gene identifiers"),
paste0(
"Select whether you want to pick or enter custom genes to assess ",
"how ubiquitous they are."
)
),
choices = list(
"Select from list" = "list",
"Enter HGNC symbols" = "hgnc",
"Enter Ensembl gene IDs" = "ensembl"
)
),
tabsetPanel(
id = NS(id, "custom_input"),
type = "hidden",
tabPanelBody(
"list",
shinyWidgets::virtualSelectInput(
NS(id, "selected_genes"),
label = NULL,
choices = gene_choices,
multiple = TRUE,
search = TRUE,
selectAllOnlyVisible = TRUE
),
),
tabPanelBody(
"hgnc",
textAreaInput(
NS(id, "hgnc_names_raw"),
label = NULL,
height = "250px"
)
),
tabPanelBody(
"ensembl",
textAreaInput(
NS(id, "gene_ids_raw"),
label = NULL,
height = "250px"
)
)
)
)
}
#' Application logic for the gene selector.
#'
#' @param id ID for namespacing.
#'
#' @return A reactive containing the selected gene IDs.
#' @noRd
gene_selector_server <- function(id) {
moduleServer(id, function(input, output, session) {
observe({
updateTabsetPanel(
session,
"custom_input",
selected = input$identifier_type
)
})
reactive({
gene_ids <- if (input$identifier_type == "list") {
input$selected_genes
} else if (input$identifier_type == "hgnc") {
inputs <- unique(strsplit(input$hgnc_names_raw, "\\s+")[[1]])
inputs <- inputs[inputs != ""]
ubigen::genes[hgnc_name %chin% inputs, gene]
} else {
inputs <- unique(strsplit(input$gene_ids_raw, "\\s+")[[1]])
inputs <- inputs[inputs != ""]
ubigen::genes[gene %chin% inputs, gene]
}
if (length(gene_ids > 100)) {
gene_ids[seq_len(100)]
} else {
gene_ids
}
})
})
}