У меня возникли проблемы с настройкой требуемой функциональности на трех входах выбора в блестящем приложении. Приложение имеет три последовательных ввода (ген, ткань, событие), где значение входа гена ограничивает набор значений ткани, а значение ввода ткани ограничивает набор значений события.
Я настроил функциональность для обновления выбора ткани / события при выборе гена и обновления выбора события при выборе ткани.
Мне также нужна отдельная функция, где Я обновляю все три этих ввода, когда строка выбирается в DataTable.
Я реализовал обе эти функции, но обнаружил, что настроил состояние гонки. Когда я выбираю строку из DataTable, иногда правильные значения вводятся во входные данные, а иногда значения по умолчанию вводятся в ткань / событие, выбирая значение по умолчанию для гена (первая ткань для этого гена, первое событие для этого ткань).
Есть ли способ, которым я могу изменить свои настройки или остановить это состояние гонки и при этом достичь этих функций?
library(shiny)
library(yaml)
library(DT)
library(shinythemes)
options(bitmapType='cairo')
df <- load.df()
dataTable.df <- load.dataTable.df()
ui <- navbarPage(
theme = shinytheme("cerulean"), #flatly, simplex, spacelab
"viewer",
tabsetPanel(id = "viewer",
tabPanel(
title = "panel1",
value = "panel1",
mainPanel(
fluidPage(
h3("hits"),
DT::dataTableOutput(
'hits.table',
height = "500px",
width = "100%"
)
)
)
),
tabPanel(
title = "plots",
value = "plots",
sidebarPanel(
selectizeInput("gene.select",
label = "Choose gene:",
choices = gene.list,
multiple = FALSE
),
br(),
selectizeInput("tissue.select",
label = "Choose tissue:",
choices = NULL,
multiple = FALSE
),
br(),
selectizeInput("event.select",
label = "Choose splicing event:",
choices = NULL,
multiple = FALSE
),
br(),
actionButton("go.plot", "Go!")
),
mainPanel(
imageOutput(
"boxplot", width="50%", height= "auto", inline=TRUE
)
)
)
)
)
server <- function(input, output, session){
# When an input is updated, update the query string
observeEvent(input$gene.select, {
query <- parseQueryString(session$clientData$url_search)
tissue <- query[['tissue']]
event <- query[['event']]
updateQueryString(
paste(
paste("?gene", input$gene.select, sep="="),
paste("tissue", input$tissue.select, sep="="),
paste("event", input$event.select, sep="="),
sep="&"
)
)
})
observeEvent(input$tissue.select, {
query <- parseQueryString(session$clientData$url_search)
tissue <- query[['tissue']]
event <- query[['event']]
updateQueryString(
paste(
paste("?gene", input$gene.select, sep="="),
paste("tissue", input$tissue.select, sep="="),
paste("event", input$event.select, sep="="),
sep="&"
)
)
})
observeEvent(input$event.select, {
query <- parseQueryString(session$clientData$url_search)
tissue <- query[['tissue']]
event <- query[['event']]
updateQueryString(
paste(
paste("?gene", input$gene.select, sep="="),
paste("tissue", input$tissue.select, sep="="),
paste("event", input$event.select, sep="="),
sep="&"
)
)
})
# When a table row is selected, update query string and selectize inputs
observeEvent(input$hits.table_rows_selected, {
hits <- as.numeric(input$hits.table_rows_selected)
#hit <- hits[length(hits)]
hit <- hits[1]
gene <- dataTable.df[hit, "hgnc"]
gene.formatted <- hgnc2format(gene)
tissue <- dataTable.df[hit, "tissue"]
chrom <- dataTable.df[hit, "chrom"]
start <- dataTable.df[hit, "start"]
end <- dataTable.df[hit, "end"]
event <- paste("chr", chrom, ":", start, "-", end, sep="")
updateSelectizeInput(
session, 'gene.select', choices = gene.list,
selected = gene.formatted, server = TRUE
)
hgnc <- strsplit(gene.formatted, " ")[[1]][1]
ensgs <- hgnc2ensgs(hgnc)
gene_hits <- df[df$gene_id %in% ensgs,]
updateSelectizeInput(
session, "tissue.select", choices = sort(unique(gene_hits$tissue)),
selected = tissue
)
tissue_hits <- gene_hits[gene_hits$tissue == tissue,]
updateSelectizeInput(
session, "event.select", choices = sort(unique(gene_hits$event_coords)),
selected = event
)
})
## When a gene or tissue select is updated, update other selects accordingly
observeEvent(input$gene.select, {
gene <- input$gene.select
tissue <- input$tissue.select
event <- input$event.select
hgnc <- strsplit(gene, " ")[[1]][1]
ensgs <- hgnc2ensgs(hgnc)
gene_hits <- df[df$gene_id %in% ensgs,]
if (is.null(tissue) || tissue == '' ) {
tissue <- sort(unique(gene_hits$tissue))[1]
}
tissue_hits <- gene_hits[gene_hits$tissue == tissue,]
if (is.null(event) || event == '') {
event <- sort(unique(tissue_hits$event_coords))[1]
}
updateSelectizeInput(
session, "tissue.select", choices = sort(unique(gene_hits$tissue)),
selected = tissue
)
updateSelectizeInput(
session, "event.select", choices = sort(unique(tissue_hits$event_coords)), selected = event
)
})
observeEvent(input$tissue.select, {
gene <- input$gene.select
tissue <- input$tissue.select
event <- input$event.select
hgnc <- strsplit(input$gene.select, " ")[[1]][1]
ensgs <- hgnc2ensgs(hgnc)
gene_hits <- df[df$gene_id %in% ensgs,]
if (is.null(tissue) || tissue == '') {
tissue <- sort(unique(gene_hits$tissue))[1]
}
tissue_hits <- gene_hits[gene_hits$tissue == tissue,]
if (is.null(event) || event == '') {
event <- sort(unique(tissue_hits$event_coords))[1]
}
updateSelectizeInput(
session, "event.select",
choices = sort(unique(tissue_hits$event_coords)),
selected = event
)
})
output$boxplot <- renderImage({
# Don't make first plot until Go! is clicked
req(input$go.plot)
# Load data
gene_format <- input$gene.select
hgnc <- strsplit(gene_format, " ")[[1]][1]
ensgs <- hgnc2ensgs(hgnc)
tissue <- input$tissue.select
event <- input$event.select
chrom <- strsplit(event, ":")[[1]][1]
coords <- strsplit(event, ":")[[1]][2]
exon_start <- as.numeric(strsplit(coords, "-")[[1]][1])
exon_end <- as.numeric(strsplit(coords, "-")[[1]][2])
gene_hits <- df[df$gene_id %in% ensgs,]
tissue_hits <- gene_hits[gene_hits$tissue == tissue,]
event_hits <- tissue_hits[
(tissue_hits$chrom == chrom) &
(tissue_hits$exon_start == exon_start) &
(tissue_hits$exon_end == exon_end),
]
# Update tissue selections
#updateSelectizeInput(
# session, "tissue.select", choices = sort(unique(gene_hits$tissue))
#)
if (dim(event_hits)[1] >= 1) {
out.file <- paste(
plots.dir,
tissue,
"box_plots",
paste(
paste(
as.character(floor(-1 * log10(event_hits[1,"corrected_pval"]))),
event_hits[1,"chrom"],
as.character(event_hits[1,"exon_start"]),
as.character(event_hits[1,"exon_end"]),
event_hits[1,"assay_name"],
sep="_"
),
".boxplot.png",
sep=""
),
sep="/"
)
} else {
out.file <- hgnc
#out.file <- "/public/appdata/no_img_found.png"
}
list(src = out.file, contentType = 'image/png', width="49%", alt = out.file)
}, deleteFile = FALSE)
shinyApp(ui = ui, server = server)```