迭代加载和过滤表 [R] [Shiny]

Question

我在 Shiny 中迭代加载和过滤数据表时遇到问题。理想的工作流程如下：

1. 用户按下按钮确认加载数据
2. 从 MySql 查询中检索数据。请注意，这应该只发生一次
3. （可选）过滤器按钮/滑块变得可见/可用
4. 用户与按钮/滑块交互以过滤数据表

1 和 2 工作正常，但我对 4 有特别的问题（也可以为 3 提供任何输入）。

不工作的初始代码如下：

get_data=function(){ # note that this is for sample purpose, real function is MySQL query
  df=data.frame(x=1:10,Age=1:100)
  print("loading data...")
return(df)
}

ui = bootstrapPage(
  fluidPage(
    fluidRow(
      actionButton(
        inputId = "confirm_button",
        label = "Confirm"
      )
    )
    ,
    fluidRow(
      column(4,

             sliderInput("slider_age", label = h4("Age"), min = 0, 
                         max = 100, value = c(0, 100))
      )
    ),

    hr(),

    fluidRow(
      DT::dataTableOutput("all_background_table") 
    )
  )
)

server = function(input, output){


observeEvent(input$confirm_button, {

  req(input$confirm_button) 


  output$all_background_table <- DT::renderDataTable({

    all_background=get_data() # <- MySQL function to laod data

    # if all_background filter function put here: 
    #--> data is re-loaded by MySQL query

    # if all_background filter function is put here surrounded by observeEvent(input$slider_age, {...:
    #--> there is no change when input$slider_age is changed

    datatable(all_background,
              rownames = FALSE,
              style = "bootstrap")

  })  


})

  observeEvent(input$slider_age, {
    ## this will throw an error requiring all_background
    #--> Error in observeEventHandler: object 'all_background' not found

    req(input$confirmation_load_pts)  

    all_background=all_background[(all_background$Age > as.numeric(input$slider_age[1]) &  all_background$Age < as.numeric(input$slider_age[2])),]

  })

}  

shinyApp(ui, server)

Answer 1

我不确定 get_data()，但我将使用 df 使其更容易。使用eventReactive，您可以在使用滑块并单击确认按钮后创建新数据框。在这种情况下，您的 observeEvent 将不是必需的。

library(shiny)
library(DT)
get_data=function(){ # note that this is for sample purpose, real function is MySQL query
  df=data.frame(x=1:10,Age=1:100)
  print("loading data...")
return(df)
}
ui = bootstrapPage(
  fluidPage(
    fluidRow(
      actionButton(
        inputId = "confirm_button",
        label = "Confirm"
      )
    )
    ,
    fluidRow(
      column(4,

             sliderInput("slider_age", label = h4("Age"), min = 0, 
                         max = 100, value = c(0, 100))
      )
    ),

    hr(),

    fluidRow(
      DT::dataTableOutput("all_background_table") 
    )
  )
)

server = function(input, output){

  test <- eventReactive(input$confirm_button, {
    df=get_data()


  })  

  observeEvent(input$confirm_button, {

    output$all_background_table <- DT::renderDataTable({
      df=test() 

      all_background2=df[(df$Age > as.numeric(input$slider_age[1]) &  df$Age < as.numeric(input$slider_age[2])),]


      datatable(all_background2,
                rownames = FALSE,
                style = "bootstrap")

    })  


  })

}  

shinyApp(ui, server)