r - 如何在 R Shiny 中围绕响应式(Reactive)表达式包装函数？

Question

最小的工作示例

假设我想要一个自定义版本的 renderDataTable ，我将命名为 myRenderDataTable并通过环绕 renderDataTable 来工作:

library(shiny)
runApp(list(
    ui = basicPage(
        actionButton("button", "Increase input"),
        tabsetPanel(
            tabPanel("table1", shiny::dataTableOutput("table1")),
            tabPanel("table2", shiny::dataTableOutput("table2")),
            tabPanel("table3", shiny::dataTableOutput("table3"))
        )
    ),
    server = function(input, output) {
        myRenderDataTable <- function(a) {
            renderDataTable(
                data.frame(x = a, y = a^2, z = a^3),
                options = list(bPaginate = as.logical(a %% 2))
            )
        }
        output$table1 <- myRenderDataTable(input$button)
        output$table2 <- myRenderDataTable(input$button + 1)
        output$table3 <- myRenderDataTable(input$button + 2)
    }
))

问题

不幸的是， myRenderDataTable不像 renderDataTable 那样具有反应性.点击 Increase input按钮应该会导致表格值发生变化，但不会。

那么出了什么问题呢？

尝试:将调用传递给 reactive :

做 output$table1 <- reactive(myRenderDataTable(input$button)) ) 导致:

Error during wrapup: evaluation nested too deeply: infinite recursion / options(expressions=)?
Error : evaluation nested too deeply: infinite recursion / options(expressions=)?

尝试:将调用传递给 observe :

做 observe(output$table1 <- myRenderDataTable(input$button))对这个问题没有影响

Answer 1

问题是 input$button被“急切地”评估 - 即 input$button + 1第一次运行时评估为 2，然后不再更改。你可以让它每次评估input$button通过显式使其具有反应性来进行更改:

library(shiny)
runApp(list(
  ui = basicPage(
    actionButton("button", "Increase input"),
    tabsetPanel(
      tabPanel("table1", shiny::dataTableOutput("table1")),
      tabPanel("table2", shiny::dataTableOutput("table2")),
      tabPanel("table3", shiny::dataTableOutput("table3"))
    )
  ),
  server = function(input, output) {
    myRenderDataTable <- function(a) {
      renderDataTable(
        data.frame(x = a(), y = a()^2, z = a()^3),
        options = list(bPaginate = as.logical(a() %% 2))
      )
    }
    output$table1 <- myRenderDataTable(reactive(input$button))
    output$table2 <- myRenderDataTable(reactive(input$button + 1))
    output$table3 <- myRenderDataTable(reactive(input$button + 2))
  }
))