如何使用Shiny中的文本输入来更新滑块范围? (当前返回错误:结果的长度必须为10,而不是0)

时间:2019-08-09 13:34:51

标签: r shiny dplyr slider

我正在创建一个闪亮的应用程序来分析数据库中的数据。我已经设置了一个滑动条来选择值的范围,并且还具有两个输入框来调整滑动条上的范围。

在下面的简化代码中,滑块工作正常,但是当您尝试通过输入数字来更新滑块时,出现以下错误:

Error: Result must have length 10, not 0

滑块本身仍然可以正常工作,并且可以与selectInput协同工作,但是一旦您尝试将数字输入到min或max并点击update时,它就会返回此错误。

在网上看似乎dplyr / filter()可能有问题,但是我找不到真正的解决方案,所以我不确定这是否真的是问题所在。

下面是一些带有伪数据的简化代码。对于滑块,我正在使用此处找到的代码来更新值:R shiny - Combine the slider bar with a text input to make the slider bar more user-friendly

library(shiny)
library(ggplot2)
library(readxl)
library(DT)
library(dplyr)

#Fake Data
 MSGRAIN <- data.frame("Year" = c(2018,2018,2018,2017,2016,2010,2010,2000,2000,2000), 
                       "SiteNameNew" = c('A','B','B','B','C','C','C','C','D','D'), 
                       "RiverMile" = 550:559)


ui <- fluidPage(
  # Selection Bar
  fluidRow(

    #Select by River Mile (Manual Input)
    column(5,
           controlledSliderUI('RiverMile')
           ),
    #Select By Site
    column(5,
           selectInput("SiteNameNew",
                       "Site Name:",
                       c("All", unique(as.character(MSGRAIN$SiteNameNew))
                         )
                       )
           ),
    column(6,h4(textOutput('test'))
           ),

    #Create a new row for the table
    DT::dataTableOutput("table")
    )
  )


server <- function(input, output, session) {
  range <- callModule(controlledSlider, "RiverMile", 550, 559, c(550,559)
  )
  range$max <- 559

  # Current Year
  cyear <- as.numeric(format(Sys.Date(), "%Y"))

  # Output to show if selected area has been tested in the last 5 years
  output$test <- renderText({
    data <- MSGRAIN %>%
      filter(SiteNameNew == input$SiteNameNew,
             RiverMile >= range$min,
             RiverMile <= range$max

      )

    if (max(data$Year) >= cyear-5){
      "This site has been tested in the last 5 years."
    } else if (max(data$Year) <= cyear-5){
      "This site has not been tested in the last 5 years."
    } else {
      "Cannot Determine"
    }
  })

  output$table <- DT::renderDataTable(DT::datatable({
    data <- MSGRAIN

    # Sorts data based on Site Name selected
    if (input$SiteNameNew !="All"){
      data <- data[data$SiteNameNew == input$SiteNameNew,]
    }
    # Sorts data based on River Mile selected
    if (range !="All"){
      data <- data[data$RiverMile >= range$min & data$RiverMile <= range$max,]
    }

    # Show Data Table
    data
    })
    )
}


# Run the application 
shinyApp(ui = ui, server = server)

我认为这可能是链接中的代码+导致问题的代码的组合,但我是新手,并不十分确定哪里出了问题。我对observeEvent代码如何工作来更新我的滑块只有一个大致的了解。

0 个答案:

没有答案