Ggplot2 在闪亮的应用程序中显示错误消息

Question

Please I am trying to convert the graphs in my shiny app into ggplot2 graphs. I use a reactive function to generate the values of financial ratios, which are plotted in bar graphs and pie charts, eg Profit/Turnover. When you load the app, by default, each input field (profit input fields and turnover input fields) contains values, whose ratios are plotted in the graphs. The ggplot2 graph displays when the app is loaded. But, when I clear an input field, say in profit, so that I can enter a new value, I get the following error message in my console:

Warning in profit/turnover :

  longer object length is not a multiple of shorter object length

Warning: Error in data.frame: arguments imply differing number of rows: 5, 4

  131: stop

  130: data.frame

  129: <reactive:profitability.df> [C:\Users\Idiaye\Documents\R data\mavisanalytic/app.R#446]

  113: profitability.df

   99: renderPlotly [C:\Users\Idiaye\Documents\R data\mavisanalytic/app.R#451]

   98: func

   95: func

   82: origRenderFunc

   81: output$bar

    1: shiny::runApp

The app is designed to compute and plot financial ratios over just five years; hence five data input fields each for profit and turnover. Nevertheless, I want a user to be able to analyse financial performance over any number of years they choose. But, when an input field is cleared, I get the above error message. I didn't experience this problem prior to converting my plots to ggplot2. Below is my reproducible code:

library(shiny)
library(ggplot2)
library(plotly)

ui<-navbarPage(
    windowTitle="Reprex",fluid=TRUE, title=strong("Reprex"),
    tabPanel(title="Reprex App",
        sidebarLayout(
            sidebarPanel(width=2,
                actionButton("delete",strong("Clear Fields"),icon=icon("broom")),br(),br(),  
                textInput("pro","Profit 1",value="100000",width=150),
                textInput("prof","Profit 2",value="150000",width=150),
                textInput("profs","Profit 3",value="200000",width=150),
                textInput("profit","Profit 4",value="250000",width=150),
                textInput("profits","Profit 5",value="300000",width=150),
                hr(),
                h4(strong("Turnover figures:")),
                actionButton("remove",strong("Clear Fields"),icon=icon("broom")),br(),br(),
                textInput("turn","Turnover 1",value="350000",width=150),
                textInput("turno","Turnover 2",value="300000",width=150),
                textInput("turnov","Turnover 3",value="420000",width=150),
                textInput("turnover","Turnover 4",value="600000",width=150),
                textInput("turnovers","Turnover 5",value="550000",width=150),
                actionButton("go",strong("Calculate Ratio"),icon=icon("caret-right"))
                
            ),mainPanel(
                plotlyOutput("plot")
            )
        )
    )
)

server<-function(input,output,session){
    
    observeEvent(input$delete,{
        
        updateTextInput(session,"pro",value="",placeholder="0")
        updateTextInput(session,"prof",value="",placeholder="0")
        updateTextInput(session,"profs",value="",placeholder="0")
        updateTextInput(session,"profit",value="",placeholder="0")
        updateTextInput(session,"profits",value="",placeholder="0")
    })
    
    
    observeEvent(input$remove,{
        
        updateTextInput(session,"turn",value="",placeholder="0")
        updateTextInput(session,"turno",value="",placeholder="0")
        updateTextInput(session,"turnov",value="",placeholder="0")
        updateTextInput(session,"turnover",value="",placeholder="0")
        updateTextInput(session,"turnovers",value="",placeholder="0")
    })
    
    profits<-reactive({
        as.numeric(c(
            if(input$pro>0){input$pro},
            if(input$prof>0){input$prof},
            if(input$profs>0){input$profs},
            if(input$profit>0){input$profit},
            if(input$profits>0){input$profits}
        ))
    })
    
    turnover<-reactive({
        as.numeric(c(
            if(input$turn>0){input$turn},
            if(input$turno>0){input$turno},
            if(input$turnov>0){input$turnov},
            if(input$turnover>0){input$turnover},
            if(input$turnovers>0){input$turnovers}
        ))
    })
    
    year<-reactive({
        c(
            if(input$pro>0){"Year 1"},
            if(input$prof>0){"Year 2"},
            if(input$profs>0){"Year 3"},
            if(input$profit>0){"Year 4"},
            if(input$profits>0){"Year 5"}
        )
    })
    profit.ratio<-function(profits,turnover){
        profitability<-round(profits/turnover*100,1)
        return(profitability)
    }
  profitability<-reactive({profit.ratio(profits(),turnover())}) 
  
  
  
  profit.df<-reactive({data.frame(profitability(),year())})
  
  output$plot<-renderPlotly({
      input$go
      isolate(profit.df()%>%
          ggplot()+aes(x=year(),y=profitability(),fill=year())+geom_bar(stat="identity")+
          labs(x="Years",y="Profitability ratios (%)",fill="Years")+scale_fill_brewer(palette="Set1")+
              geom_text(label=profitability(),position=position_stack(vjust=0.8)))
  })
}
shinyApp(ui=ui,server=server)

Thanks in anticipation of your suggestions.

Answer 1

You can use req to make sure that all input fulfill the conditions needed for further processing.
This will avoid the warning message in the console.

Try:

 profits<-reactive({
    req(input$pro>0,
        input$prof>0,
        input$profs>0,
        input$profit>0,
        input$profits>0)
    
    as.numeric(c(input$pro,
                 input$prof,
                 input$profs,
                 input$profit,
                 input$profits
    ))
})

Another option is to use validate in order to display an useful information message as long as the conditions aren't met:

  profits<-reactive({
    validate(need(input$pro>0 &
                  input$prof>0 &
                  input$profs>0 &
                  input$profit>0 &
                  input$profits>0,'Please fill all coefs'))
    
    as.numeric(c(input$pro,
                 input$prof,
                 input$profs,
                 input$profit,
                 input$profits
    ))
  })

Answer 2

You were not handling the missing values when you cleared the profits or turnover. I created a new reactive dataframe where it is easier to check if all fields are missing for profit or turnover. Try this code.

ui<-navbarPage(
  windowTitle="Reprex",fluid=TRUE, title=strong("Reprex"),
  tabPanel(title="Reprex App",
           sidebarLayout(
             sidebarPanel(width=2,
                          actionButton("delete",strong("Clear Fields"),icon=icon("broom")),br(),br(),  
                          textInput("pro","Profit 1",value="100000",width=150),
                          textInput("prof","Profit 2",value="150000",width=150),
                          textInput("profs","Profit 3",value="200000",width=150),
                          textInput("profit","Profit 4",value="250000",width=150),
                          textInput("profits","Profit 5",value="300000",width=150),
                          hr(),
                          h4(strong("Turnover figures:")),
                          actionButton("remove",strong("Clear Fields"),icon=icon("broom")),br(),br(),
                          textInput("turn","Turnover 1",value="350000",width=150),
                          textInput("turno","Turnover 2",value="300000",width=150),
                          textInput("turnov","Turnover 3",value="420000",width=150),
                          textInput("turnover","Turnover 4",value="600000",width=150),
                          textInput("turnovers","Turnover 5",value="550000",width=150),
                          actionButton("go",strong("Calculate Ratio"),icon=icon("caret-right"))
                          
             ),mainPanel(
               plotlyOutput("plot")
             )
           )
  )
)

server<-function(input,output,session){
  
  DF1 <- reactiveValues(data=NULL)
  
  observeEvent(input$delete,{
    
    updateTextInput(session,"pro",value="",placeholder="0")
    updateTextInput(session,"prof",value="",placeholder="0")
    updateTextInput(session,"profs",value="",placeholder="0")
    updateTextInput(session,"profit",value="",placeholder="0")
    updateTextInput(session,"profits",value="",placeholder="0")
  })
  
  observeEvent(input$remove,{
    
    updateTextInput(session,"turn",value="",placeholder="0")
    updateTextInput(session,"turno",value="",placeholder="0")
    updateTextInput(session,"turnov",value="",placeholder="0")
    updateTextInput(session,"turnover",value="",placeholder="0")
    updateTextInput(session,"turnovers",value="",placeholder="0")
  })

  
  findata <- reactive({
    years <- c("Year 1", "Year 2", "Year 3", "Year 4", "Year 5")
    profits <- c(input$pro, input$prof, input$profs, input$profit, input$profits)
    turnovers <- c(input$turn,input$turno,input$turnov,input$turnover,input$turnovers)
    fdata <- data.frame(profitability=c(),year=c())
    chkp <- sum(is.na(as.numeric(profits)))
    chkt <- sum(is.na(as.numeric(turnovers)))
    if (chkp==5 | chkt==5) {
      fdata <- NULL
    }else{
      lapply(1:5, function(i){
        if (!is.null(profits[i]) & !is.null(turnovers[i]) ) {
          if (profits[i]>0 & turnovers[i]>0) {
            pfy <- round(as.numeric(profits[i])/as.numeric(turnovers[i])*100,1)
            fdata <<- rbind(fdata,data.frame(profitability=pfy,year=years[i]))
          }
          
        }
        
      })
    }
    
    fdata
  })
  
  observe({DF1$data <- findata()})
  
  #observeEvent(input$go, {
    output$plot<-renderPlotly({
      input$go
     
      df <- DF1$data
      
      chkpfy <- sum(is.na(as.numeric(df$profitability)))
      if (is.null(df)) return(NULL)
      if (chkpfy==5) { 
        return(NULL)
      }else{
        p <-  ggplot(data=df, aes(x=year, y=profitability, fill=year )) +
          geom_bar(stat="identity") +
          labs(x="Years",y="Profitability ratios (%)",fill="Years") +
          scale_fill_brewer(palette="Set1") +
          geom_text(label=df$profitability, position=position_stack(vjust=0.8))
                        
        ggplotly(p)
      }
      
    })
  #})

}
shinyApp(ui=ui,server=server)

output