如何在R Shiny中使用renderUI触发renderDataTable进行输入?

时间:2018-03-02 18:02:07

标签: r shiny

我正在开发一个简单的应用程序,使用R Shiny将数据库数据显示为数据表。

从数据库查询的数据可能会发生变化,因此我希望为所存在的数据量身定制过滤输入选项,因此,我使用renderUI在服务器中生成UI。问题是来自renderUI的输入没有触发renderDataTable,因此在操作按钮触发renderDataTable之前它是空的。我想这样做,以便renderDataTable的输入触发renderDataTable。

作为一个例子,这是一个小应用程序,按我的意愿工作,但它的过滤输入是静态的,所以我不能使用它:

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
      ) 
    )

  })

}

以下是编辑使用renderUI生成过滤选项的相同应用程序,请注意在按下提交之前数据表是如何生成的:

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
      ) 
    )

  })

}

在提供动态过滤选项的同时,让第二个应用程序像第一个应用程序一样工作的最佳方法是什么?

1 个答案:

答案 0 :(得分:1)

只需按filtered_fish_click

初始化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)