How to wrap a function around a reactive expression in R Shiny? - r

Question

Minimal working example
Say I want to have a custom version of renderDataTable, which I shall name myRenderDataTable and works by wrapping around 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)
}
))
Issue
Unfortunately, it appears that myRenderDataTable is not reactive like renderDataTable. Clicking the Increase input button should cause the table values to change, but doesn't.
So what's going wrong?
Attempt: Passing calls to reactive:
Doing output$table1 <- reactive(myRenderDataTable(input$button))) leads to:
Error during wrapup: evaluation nested too deeply: infinite recursion / options(expressions=)?
Error : evaluation nested too deeply: infinite recursion / options(expressions=)?
Attempt: Passing calls to observe:
Doing observe(output$table1 <- myRenderDataTable(input$button)) had no effect on the issue

Answer 1

The problem is that input$button is evaluated "eagerly" - i.e. input$button + 1 evaluates to 2 to the first time it's run and then never changes again. You can make it evaluate every time input$button changes by explicitly making it a reactive:
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))
}
))

Answer 2

I think you're underestimating how much magic goes in in the render* functions. From looking at this example, I don't think you want a custom renderDataTable function, I think you want a custom function to build a table, which you can then pass to the built in renderDataTable. I think this does what you want, the wrapping is just in the opposite order (ie, a custom funciton inside a reactive expression):
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))
}
))