1

Estou desenvolvendo um app em shiny que o usuário sobe uma planilha e é calculada algumas estatísticas daquela base. Gostaria de que no momento que a base estiver sendo lida, não eqnuanto estiver no upload, (arquivo em excel), o app mostrasse alguma mensagem de 'ainda trabalhando' para que não parecesse que travou. Tentei trabalhar com o options(readxl.show_progress = T) do pacote read_excel e o resultado do interactive() é TRUE. Postei o código completo, por não saber exatamente qual parte postar.

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)
2
  • 1
    Dá uma olhada no pacote shinyhttr. A ideia dele é essa. Commented 23/09/2019 às 16:22
  • Obrigado pela dica, acabaei não usando este pacote, mas me ajudou na pesquisa. Commented 23/09/2019 às 17:56

1 Resposta 1

1

Com o a função withProgress do pacote Shiny ela gera uma barra de 'loading'. Não está exatamente do jeito que eu queria, mas já satisfaz por hora.

output$contents <- renderTable({

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

No stackoverflow da gringa já tinha essa pergunta: https://stackoverflow.com/questions/44043475/adjust-size-of-shiny-progress-bar-and-

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .