How to make input from renderUI trigger renderDataTable in R Shiny?

Question

I'm developing a simple app to display database data as a data table using R Shiny.

The data queried from the database can change, thus I'd like to have filtering input options tailored to the data present, thus, I'm generating the UI in the server using renderUI. The issue is that the input from renderUI is not triggering renderDataTable, thus it is empty until renderDataTable is triggered by an action button. I'd like to make it so that the input from renderDataTable triggers renderDataTable.

As an example, this is a small app that works as I want it to, but it the input for filtering is static, so I can't use it:

ui <- fluidPage(

  sidebarLayout(
    sidebarPanel(
      selectInput(
        "fish_taste", "Please select fish taste:",
        choices  = c("good", "bad"),
        selected = c("good", "bad"),
        multiple = TRUE
      ),
      actionButton("submit", "Submit")
    ),
    mainPanel(
      DT::dataTableOutput("dt")
    ))

)

server <- function(input, output) {

  data <- data.frame(fish = c("jellyfish", "tuna", "salmon", "magikarp"),
                    cost = c("$", "$$$", "$$", "$"),
                    taste = c("bad", "good", "good", "bad"))

  filtered_fish <- reactive({
    data[ data$taste %in% input$fish_taste, ]
  })

  filtered_fish_click <- reactiveVal(
    value = isolate(filtered_fish())
  )

  observeEvent(input$submit, {
    filtered_fish_click( filtered_fish() )
  })


  output$dt <- DT::renderDataTable({

    datatable(
      filtered_fish_click(),
      rownames = FALSE,
      options = list(
        pageLength = 100,
        lengthChange = FALSE
      ) 
    )

  })

}

The following is the same app edited to use renderUI to generate filtering options, notice how the data table isn't generated until submit is pressed:

ui <- fluidPage(

  sidebarLayout(
    sidebarPanel(
      uiOutput("fish_taste"),
      actionButton("submit", "Submit")
    ),
    mainPanel(
      DT::dataTableOutput("dt")
    ))

)

server <- function(input, output) {

  data <- data.frame(fish = c("jellyfish", "tuna", "salmon", "magikarp"),
                    cost = c("$", "$$$", "$$", "$"),
                    taste = c("bad", "good", "good", "bad"))

  output$fish_taste = renderUI({
    fish_taste_choices <- sort(unique(data$taste), decreasing = TRUE)
    fish_taste_choices_initial <- fish_taste_choices

    selectInput(
      "fish_taste", "Please select fish taste:",
      choices  = fish_taste_choices,
      selected = fish_taste_choices_initial,
      multiple = TRUE
    )
  })

  filtered_fish <- reactive({
    data[ data$taste %in% input$fish_taste, ]
  })

  filtered_fish_click <- reactiveVal(
    value = isolate(filtered_fish())
  )

  observeEvent(input$submit, {
    filtered_fish_click( filtered_fish() )
  })


  output$dt <- DT::renderDataTable({

    datatable(
      filtered_fish_click(),
      rownames = FALSE,
      options = list(
        pageLength = 100,
        lengthChange = FALSE
      ) 
    )

  })

}

What would be the best way to make the second app work like the first one while providing dynamic filtering options?

lkq · Accepted Answer · 2018-03-02 19:45:29Z

2

Just initialize filtered_fish_click by data

ui <- fluidPage(

  sidebarLayout(
    sidebarPanel(
      uiOutput("fish_taste"),
      actionButton("submit", "Submit")
    ),
    mainPanel(
      DT::dataTableOutput("dt")
    ))

)

server <- function(input, output) {

  data <- data.frame(fish = c("jellyfish", "tuna", "salmon", "magikarp"),
                     cost = c("$", "$$$", "$$", "$"),
                     taste = c("bad", "good", "good", "bad"))

  output$fish_taste = renderUI({
    fish_taste_choices <- sort(unique(data$taste), decreasing = TRUE)
    fish_taste_choices_initial <- fish_taste_choices

    selectInput(
      "fish_taste", "Please select fish taste:",
      choices  = fish_taste_choices,
      selected = fish_taste_choices_initial,
      multiple = TRUE
    )
  })

  filtered_fish <- reactive({
    data[ data$taste %in% input$fish_taste, ]
  })

  filtered_fish_click <- reactiveVal(
    value = isolate(data)
  )

  observeEvent(input$submit, {
    filtered_fish_click( filtered_fish() )
  })


  output$dt <- DT::renderDataTable({

    DT::datatable(
      filtered_fish_click(),
      rownames = FALSE,
      options = list(
        pageLength = 100,
        lengthChange = FALSE
      ) 
    )

  })

}
shinyApp(ui, server)

answered Mar 2, 2018 at 19:45

lkq

2,3861 gold badge14 silver badges22 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

J0HN_TIT0R Over a year ago

Thanks, this answer is does exactly what I asked for. However, it 's static, and if I altered the value of fish_taste_choices_initial in the server, for instance, I defaulted to selecting only "good", the data table displayed on loading wouldn't reflect the default filter. Do you have any idea how I could apply the filter before I display the data table?

lkq Over a year ago

Just filter data using your initial filters as a new variable and pass this new variable in the place I changed.

Collectives™ on Stack Overflow

How to make input from renderUI trigger renderDataTable in R Shiny?

1 Answer 1

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related