Question

我想使用Quarter列作为我的滑块，但是，我无法使用它，而不得不创建另一列QuarterInNum（这样我就可以获取输出，但是我想请参阅滑块名称以从“四分之一列”获取输入）。请帮助我将滑块输入更改为四分之一（FY17Q1，FY17Q2，......），而不是数字（1,2,3 ....）。这是一个工作示例：

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(ggplot2)

Quarter<- c("Fy17Q1",
            "Fy17Q1",
            "Fy17Q1",
            "Fy17Q2",
            "Fy17Q2",
            "Fy17Q2",
            "Fy17Q3",
            "Fy17Q3",
            "Fy17Q3",
            "Fy17Q4",
            "Fy17Q4",
            "Fy17Q4",
            "Fy18Q1",
            "Fy18Q1",
            "Fy18Q1",
            "Fy18Q2",
            "Fy18Q2",
            "Fy18Q2")

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

Freq <- c(517,
         63,
         1521,
         566,
         88,
         1655,
         636,
         80,
         1616,
         563,
         69,
         1528,
         555,
         61,
         1611,
         623,
         52,
         2085)

FreqbyPercent <- c(25,
                3,
                72,
                25,
                4,
                72,
                27,
                3,
                69,
                26,
                3,
                71,
                25,
                3,
                72,
                23,
                2,
                76)

QuarterInNum<- c(1,
                1,
                1,
                2,
                2,
                2,
                3,
                3,
                3,
                4,
                4,
                4,
                5,
                5,
                5,
                6,
                6,
                6)

File3<- data.frame(Quarter,RiskTierDesc,Freq,FreqbyPercent,QuarterInNum)

File3$RiskTierDesc = factor(File2$RiskTierDesc, levels=c("High", "Above Normal", "Normal"))


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

  dashboardSidebar(
    sidebarMenu(sliderTextInput("Quarter","Select Quarter:" ,
                                choices =  File3$QuarterInNum,#To not repeat values in the slidertextinput if the values are not sorted
                                selected =  File3$QuarterInNum, #values which will be selected by default
                                animate = FALSE, grid = FALSE,
                                hide_min_max = TRUE, from_fixed = FALSE,
                                to_fixed = FALSE, from_min = NULL, from_max = NULL, to_min = NULL,
                                to_max = NULL, force_edges = FALSE, width = NULL, pre = NULL,
                                post = NULL, dragRange = TRUE))),

  dashboardBody(
    fluidRow(
      box(solidHeader = TRUE 
          ,collapsible = TRUE,align="center",offset = 2,title = "RiskTier Vs Quater",status = "warning", plotOutput("k", height = "300px"),width = 6)
      ,      
      box(solidHeader = TRUE 
          ,collapsible = TRUE,align="center",offset = 4,title = "RiskTier Vs Quater(%)",status = "warning", plotOutput("l", height = "300px"),width = 6)
 )))



server <- function(input, output) { 
  dataInput <- reactive({
    test <- File3[File3$QuarterInNum %in% seq(from=min(input$Quarter),to=max(input$Quarter)),]
    #print(test)
    test
    })

  output$k<- renderPlot({


    ggplot(dataInput(), 
           aes(x=Quarter, y=Freq, group=RiskTierDesc, colour=RiskTierDesc)) + 
      geom_line(aes(size=RiskTierDesc)) +
      geom_point() + ylim(0,2500) +
      scale_color_manual(values=c("red","orange","green")) +
      scale_size_manual(values=c(1,1,1)) +
      labs( x = "Quarter", y = "Frequency") +
      geom_text(aes(label = Freq), position = position_dodge(0),vjust = -1) +
      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
  })

  output$l<- renderPlot({
    ggplot(dataInput(), 
           aes(x=Quarter, y=FreqbyPercent, group=RiskTierDesc, colour=RiskTierDesc)) + 
      geom_line(aes(size=RiskTierDesc)) +
      geom_point() + ylim(0,100) +
      scale_color_manual(values=c("red","orange","green")) +
      scale_size_manual(values=c(1,1,1)) +
      labs( x = "Quarter", y = "Frequency(%)") +
      geom_text(aes(label = FreqbyPercent), position = position_dodge(0),vjust = -1) +
      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
  })
}

shinyApp(ui, server)

Answer 1

正如Stéphane所建议的那样，您可以在choices中提供一个字符向量。然后，您可以更改dataInput表达式以将字符串转换为相应的数字四分之一。

我迅速进行了测试，这对我有用：

我使用字符串，而不是data.frame中的因子，在大多数情况下更合适。

File3 <- data.frame(Quarter,RiskTierDesc,Freq,FreqbyPercent,QuarterInNum,
                    stringsAsFactors = FALSE)

在ui中使用Quarter中的字符串。 selected中的初始选择必须是2，而不是全部。我使用“唯一”，这样它就不会重复“宿舍”

sliderTextInput("Quarter","Select Quarter:",
                 choices =  unique(File3$Quarter),
                 selected =  unique(File3$Quarter)[c(2, 5)]), 
    ## ... rest of the code

最后，在server中，选择与字符Quarter相匹配的数字Quarter。我认为可以更优雅地完成此操作，但是想出一个主意

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

如何使用字符变量作为我的过滤器？

1 个答案: