在 sizeslider 中设置范围：Shiny

Question

我在论坛上的工作程序中使用，但测试它我发现它工作得不好。正如您在附图中看到的那样，设置的大小范围在表中显示不正确的字段。只有当我们选择“Choose Cat 1”作为“all”尺寸范围时才能正常工作。你能指出需要纠正的地方吗？

下面是代码：

library(shiny) 
data.input <- data.frame(
  Category1 = rep(letters[1:3],each=15),
  Info = paste("Text info", 1:45),
  Category2 = sample(letters[15:20], 45, replace = T),
  Size = sample(1:100, 45),
  MoreStuff = paste("More Stuff", 1:45)
)
ui <- fluidPage(titlePanel("Test Explorer"),
                sidebarLayout(
                  sidebarPanel(
                    selectizeInput(
                      "show_vars",
                      "Columns to show:",
                      choices = colnames(data.input),
                      multiple = TRUE,
                      selected = c("Category1", "Info", "Category2")
                    ),
                    actionButton("button", "An action button"),
                    uiOutput("category1"),
                    uiOutput("category2"),
                    uiOutput("sizeslider")
                  ),
                  mainPanel(tableOutput("table"))
                ))

server <- function(input, output, session) {
  data.react <- eventReactive(input$button, {
    data.input[, input$show_vars]
  })
  observeEvent(input$button, {
    output$category1 <- renderUI({
      data.sel <- data.react()
      selectizeInput('cat1',
                     'Choose Cat 1',
                     choices = c("All", sort(as.character(
                       unique(data.sel$Category1)
                     ))),
                     selected = "All")
    })

    df_subset <- eventReactive(input$cat1, {
      data.sel <- data.react()
      if (input$cat1 == "All") {
        data.sel
      }
      else{
        data.sel[data.sel$Category1 == input$cat1,]
      }
    })

    output$category2 <- renderUI({
      selectizeInput(
        'cat2',
        'Choose Cat 2 (optional):',
        choices = sort(as.character(unique(
          df_subset()$Category2
        ))),
        multiple = TRUE,
        options = NULL
      )
    })

    df_subset1 <- reactive({
      if (is.null(input$cat2)) {
        df_subset()
      } else {
        df_subset()[df_subset()$Category2 %in% input$cat2,]
      }
    })

    output$sizeslider <- renderUI({
      sliderInput(
        "size",
        label = "Size Range",
        min = min(data.input$Size),
        max = max(data.input$Size),
        value = c(min(data.input$Size), max(data.input$Size))
      )
    })

    df_subset2 <- reactive({
      if (is.null(input$size)) {
        df_subset1()
      } else {
        df_subset1()[data.input$Size >= input$size[1] &
                       data.input$Size <= input$size[2],]
      }
    })
    output$table <- renderTable({
      df_subset2()

    })
  })
}

shinyApp(ui, server)

Answer 1

经过一番调试，你会发现

df_subset2 <- reactive({
  if (is.null(input$size)) {
    df_subset1()
  } else {
    df_subset1()[data.input$Size >= input$size[1] &
                   data.input$Size <= input$size[2],]
  }

应该是

df_subset2 <- reactive({
  if (is.null(input$size)) {
    df_subset1()
  } else {
    df_subset1()[df_subset1()$Size >= input$size[1] &
                  df_subset1()$Size <= input$size[2],]
  }

由于您指的是data.input 不是 data_subset1()，因此您在条件语句中指定了错误的子集条件。

---

---

其他一些 [不太重要的] 说明

---

• dplyr

我会尝试替换下面的语句

df_subset1()[data.input$Size >= input$size[1] &
                   data.input$Size <= input$size[2],]

与

df_subset1()%>% filter(between(Size, input$size[1], input$size[2]))

因为可读性。许多过滤条件可以通过dplyr 包中的filter() 替换。它看起来更好。

---

• 列的显示

请考虑（这只是一个建议，不是那么重要）替换

selected = c("Category1", "Info", "Category2")

与

selected = c("Category1", "Info", "Category2", "Size")

用于初始显示，在 UI 中，用于调试这些东西。在应用程序中查看时来回单击有点痛苦。为什么不一次全部显示？

我希望这会有所帮助！