在sizeslider中设置范围:闪亮

问题描述 投票:0回答:1

我在论坛上使用我的工作程序,但测试它我发现它工作得很糟糕。正如您在附加图像中看到的那样,设置的大小范围在表中显示不正确的字段。只有当我们选择“选择猫1”作为“全部”尺寸范围才能正常工作。你能指出需要纠正的问题吗?

enter image description here

以下是代码:

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)
r dataframe shiny
1个回答
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中,用于调试这些类型的东西。在应用程序中查看时,来回点击是一种痛苦。为什么不一次全部显示它们?

我希望这有帮助!

© www.soinside.com 2019 - 2024. All rights reserved.