Не удается выбрать с помощью Selectinput в блестящей - PullRequest
0 голосов
/ 09 февраля 2019

Привет, я не могу понять, где я делаю ошибку, из приведенного ниже запроса, я получаю график для варианта "B", но когда я выбираю вариант "A", график не отображается.Я хочу построить первую часть из «l» и «k», когда я выбираю «A», но почему-то отсутствует «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 голосов
/ 09 февраля 2019

Несколько коротких идей: почему вы повторяете ок.одна и та же функция в четыре раза?как насчет написания функции?Насколько я вижу, только данные для оси 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]])
)}

Извините, немного быстро и грязно, возможно в этом есть некоторые ошибки.

0 голосов
/ 09 февраля 2019

Я думаю, что проблема здесь в том, что у вас разные средства визуализации, "названные" одинаково (т.е. вы создаете и вывод $ l, и вывод $ k дважды в коде сервера).Это может не сработать, потому что один собирается «замаскировать» другой, так как оба запускаются при изменении x().Чтобы это работало, вы должны переставить свой серверный код так, чтобы на графике был только один рендер.

Нечто подобное должно работать (хотя я не могу проверить, потому что у меня нет ваших данных - рассмотрите возможность всегда предоставлять воспроизводимый пример при публикации вопроса):


    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)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...