CODEWITHSUNDEEP
rshiny
J0HN_TIT0R
J0HN_TIT0R

Reputation: 323

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

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?

Upvotes: 1

Views: 1030

Answers (1)

lkq
lkq

Reputation: 2366

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)

Upvotes: 2

Related Questions