需要帮助滑块才能在Shiny App中工作

时间:2019-04-30 10:08:04

标签: r shiny

大家好我创建了一个闪亮的小应用程序,并且在FY Quarter使用滑块。但是当我尝试使用滑块时遇到错误时。

我正在使用反应式来更新滑块,但是却收到错误消息。 警告:seq.default中的错误:“ from”必须为有限数字

数据部分

Quarter <- c("Fy17Q1","Fy17Q1","Fy17Q1","Fy17Q2","Fy17Q2","Fy17Q2","Fy17Q3","Fy17Q3","Fy17Q3","Fy17Q4","Fy17Q4","Fy17Q4","Fy18Q1","Fy18Q1","Fy18Q1","Fy18Q2","Fy18Q2","Fy18Q2","Fy18Q3","Fy18Q3","Fy18Q3","Fy18Q4","Fy18Q4","Fy18Q4","Fy19Q1","Fy19Q1","Fy19Q1")
QuarterInNum <- c(1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6,6,6,7,7,7,8,8,8,9,9,9)
RiskTierDesc <- c("Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal")
Freq <- c(447,52,1161,470,87,1277,556,69,1284,471,61,1195,481,46,1247,519,46,1641,598,61,1591,556,56,1451,478,41,1617)
FreqPercent <- c(27,3,70,26,5,70,29,4,67,27,4,69,27,3,70,24,2,74,27,3,71,27,3,70,22,2,76)

Data <- data.frame(Quarter,QuarterInNum,RiskTierDesc,Freq,FreqPercent)

UI部分


library(shiny)
require(shinydashboard)
library(dplyr)
library(shinyWidgets)


ui <- dashboardPage(
  dashboardHeader(title = "Basic Dashboard"),

  dashboardSidebar(
    sidebarMenu( 
    sliderTextInput("Quarter","Select Quarter:",
                    choices =  c("FY17Q1","FY17Q2","FY17Q3","FY17Q4","FY18Q1","FY18Q2"),
                    selected =  c("FY17Q2","FY18Q1")))),

  dashboardBody(
    fluidRow(
      tableOutput('table')

    )))

服务器部分

server <- function(input, output) {


  dataInput <- reactive({
    #dataframe <- GroupFreq
    qfrom <- Data$QuarterInNum[match(input$Quarter[1], Data$Quarter)]
    qto <- Data$QuarterInNum[match(input$Quarter[2], Data$Quarter)]
    test <- Data[Data$QuarterInNum %in% seq(from=qfrom,to=qto),]
    #print(test)
    test()
  })

  output$table <- renderTable(dataInput())
  #output$table <- renderTable(Data) # to test if i am getting the table 

}


runApp(shinyApp(ui, server),launch.browser = TRUE)

我的预期结果是获取我在滑块中选择的季度的表。

请告知我是否还有其他详细信息。谢谢

1 个答案:

答案 0 :(得分:0)

我发现了几件事:

  1. 您的数据框具有“ Fy ...”格式的四分之一,而范围选择器具有“ FY ...”格式的四分之一。

  2. 您的代码正在将四分之一字段的数字因子级别与范围选择器中的文本进行比较。

这两个问题结合在一起导致了您的问题。更新的代码:

library(shiny)
require(shinydashboard)
library(dplyr)
library(shinyWidgets)

Quarter <- c("Fy17Q1","Fy17Q1","Fy17Q1","Fy17Q2","Fy17Q2","Fy17Q2","Fy17Q3","Fy17Q3","Fy17Q3","Fy17Q4","Fy17Q4","Fy17Q4","Fy18Q1","Fy18Q1","Fy18Q1","Fy18Q2","Fy18Q2","Fy18Q2","Fy18Q3","Fy18Q3","Fy18Q3","Fy18Q4","Fy18Q4","Fy18Q4","Fy19Q1","Fy19Q1","Fy19Q1")
QuarterInNum <- c(1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6,6,6,7,7,7,8,8,8,9,9,9)
RiskTierDesc <- c("Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal","Above Normal","High","Normal")
Freq <- c(447,52,1161,470,87,1277,556,69,1284,471,61,1195,481,46,1247,519,46,1641,598,61,1591,556,56,1451,478,41,1617)
FreqPercent <- c(27,3,70,26,5,70,29,4,67,27,4,69,27,3,70,24,2,74,27,3,71,27,3,70,22,2,76)

Data <- data.frame(Quarter,QuarterInNum,RiskTierDesc,Freq,FreqPercent)


ui <- dashboardPage(
  dashboardHeader(title = "Basic Dashboard"),

  dashboardSidebar(
    sidebarMenu( 
      sliderTextInput("Quarter","Select Quarter:",
                      choices =   c("Fy17Q1","Fy17Q2","Fy17Q3","Fy17Q4","Fy18Q1","Fy18Q2"),
                      selected =  c("Fy17Q2","Fy18Q1")))),

  dashboardBody(
    fluidRow(
      tableOutput('table')

    )))

server <- function(input, output) {


  dataInput <- reactive({
    #dataframe <- GroupFreq
    qfrom <- Data$QuarterInNum[match(input$Quarter[1], as.character(Data$Quarter))]
    qto <- Data$QuarterInNum[match(input$Quarter[2], as.character(Data$Quarter))]
    test <- Data[Data$QuarterInNum %in% seq(from=qfrom,to=qto),]
    print(test)
    #test()
  })

  output$table <- renderTable(dataInput())
  #output$table <- renderTable(Data) # to test if i am getting the table 

}

runApp(shinyApp(ui, server),launch.browser = TRUE)