无法让过滤器选择滑块点之间的值

Question

我正在尝试在 R Shiny 中创建一个数据表，在其中我可以使用一些下拉列表和具有最小值和最大值的 sliderInput 来过滤数据框。我还希望在选择比赛 ID 列时对马匹列进行过滤，并具有根据需要选择或取消选择马匹的功能。我之前创建了数据表和其他侧边栏输入，但 race_distance_furlongs 下拉列表除外，它缺少半值（我可以选择 16、17，但不能选择 16.5 或 17.5）。因此，我决定使用滑块，但添加此滑块后，数据无法正确过滤。阅读完这里的帖子后，我已经考虑了很多不同的选择，但没有运气。

ui <- fluidPage(
  titlePanel("Race Dashboard"),
  sidebarLayout(
    sidebarPanel(
      pickerInput("race_ID", "Race ID", order(sort(unique(NH_shiny$race_ID))), options = list(`actions-box` = TRUE)),
      sliderInput("race_distance_furlongs", "Distance",min = distance_range[1], max = distance_range[2],value = distance_range,step = 0.5),
      pickerInput("going", "Going", multiple = TRUE, choices = sort(unique(NH_shiny$going)), options = list(`actions-box` = TRUE)),
      pickerInput("racecourse", "Racecourse", multiple = TRUE, sort(unique(NH_shiny$racecourse)), options = list(`actions-box` = TRUE)),
      pickerInput("horse", "Horse", multiple = TRUE, choices = sort(unique(NH_shiny$horse)), options = list(`actions-box` = TRUE)),
      pickerInput("race_class", "Class", multiple = TRUE, choices = sort(unique(NH_shiny$race_class)), options = list(`actions-box` = TRUE)),
      pickerInput("hurdle_or_chase", "Race type", multiple = TRUE, choices = sort(unique(NH_shiny$hurdle_or_chase)), options = list(`actions-box` = TRUE))
    ),
    mainPanel(
      tableOutput("raceTable")
    )
  )
)

server <- function(input, output) {
    output$raceTable <- renderTable({
      filtered_data <- NH_shiny
    
      if (!is.null(input$race_ID)) {
      filtered_data <- filtered_data[filtered_data$race_ID %in% input$race_ID, ]
      
      # Update the horse filter based on the selected race_ID
      updateSelectInput(inputId = "horse", choices = unique(filtered_data$horse))
    }
    
    if (!is.null(input$going)) {
      filtered_data <- filtered_data[filtered_data$going %in% input$going, ]
    }
    
    if (!is.null(input$racecourse)) {
      filtered_data <- filtered_data[filtered_data$racecourse %in% input$racecourse, ]
    }
    
    if (!is.null(input$horse)) {
      filtered_data <- filtered_data[filtered_data$horse %in% input$horse, ]
    }
    
    if (!is.null(input$race_class)) {
      filtered_data <- filtered_data[filtered_data$race_class %in% input$race_class, ]
    }
    
    if (!is.null(input$hurdle_or_chase)) {
      filtered_data <- filtered_data[filtered_data$hurdle_or_chase %in% input$hurdle_or_chase, ]
    }
   
    if (!is.null(input$race_distance_furlongs)) {
      filtered_data <- filtered_data[filtered_data$race_distance_furlongs %in% input$race_distance_furlongs, ]
    }
      filtered_data <- filter(filtered_data,race_distance_furlongs >= input$race_distance_furlongs[1] & race_distance_furlongs <= input$race_distance_furlongs[2])
  })
    
}

shinyApp(ui = ui, server = server)

Answer 1

我现在已经解决了这个问题。下面的服务器代码让它工作：

  output$raceTable <- renderTable({
    filtered_data <- NH_shiny
    
    if (!is.null(input$race_ID)) {
      filtered_data <- filtered_data[filtered_data$race_ID %in% input$race_ID, ]
      
      # Update the horse filter based on the selected race_ID
      updateSelectInput(inputId = "horse", choices = unique(filtered_data$horse))
    }
    
    if (!is.null(input$going)) {
      filtered_data <- filtered_data[filtered_data$going %in% input$going, ]
    }
    
    if (!is.null(input$racecourse)) {
      filtered_data <- filtered_data[filtered_data$racecourse %in% input$racecourse, ]
    }
    
    if (!is.null(input$horse)) {
      filtered_data <- filtered_data[filtered_data$horse %in% input$horse, ]
    }
    
    if (!is.null(input$race_class)) {
      filtered_data <- filtered_data[filtered_data$race_class %in% input$race_class, ]
    }
    
    if (!is.null(input$hurdle_or_chase)) {
      filtered_data <- filtered_data[filtered_data$hurdle_or_chase %in% input$hurdle_or_chase, ]
    }
    
    # Use the sliderInput to filter the data based on the selected range of "race_distance_furlongs"
    if (!is.null(input$race_distance_furlongs)) {
      filtered_data <- filtered_data[filtered_data$race_distance_furlongs >= input$race_distance_furlongs[1] & 
                                       filtered_data$race_distance_furlongs <= input$race_distance_furlongs[2], ]
    }
    
    return(filtered_data)
  })
}