迭代加载和过滤table[R][闪亮]

Question

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

用户按下按钮确认加载数据
从 MySql 查询中检索数据。请注意，这应该只发生一次
（可选）过滤器 buttons/sliders 变为 visible/available
用户与 buttons/sliders 交互以过滤数据表

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)

迭代加载和过滤table[R][闪亮]

Iteratively loading and filtering table [R] [Shiny]

r

shiny

shinydashboard