Question

我正在构建一个包含DT表和滑块（均作为输入）以及图形输出的UI。这些表用于从多个表中进行选择。用户只能选择一个单元格进行选择。

我希望用户能够存储表格和滑块的设置，因为它们非常复杂。这个想法是，例如，用户可以在两个存储的设置之间来回切换，并查看结果图如何变化。当用户还原设置时，表格和滑块会更新，从而更新绘图。

问题在于情节不会更新一次，而是通常更新两次。似乎在逻辑中存在某个延迟，这导致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”单元格，然后单击“预设”按钮，将加载预设并演示问题。

这似乎是一个时间问题/ race condition，因为有时它可以正常运行，并且绘图仅更新一次（仅在最小示例中，而不是实际应用中）。通常是在启动应用程序后的第一次。但是在这种情况下，只需再次单击“ Sepal.Length”并更改滑块位置，然后单击“ Preset”按钮，通常该图将更新两次。

我注意到当我用selectInput替换表时，该问题没有出现。但是表格具有一定的含义：它们代表形态字段（请参见软件包morphr），因此我宁愿坚持使用表格以使其外观正确。

我也可以使用isolate()明显地禁用反应性，如下所示：R Shiny: how to prevent duplicate plot update with nested selectors?，然后例如引入一个按钮“更新图”。但是我宁愿让应用程序对滑块和表中的更改保持反应，因为这是非常有用的用户体验，也是我使用Shiny而不是PHP / python / etc的原因之一。

我解决该问题的第一个想法是引入反应性值：

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)
})

，然后在if代码中添加renderPlot()语句，例如与validate：

output$distPlot <- renderPlot({
  validate(need(!updating(), ""))
  # ...
})

但这没有效果，因为observeEvent(input$button)中的整个代码首先运行，将updating设置为TRUE，然后立即返回到FALSE。但是renderPlot()中的代码是稍后执行的（在发生无效之后），并且updating在运行时始终为FALSE。

因此，目前我对如何解决此问题尚不了解。最好是可以以某种方式禁用绘图的反应性，然后更新输入，再次启用反应性并以编程方式触发绘图更新。但这有可能吗？

还有其他解决方法吗？

Answer 1

我不确定该问题。这样可以解决问题吗？

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)
  })

R闪亮：如何暂时停用反应性？

1 个答案: