如何在 R Shiny 中围绕反应式表达式包装函数？

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

我认为您低估了 render* 函数中的魔力。从这个例子来看，我不认为你想要一个自定义renderDataTable函数，我认为你想要一个自定义函数来构建一个表，然后你可以将其传递给内置的renderDataTable. 我认为这符合您的要求，包装只是按照相反的顺序（即反应式表达式内的自定义函数）：

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