Question

我无法在Shiny中迭代加载和过滤数据表。理想的工作流程如下：

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

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)

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

1 个答案: