无法选择使用Selectinput闪亮

时间:2019-02-09 16:17:07

标签: r shiny

嗨,我无法从下面的查询中弄明白我在哪里出错,我正在为选项“ B”获得图,但是当我选择选项“ A”时,没有图显示。当我选择“ A”时,我想从“ l”和“ k”中绘制第一部分,但是不知何故它缺少“ A”,并且可以与“ B”一起工作。 需要一些帮助。

library(shinydashboard)
library(shiny)
library(shinyWidgets)
library(ggplot2)
## test data
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(502,62,1452,549,88,1582,617,80,1578,530,68,1455,536,61,1551,600,52,2038) 
FreqbyPercent <- c(25,3,72,25,4,71,27,4,69,26,3,71,25,3,72,22,2,76)
QuarterInNum<- c(1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6,6,6) 
TotalNRinM <- c(33.044,0,56.459,18.089,0.234,39.774,99.451,20.608,86.166,257.532,
                3.93,336.079,493.464,7.952,298.565,661.728,189.184,1172.245) 
TotalNRinMPercent <- c(37,0,63,31,0,68,48,10,42,43,1,56,62,1,37,33,9,58) 
File2<- data.frame(Quarter,RiskTierDesc,Freq,FreqbyPercent,QuarterInNum,TotalNRinM,
                   TotalNRinMPercent) 
File2$RiskTierDesc = factor(File2$RiskTierDesc, levels=c("High", "Above Normal", "Normal"))


#========================================UI=============================================================#

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

  dashboardSidebar(
                   sidebarMenu( selectInput("app", 
                                         "Select App:", 
                                         choices = c("","A","B"), 
                                         selected = "A", 
                                         multiple = FALSE)),
                             sliderTextInput("Quarter","Select Quarter:",
                                              choices =  unique(File2$Quarter),
                                              selected =  unique(File2$Quarter)[c(2, 5)])),     

  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=======================================================#

server <- function(input, output) {

  dataInput <- reactive({

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

  x<-reactive({input$app})


  output$k<- renderPlot({
    if (x()=="A"){
    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({
    if (x()=="A"){
    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())}})




  output$k<- renderPlot({
    if (x()=="B"){
      ggplot(dataInput(), 
             aes(x=Quarter, y=TotalNRinM, 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 = TotalNRinM), position = position_dodge(0),vjust = -1) +
        theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
  }})

  output$l<- renderPlot({
    if (x()=="B"){ggplot(dataInput(), 
             aes(x=Quarter, y=TotalNRinMPercent, 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 = TotalNRinMPercent), position = position_dodge(0),vjust = -1) +
        theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())}})

}

shinyApp(ui, server)

2 个答案:

答案 0 :(得分:0)

我认为这里的问题是,您以相同的方式为不同的渲染器“命名”(即,在服务器代码中同时创建了output $ l和output $ k 两次)。这是行不通的,因为一个人要“掩盖”另一个人,因为在x()更改时都会触发这两者。为了使这项工作有效,您应该重新排列服务器代码,以使每个绘图仅具有一个渲染器。

类似的事情应该起作用(尽管我无法测试,因为我没有您的数据-请在发布问题时始终提供reproducible example):


    server <- function(input, output) {

      dataInput <- reactive({

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

      x<-reactive({input$app})

     output$k<- renderPlot({
        if (x() == "A"){
          plotvar <- "Freq" 
        } else {
          plotvar <- "TotalNRinM" 
        }
        data_toplot <- dataInput()
        names(data_toplot)[names(data_toplot) == plotvar] <- "plotvar"
        ggplot(data_toplot, 
               aes(x=Quarter, y=plotvar, 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 = plotvar), position = position_dodge(0),vjust = -1) +
          theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
      })

      output$l<- renderPlot({
        if (x() =="A"){
          plotvar <- "FreqbyPercent" 
        } else {
          plotvar <- "TotalNRinMPercent" 
        }
        data_toplot <- dataInput()
        names(data_toplot)[names(data_toplot) == plotvar] <- "plotvar"
        ggplot(data_toplot, 
               aes(x=Quarter, y=plotvar, 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 = plotvar), position = position_dodge(0),vjust = -1) +
          theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
      })
    }

    shinyApp(ui, server)

答案 1 :(得分:0)

一些简短的想法: 你为什么要重复大约。相同功能四次? 写一个函数是什么?据我所知,只有y轴的数据不同。 进行反应,改变y轴的值并将其传递给函数。

yaxis <- reactive({
             if (input$app == "A")
                    x <- list("Freq","FreqbyPercent") 
             else if (input$yearset == "B")
                     x <- list("TotalNR","TotalNRinMPercent")
    })




plotter<- function(df,xname,yname){
x_var <- enquo(xname)
y_var <- enquo(yname)
ggplot(df, 
      aes(x=x_var, y=y_var, 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 = TotalNRinMPercent), position =position_dodge(0),vjust = -1) +
 theme(panel.grid.major = element_blank(), panel.grid.minor=element_blank())}}) }

然后将其命名为您的。

renderPlot{(
 plotter(dataInput(),quarter,x[[1]])
)}

对不起,有点麻烦和肮脏,也许其中有一些错误。