observeEvent() 中的嵌套 observeEvent() 执行过于频繁
Posted
技术标签:
【中文标题】observeEvent() 中的嵌套 observeEvent() 执行过于频繁【英文标题】：Nested observeEvent() in observeEvent() gets executed too often 【发布时间】：2017-08-03 12:43:45 【问题描述】：编辑最后的可重现示例。
我发现了与here 描述的类似问题，但使用reactive() 并不能解决我的问题。
我正在开发一个应用程序，用户可以使用FileInput 上传文件，到目前为止它可以处理 FASTQ 和 CSV 文件（此处关注 CSV）。所有上传的文件都保存为 RData，然后可以在 selectinput 中选择它们再次加载它们。这个selectinput 基本上运行所有东西，因为在评估之后它会触发一些反应式 UI 来显示 CSV。我在打印时还注意到，当我选择一个新文件然后选择行时，它仍然会打印前一个文件中的行。
我今年 1 月开始使用 Shiny，我首先按照 Shiny 页面上的教程进行操作，并且潜伏了几个博客和 *** 问题，所以我确信我在反应性和其他 Shiny 方面犯了很多错误具体的事情。
selectinput观察者：
observeEvent(input$selectfiles, ignoreInit = T,
if (!is.null(USER$Data))
if (nchar(input$selectfiles) > 1)
file <- paste0(input$selectfiles, ".RData")
# FASTQ
if (endsWith(input$selectfiles, ".fastq"))
source("LoadFastQ.R", local = T)
else
# CSV
source("LoadCSV.R", local = T)
# Force user to View tab once file is uploaded
updateTabsetPanel(session, "inTabset", selected = "DataView")
)
CSV 界面
output$CSV <- renderDataTable(
datatable(
CSV_table,
filter = list(position = 'top'),
class = 'cell-border strip hover',
options = list(
search = list(regex = TRUE, caseInsensitive = TRUE),
pageLength = 10
)
)
)
output$DataOutput <- renderUI(
fluidPage(
fluidRow(
column(4,
selectInput("CSV_identifier", "Identifier",
choices = c(colnames(CSV_table)),
selected = colnames(CSV_table)[1])
),
column(
12, offset = -1,
dataTableOutput("CSV")
)
),
actionButton("clustbutton", "Clustering"),
actionButton("corrbutton", "Correlation")
)
)
)
选择行：
observeEvent(input$CSV_rows_selected, ignoreInit = T,
print("### NEW SELECT ###")
print(input$CSV_rows_selected)
CSV_selected <<- CSV_table[input$CSV_rows_selected, input$CSV_identifier]
print(CSV_selected)
print(dim(CSV_table))
)
点击行时的输出：
**click**
[1] "### NEW SELECT ###"
[1] 1 # index of row in CSV
[1] "A" # value of index of row in CSV
[1] 22 1642 # dim(CSV)
**click**
[1] "### NEW SELECT ###"
[1] 1 2
[1] "A" "B"
[1] 22 1642
** Selecting new file **
**click**
[1] "### NEW SELECT ###"
[1] 1
[1] "A"
[1] 22 1642
[1] "### NEW SELECT ###"
[1] 1
[1] "X"
[1] 10 5
**click**
[1] "### NEW SELECT ###"
[1] 1 2
[1] "A" "B"
[1] 22 1642
[1] "### NEW SELECT ###"
[1] 1 2
[1] "X" "Y"
[1] 10 5
例子：
source("http://bioconductor.org/biocLite.R")
packages <-
c(
"shiny",
"DT",
"data.table",
"DESeq2",
"fpc",
"gplots",
"SCAN.UPC",
"digest",
"shinyBS",
"ggplot2",
"reshape",
"shinyjs",
"squash"
)
for (package in packages)
if (!package %in% installed.packages())
biocLite(package, ask = FALSE)
library(package, character.only = T)
rm(list=ls())
gc()
tableA <- data.frame(LETTERS[1:10], runif(10, 1, 100), stringsAsFactors = F)
tableB <- data.frame(LETTERS[11:20], runif(10, 1, 100), stringsAsFactors = F)
# Define UI for application that draws a histogram
ui <- navbarPage(
title = "TEST",
id = "inTabset",
# Tab 1 - Loading file
tabPanel(
title = "Load File",
value = "loadfile",
fluidRow(
useShinyjs(),
selectInput(
"selectfiles",
label = "Select loaded file",
multiple = F,
choices = c("tableA", "tableB"), selected = "tableA"
)
)
),
# Tab 2 - View Data
tabPanel(
title = "View",
value = "DataView",
useShinyjs(),
uiOutput("DataOutput")
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session)
# READ FILE AND RETURN DATA
observeEvent(input$selectfiles,
# CSV
CSV_table <- get(input$selectfiles)
output$CSV <- renderDataTable(
datatable(
CSV_table,
filter = list(position = 'top'),
class = 'cell-border strip hover',
options = list(
search = list(regex = TRUE, caseInsensitive = TRUE),
pageLength = 10
)
)
)
output$DataOutput <- renderUI(
fluidPage(
fluidRow(
column(4,
selectInput("CSV_identifier", "Identifier",
choices = c(colnames(CSV_table)),
selected = colnames(CSV_table)[1])
),
column(
12, offset = -1,
dataTableOutput("CSV")
)
),
fluidRow(
bsModal("clusterDESeqplotwindow", "DESeq clustering", trigger = "clusterDESeq", size = 'large',
plotOutput("clusterDESeqplot"),
downloadButton("clusterDESeqplotDownload")
),
bsModal("clusterUPCplotwindow", "UPC clustering", trigger = "clusterUPC", size = 'large',
plotOutput("clusterUPCplot"),
downloadButton("clusterUPCplotDownload")
),
bsModal("clustering", "Clustering", trigger = "clustbutton", size = "large",
fluidRow(
column(5,
textOutput("bsModal_selected_rows"),
br(),
htmlOutput("bsModal_Log")
),
column(6, offset = 1,
fileInput("metadata", "Add metadata"),
selectInput("CSV_clusterparam", "Select DE parameter", choices = c(colnames(CSV_table)), selected = c(colnames(CSV_table))[2])
)
,
div(id = "clusterButtons",
column(4, align="center",
actionButton("clusterUPC", "UPC"),
actionButton("clusterDESeq", "DESeq")
)
)
)
),
actionButton("clustbutton", "Clustering"),
actionButton("corrbutton", "Correlation")
)
)
)
observeEvent(input$CSV_rows_selected, ignoreInit = T,
print("### NEW SELECT ###")
print(input$CSV_rows_selected)
CSV_selected <<- CSV_table[input$CSV_rows_selected, input$CSV_identifier]
print(CSV_selected)
print(dim(CSV_table))
output$bsModal_selected_rows <- renderText(paste("Selected samples:", paste(CSV_selected, collapse = ", ")))
)
)
session$onSessionEnded(stopApp)
# Run the application
shinyApp(ui = ui, server = server)
【问题讨论】：
我认为你的意思是 datatables 标签或其他类似的东西，而不是 data.table 包的标签。 我正在使用 data.table 包，但足够公平。错误与包本身无关。 好的，由你决定。也许是相关的；我不知道有什么闪亮的，但我知道它支持一些数据表。 不，你是对的。我已经删除了标签。 为什么reactive()不解决您的问题？ （我认为确实如此:)）
【参考方案1】：
所以事实证明我完全想多了。
由于嵌套的 observe() 是问题所在，并尝试使用 reactive() 和 eventReactive() 修复它并且没有任何效果，我得出的结论是我应该从我的 LoadCSV.R 脚本中删除 observeEvent() 调用，带来在用于检查 selectinput() 元素的 observeEvent 之外进行观察。
现在一切都按预期工作了..
【讨论】：
以上是关于observeEvent() 中的嵌套 observeEvent() 执行过于频繁的主要内容，如果未能解决你的问题，请参考以下文章
如何从可反应中的单元格呈现按钮触发带有observeEvent的modalBox？
Shiny：Shiny Dashboard (sidebarMenu) 中的 renderMenu 和 observeEvent 冲突
无法使用 observeEvent 和 eventReactive 更新闪亮应用程序中的输入
R Shiny：在 ObserveEvent 中更新代理表列标题