Base Reading Step Bar

Question

I am developing an app in Shiny that the user climbs a spreadsheet and is calculated some statistics from that base. I would like the moment the database is being read, not displayed in the upload, (excel file), the app shows some message 'still working' so it doesn’t look like it crashed. I tried to work with the options(readxl.show_progress = T) package read_excel and the outcome of interactive() is TRUE. I posted the full code, because I don’t know exactly which part to post.

library(shiny)

# Define UI for data upload app ----
ui <- fluidPage(

  # App title ----
  titlePanel("Critica da Base de Inativos"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      # Input: Select a file ----
      fileInput("file1", "Escolha a Base de Inativos",
                multiple = FALSE),

      # Linha Horizontal
      tags$hr(),

      #Entrada de Parametro Para os Testes
      textInput("enteAnalise", "Ente em Analise"),

      textInput("UF", "UF"),

      textInput("salMin", "Salario Minimo"),

      textInput("tetoINSS", "Teto INSS"),

      textInput("dataBase", "Ultimo dia do Mes da Competencia das Bases"),

      textInput("dataFocal", "Ultimo dia do Ano de Referencia das Bases"),

      actionButton("btStats", "Gerar Estatisticas"),

      tags$hr()



    ),

    # Main panel for displaying outputs ----
    mainPanel(

      # Output: Data file ----
      tableOutput("contents")

    )

  )
)

# Define server logic to read selected file ----
options(shiny.maxRequestSize = 60*1024^2)

server <- function(input, output) {

  library(dplyr)
  library(lubridate)
  library(readxl)
  library(stringr)
  library(knitr)
  library(progress)

  geraStats <- eventReactive(input$btStats,{

    lct <- Sys.getlocale("LC_TIME")
    Sys.setlocale("LC_TIME", lct)

    tryCatch(
      {
        options(readxl.show_progress = T)
        baseDeDados2 <- read_excel(input$file1$datapath, col_types = "text", progress = readxl_progress())
        baseDeDados2 <- as.data.frame(baseDeDados2)
      },
      error = function(e) {
        # return a safeError if a parsing error occurs
        stop(safeError(e))
      }
    )

    salMin <- input$salMin
    dataMesAvaliacao <- input$dataBase
    tetoINSS <- input$tetoINSS
    dataFocal <- input$dataFocal
    dataMesAvaliacao <- input$dataBase

    baseEstatistica <- data.frame()

    format_real <- function(values, nsmall = 0) {
      values %>%
        as.numeric() %>%
        format(nsmall = nsmall, decimal.mark = ",", big.mark = ".") %>%
        str_trim() %>%
        str_c("R$ ", .)
    }

    baseEstatistica[1,1] <- "Ente em Analise"
    baseEstatistica[1,2] <- input$enteAnalise
    #----------------------------------------
    baseEstatistica[2,1] <- "UF"
    baseEstatistica[2,2] <- input$UF
    #----------------------------------------
    baseEstatistica[3,1] <- "Orgao"
    baseEstatistica[3,2] <- case_when(baseDeDados2[1,7] == "1" ~ "Executivo",
                                      baseDeDados2[1,7] == "2" ~ "Legislativo",
                                      baseDeDados2[1,7] == "3" ~ "Judiciario",
                                      baseDeDados2[1,7] == "4" ~ "Ministerio Publico",
                                      baseDeDados2[1,7] == "5" ~ "Tribunal de COntas")
    #----------------------------------------
    baseEstatistica[4,1] <- "Data da Base de Dados"
    baseEstatistica[4,2] <- dataMesAvaliacao
    #----------------------------------------
    baseEstatistica[5,1] <- "Plano:"
    baseEstatistica[5,2] <- ifelse(baseDeDados2[1,4] == "1","Previdenciario","Financeiro")
    #----------------------------------------
    baseEstatistica[6,1] <- "Data da Avaliacao:"
    baseEstatistica[6,2] <- Sys.Date()
    #----------------------------------------
    baseEstatistica[7,1] <- "Valor Salario Minimo:"
    baseEstatistica[7,2] <- format_real(salMin)
    #----------------------------------------
    baseEstatistica[8,1] <- "Valor da Folha:"
    baseEstatistica[8,2] <- format_real(sum(as.numeric(baseDeDados2[,20])))
    #----------------------------------------
    baseEstatistica[9,1] <- "Quantitativo:"
    baseEstatistica[9,2] <- format(NROW(baseDeDados2), big.mark = ".", decimal.mark = ",")
    #----------------------------------------
    baseEstatistica[10,1] <- "Beneficio Medio:"
    baseEstatistica[10,2] <- format_real(mean(as.numeric(baseDeDados2[,20])))
    #----------------------------------------
    baseEstatistica[11,1] <- "Quantidade Homens:"
    baseEstatistica[11,2] <- format(sum(baseDeDados2[,15] == "2"), big.mark = ".", decimal.mark = ",")
    #----------------------------------------
    baseEstatistica[12,1] <- "Quantidade Mulheres:"
    baseEstatistica[12,2] <- format(sum(baseDeDados2[,15] == "1"), big.mark = ".", decimal.mark = ",")

    baseEstatistica[13,1] <- interactive()

    names(baseEstatistica) <- c("Estatisticas","Valores")

    baseEstatistica
  })

  output$contents <- renderTable({
    geraStats()

  })

}

# Create Shiny app ----
shinyApp(ui, server)

Answer 1

With the function withProgress package Shiny it generates a loading bar. It’s not exactly the way I wanted it, but it already satisfies by the hour.

output$contents <- renderTable({

    withProgress(message = "Gerando Estatisticas", value = 0,{
                   incProgress(1, detail= "Pode demorar um pouco...")
                   geraStats()
                 }
              )
  })

In the stackoverflow of the gringa already had this question: https://stackoverflow.com/questions/44043475/adjust-size-of-shiny-progress-bar-and-