Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

Tags:

r

shiny

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

like image 944
mchen Avatar asked Sep 30 '22 22:09

mchen


1 Answers

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))
  }
))
like image 148
hadley Avatar answered Oct 03 '22 15:10

hadley