Question

我在论坛上使用我的工作程序，但测试它我注意到它工作得很糟糕。正如您在附加图像中看到的那样，设置的大小范围在表中显示不正确的字段。只有当我们选择＆＃34; 选择Cat 1 ＆＃34; as＆＃34; 所有＆＃34;尺寸范围很好。你能指出需要纠正的问题吗？

以下是代码：

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]))

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

列的显示

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

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

与

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

用于初始显示，在UI中，用于调试这些类型的事物。在应用程序中查看时，来回点击是一种痛苦。为什么不一次全部显示它们？

我希望这有帮助！

在sizeslider中设置范围：闪亮

1 个答案: