R:如何暂时禁用反应性？
我正在构建一个UI，其中包含DT表和滑块(两者都作为输入)以及绘图输出。这些表用于从几个表中进行选择。用户只能选择一个单元格进行选择。
我希望用户能够存储表和滑块的设置，因为它们是相当复杂的。例如，用户可以在两个存储的设置之间来回切换，并查看结果图是如何变化的。当用户恢复设置时，表格和滑块将更新，这将更新绘图。
问题是绘图不是更新一次，而是通常更新两次。似乎在逻辑中的某处有延迟，导致Shiny首先对滑块的更新做出反应，然后对表的更新做出反应，因此分两步重新绘制绘图。这是非常恼人的，原因有两个：(1)它导致计算重新运行两次，使应用程序的反应速度慢了一倍；(2)不可能直接在绘图中看到变化，因为原始绘图首先被一个对用户没有意义的中间绘图取代。
为了说明这个问题，我创建了这个最小的工作示例，其中我将复杂性降低到只有一个表和一个滑块。我添加了一个3秒的Sys.sleep来模拟一个很长的计算，因为很明显，如果不这样的话就看不到问题了：
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button", "Preset"),
# No problem with selectInput:
# selectInput("select", "x", choices = names(iris)[1:4], selected = "Sepal.Length"),
DT::dataTableOutput("table"),
sliderInput("slider", "bins", min = 1, max = 50, value = 30)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
observeEvent(input$button, {
# updateSelectInput(session, "select", selected = "Petal.Width")
selectRows(DT::dataTableProxy("table"), 4)
updateSliderInput(session, "slider", value = 15)
})
output$table <- DT::renderDataTable(
DT::datatable(
data.frame(x = names(iris)[1:4]),
rownames = FALSE,
selection = "single",
options = list(searching = FALSE, paging = FALSE, info = FALSE, ordering = FALSE)
)
)
output$distPlot <- renderPlot({
req(input$table_rows_selected)
# x <- iris[[input$select]]
x <- iris[[input$table_rows_selected]]
bins <- seq(min(x), max(x), length.out = input$slider + 1)
# Simulate long calculation:
Sys.sleep(3)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)首先单击表中的单元格"Sepal.Length“，然后单击按钮" preset”将加载预设并演示问题。
这似乎是一个计时问题/race condition，因为有时，它工作正常，绘图只更新一次(仅在最小的示例中，而不是实际的应用程序)。通常是在启动应用程序后的第一次。但在这种情况下，只需再次单击"Sepal.Length“并更改滑块位置，然后单击"Preset”按钮，通常绘图将更新两次。
我注意到，当我用selectInput替换该表时，问题并没有出现。但是这些表有一定的含义:它们代表形态字段(请参阅morphr包)，所以我宁愿坚持使用表以获得正确的外观。
显然，我也可以像这里建议的那样，使用isolate()禁用反应性：R Shiny: how to prevent duplicate plot update with nested selectors?，然后引入一个按钮"Update plot“。但我更喜欢让应用程序对滑块和表格的变化做出反应，因为这是一种非常有用的用户体验，也是我使用Shiny而不是PHP/python/等的原因之一。
我解决这个问题的第一个想法是引入一个反应值：
server <- function(input, output, session) {
updating <- reactiveVal(FALSE)
# ...
}然后在更新输入之前和之后更改该值：
observeEvent(input$button, {
updating(TRUE)
selectRows(DT::dataTableProxy("table"), 4)
updateSliderInput(session, "slider", value = 15)
updating(FALSE)
})并在renderPlot()代码中添加一条if语句，例如使用validate
output$distPlot <- renderPlot({
validate(need(!updating(), ""))
# ...
}) 但这没有效果，因为observeEvent(input$button)中的整个代码首先运行，将updating设置为TRUE，然后立即返回到FALSE。但是renderPlot()中的代码是稍后执行的(在失效发生之后)，并且updating在运行时始终为FALSE。
因此，目前我几乎不知道如何解决这个问题。如果能以某种方式禁用绘图的反应性，然后更新输入，再次启用反应性并以编程方式触发绘图更新，这将是最好的。但这是可能的吗？
还有其他解决办法的想法吗？
回答 1
Stack Overflow用户
发布于 2019-06-03 09:09:49
我不确定是否能理解这个问题。这是否解决了问题：
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
......
observeEvent(input$button, {
runjs("Shiny.setInputValue('slider', 15); Shiny.setInputValue('table_rows_selected', 4);")
selectRows(DT::dataTableProxy("table"), 4)
updateSliderInput(session, "slider", value = 15)
})https://stackoverflow.com/questions/53173871
复制相似问题
腾讯云开发者
