R/app_server.R

Defines functions app_server

#' The application server-side
#'
#' @param input,output,session Internal parameters for {shiny}.
#'     DO NOT REMOVE.
#' @import shiny
#' @import DT
#' @import magrittr
#' @import purrr
#' @import tidyr
#' @import dplyr
#' @import stringr
#' @import lubridate
#' @import DBI
#' @import RMySQL
#' @import writexl
#' @noRd
app_server <- function( input, output, session ) {
  # List the first level callModules here

  competencia_in <- eventReactive(input$doGR,{return(input$competencia)})

  regiao_in <- eventReactive(input$doGR,{return(regiao$regiao_id[regiao$regiao%in%input$regiao] )})
  uf_in <- eventReactive(input$doGR,{return(uf$uf_id[uf$uf%in%input$uf] )})
  municipio_in <- eventReactive(input$doGR,{return(municipio$municipio_id[municipio$municipio%in%input$municipio] )})
  fonte_in <- eventReactive(input$doGR,{return(fonte$fonte_id[fonte$fonte%in%input$fonte] )})
  secao_in <- eventReactive(input$doGR,{return(secao$secao_id[secao$secao%in%input$secao] )})
  subclasse_in <- eventReactive(input$doGR,{return(subclasse$subclasse_id[subclasse$subclasse%in%input$subclasse] )})
  cbo2002ocupacao_in <- eventReactive(input$doGR,{return(cbo2002ocupacao$cbo2002ocupacao_id[cbo2002ocupacao$cbo2002ocupacao%in%input$cbo2002ocupacao] )})
  categoria_in <- eventReactive(input$doGR,{return(categoria$categoria_id[categoria$categoria%in%input$categoria] )})
  graudeinstrucao_in <- eventReactive(input$doGR,{return(graudeinstrucao$graudeinstrucao_id[graudeinstrucao$graudeinstrucao%in%input$graudeinstrucao] )})
  racacor_in <- eventReactive(input$doGR,{return(racacor$racacor_id[racacor$racacor%in%input$racacor] )})
  sexo_in <- eventReactive(input$doGR,{return(sexo$sexo_id[sexo$sexo%in%input$sexo] )})
  tipoempregador_in <- eventReactive(input$doGR,{return(tipoempregador$tipoempregador_id[tipoempregador$tipoempregador%in%input$tipoempregador] )})
  tipodedeficiencia_in <- eventReactive(input$doGR,{return(tipodedeficiencia$tipodedeficiencia_id[tipodedeficiencia$tipodedeficiencia%in%input$tipodedeficiencia] )})
  tamestabjan_in <- eventReactive(input$doGR,{return(tamestabjan$tamestabjan_id[tamestabjan$tamestabjan%in%input$tamestabjan] )})
  indtrabintermitente_in <- eventReactive(input$doGR,{return(indtrabintermitente$indtrabintermitente_id[indtrabintermitente$indtrabintermitente%in%input$indtrabintermitente] )})
  indtrabparcial_in <- eventReactive(input$doGR,{return(indtrabparcial$indtrabparcial_id[indtrabparcial$indtrabparcial%in%input$indtrabparcial] )})
  indicadoraprendiz_in <- eventReactive(input$doGR,{return(indicadoraprendiz$indicadoraprendiz_id[indicadoraprendiz$indicadoraprendiz%in%input$indicadoraprendiz] )})

  salMin <- eventReactive(input$doGR,{input$salMin})
  salMax <- eventReactive(input$doGR,{input$salMax})
  idadeMin <- eventReactive(input$doGR,{input$idadeMin})
  idadeMax <- eventReactive(input$doGR,{input$idadeMax})

  horascontratuaisMin <- eventReactive(input$doGR,{input$horascontratuaisMin})
  horascontratuaisMax <- eventReactive(input$doGR,{input$horascontratuaisMax})
  #tempoempregoMin <- eventReactive(input$doGR,{input$tempoempregoMin})
  #tempoempregoMax <- eventReactive(input$doGR,{input$tempoempregoMax})


  stats <- eventReactive(input$doGR,{
    descritivas %>%
      filter(stats %in% input$descritiva_id) %>%
      select(sql) %>%
      as_vector() %>%
      unname()%>%
      paste(collapse = ",")


    })


  vari <-eventReactive(input$doGR,{
    vars_sel <- base_vars$vars_id[base_vars$vars %in% input$group_id]

    c("saldomovimentacao_id",vars_sel) %>% # vari
      paste(collapse = ",")
  })


  base <- eventReactive(input$doGR,{
    vars_sel <- vari()
    stats_sel <- stats()

    estatisticas_sel <- stats() %>%
      paste(collapse = ",")

    # Competêcia
    if(length(competencia_in())==0 | length(competencia_in()) == length(competencia_id)){
      competencia_sel <- ""
    }else{
      ids <- paste0(competencia_in(),collapse = ",")
      competencia_sel <- paste0("competencia_id IN (", ids, ") AND") #
    }

    # Região
    if(length(regiao_in())==0 | length(regiao_in()) == length(regiao$regiao_id)){
      regiao_sel <- ""
    }else{
      ids <- paste0(regiao_in(),collapse = ",")
      regiao_sel <- paste0("regiao_id IN (", ids, ") AND") #
    }

    # UF
    if(length(uf_in())==0 | length(uf_in()) == length(uf$uf_id)){
      uf_sel <- ""
    }else{
      ids <- paste0(uf_in(),collapse = ",")
      uf_sel <- paste0("uf_id IN (", ids, ") AND") #
    }

    # municipio
    if(length(municipio_in())==0 | length(municipio_in()) == length(municipio$municipio_id)){
      municipio_sel <- ""
    }else{
      ids <- paste0(municipio_in(),collapse = ",")
      municipio_sel <- paste0("municipio_id IN (", ids, ") AND") #
    }

    # fonte
    if(length(fonte_in())==0 | length(fonte_in()) == length(fonte$fonte_id)){
      fonte_sel <- ""
    }else{
      ids <- paste0(fonte_in(),collapse = ",")
      fonte_sel <- paste0("fonte_id IN (", ids, ") AND") #
    }

    # secao
    if(length(secao_in())==0 | length(secao_in()) == length(secao$secao_id)){
      secao_sel <- ""
    }else{
      ids <- paste0("'",secao_in(),"'") %>% paste0(collapse = ",")
      secao_sel <- paste0("secao_id IN (", ids, ") AND") #
    }

    # subclasse
    if(length(subclasse_in())==0 | length(subclasse_in()) == length(subclasse$subclasse_id)){
      subclasse_sel <- ""
    }else{
      ids <- paste0(subclasse_in(),collapse = ",")
      subclasse_sel <- paste0("subclasse_id IN (", ids, ") AND") #
    }

    # cbo2002ocupacao
    if(length(cbo2002ocupacao_in())==0 | length(cbo2002ocupacao_in()) == length(cbo2002ocupacao$cbo2002ocupacao_id)){
      cbo2002ocupacao_sel <- ""
    }else{
      ids <- paste0(cbo2002ocupacao_in(),collapse = ",")
      cbo2002ocupacao_sel <- paste0("cbo2002ocupacao_id IN (", ids, ") AND") #
    }

    # categoria
    if(length(categoria_in())==0 | length(categoria_in()) == length(categoria$categoria_id)){
      categoria_sel <- ""
    }else{
      ids <- paste0(categoria_in(),collapse = ",")
      categoria_sel <- paste0("categoria_id IN (", ids, ") AND") #
    }

    # graudeinstrucao
    if(length(graudeinstrucao_in())==0 | length(graudeinstrucao_in()) == length(graudeinstrucao$graudeinstrucao_id)){
      graudeinstrucao_sel <- ""
    }else{
      ids <- paste0(graudeinstrucao_in(),collapse = ",")
      graudeinstrucao_sel <- paste0("graudeinstrucao_id IN (", ids, ") AND") #
    }

    # racacor
    if(length(racacor_in())==0 | length(racacor_in()) == length(racacor$racacor_id)){
      racacor_sel <- ""
    }else{
      ids <- paste0(racacor_in(),collapse = ",")
      racacor_sel <- paste0("racacor_id IN (", ids, ") AND") #
    }

    # sexo
    if(length(sexo_in())==0 | length(sexo_in()) == length(sexo$sexo_id)){
      sexo_sel <- ""
    }else{
      ids <- paste0(sexo_in(),collapse = ",")
      sexo_sel <- paste0("sexo_id IN (", ids, ") AND") #
    }

    # tipoempregador
    if(length(tipoempregador_in())==0 | length(tipoempregador_in()) == length(tipoempregador$tipoempregador_id)){
      tipoempregador_sel <- ""
    }else{
      ids <- paste0(tipoempregador_in(),collapse = ",")
      tipoempregador_sel <- paste0("tipoempregador_id IN (", ids, ") AND") #
    }

    # tipodedeficiencia
    if(length(tipodedeficiencia_in())==0 | length(tipodedeficiencia_in()) == length(tipodedeficiencia$tipodedeficiencia_id)){
      tipodedeficiencia_sel <- ""
    }else{
      ids <- paste0(tipodedeficiencia_in(),collapse = ",")
      tipodedeficiencia_sel <- paste0("tipodedeficiencia_id IN (", ids, ") AND") #
    }

    # tamestabjan
    if(length(tamestabjan_in())==0 | length(tamestabjan_in()) == length(tamestabjan$tamestabjan_id)){
      tamestabjan_sel <- ""
    }else{
      ids <- paste0(tamestabjan_in(),collapse = ",")
      tamestabjan_sel <- paste0("tamestabjan_id IN (", ids, ") AND") #
    }

    # indtrabintermitente
    if(length(indtrabintermitente_in())==0 | length(indtrabintermitente_in()) == length(indtrabintermitente$indtrabintermitente_id)){
      indtrabintermitente_sel <- ""
    }else{
      ids <- paste0(indtrabintermitente_in(),collapse = ",")
      indtrabintermitente_sel <- paste0("indtrabintermitente_id IN (", ids, ") AND") #
    }

    # indtrabparcial
    if(length(indtrabparcial_in())==0 | length(indtrabparcial_in()) == length(indtrabparcial$indtrabparcial_id)){
      indtrabparcial_sel <- ""
    }else{
      ids <- paste0(indtrabparcial_in(),collapse = ",")
      indtrabparcial_sel <- paste0("indtrabparcial_id IN (", ids, ") AND") #
    }

    # indicadoraprendiz
    if(length(indicadoraprendiz_in())==0 | length(indicadoraprendiz_in()) == length(indicadoraprendiz$indicadoraprendiz_id)){
      indicadoraprendiz_sel <- ""
    }else{
      ids <- paste0(indicadoraprendiz_in(),collapse = ",")
      indicadoraprendiz_sel <- paste0("indicadoraprendiz_id IN (", ids, ")") #
    }

    # salario
    if(salMin()==0 & salMax()==10^6){
      salario_sel <- ""
    }else{
      salario_sel <- paste0("salario >= ",salMin()," AND salario <= (",salMax(), ") AND") #
    }

    # idade
    if(idadeMin()==0 & idadeMax()==120){
      idade_sel <- ""
    }else{
      idade_sel <- paste0("idade >= ",idadeMin()," AND idade <= (",idadeMax(), ") AND") #
    }

    # horas contratuais
    if(horascontratuaisMin()==0 & horascontratuaisMax()==99){
      horascontratuais_sel <- ""
    }else{
      horascontratuais_sel <- paste0("horascontratuais >= ",horascontratuaisMin()," AND horascontratuais <= (",horascontratuaisMax(), ") AND") #
    }

    # tempo emprego
    # if(tempoempregoMin()==0 & tempoempregoMax()==50000){
    #   tempoemprego_sel <- ""
    # }else{
    #   tempoemprego_sel <- paste0("tempoemprego >= ",tempoempregoMin()," AND tempoemprego <= (",tempoempregoMax(), ") AND") #
    # }



    query_select <- "select vars_sel, stats_sel from temporario.caged" %>%
      str_replace("vars_sel",vars_sel) %>%
      str_replace("stats_sel",stats_sel)
      print(query_select)
    query_groupby <- "group by vars_sel" %>%
      str_replace("vars_sel",vars_sel)

    query_where <- "where" %>%
      paste(competencia_sel)%>%
      paste(regiao_sel)%>%
      paste(uf_sel) %>%
      paste(municipio_sel) %>%
      paste(fonte_sel) %>%
      paste(secao_sel) %>%
      paste(subclasse_sel) %>%
      paste(cbo2002ocupacao_sel) %>%
      paste(categoria_sel) %>%
      paste(graudeinstrucao_sel) %>%
      paste(racacor_sel) %>%
      paste(sexo_sel) %>%
      paste(tipoempregador_sel) %>%
      paste(tipodedeficiencia_sel) %>%
      paste(tamestabjan_sel) %>%
      paste(indtrabintermitente_sel) %>%
      paste(indtrabparcial_sel) %>%
      paste(indicadoraprendiz_sel) %>%
      paste(salario_sel) %>%
      paste(idade_sel) %>%
      paste(horascontratuais_sel)
    # %>%
    #   paste(tempoemprego_sel)


    query_2 <- paste(query_select,query_where,query_groupby) %>%
      str_squish() %>%
      str_replace("AND group","group") %>%
      str_replace("where group","group")

    print(query_2)

    base <- dbGetQuery(con("temporario"),query_2)

    base <- base %>%
      try_left_join(categoria) %>%
      try_left_join(cbo2002ocupacao) %>%
      try_left_join(fonte) %>%
      try_left_join(graudeinstrucao) %>%
      try_left_join(indicadoraprendiz) %>%
      try_left_join(indtrabintermitente) %>%
      try_left_join(indtrabparcial) %>%
      try_left_join(municipio) %>%
      try_left_join(racacor) %>%
      try_left_join(regiao) %>%
      try_left_join(secao) %>%
      try_left_join(sexo) %>%
      try_left_join(subclasse) %>%
      try_left_join(tamestabjan) %>%
      try_left_join(tipodedeficiencia) %>%
      try_left_join(tipoempregador) %>%
      try_left_join(tipoestabelecimento) %>%
      try_left_join(tipomovimentacao) %>%
      try_left_join(saldomovimentacao) %>%
      try_left_join(competencia) %>%
      try_left_join(uf) %>%
      try_rename() %>%
      select(!ends_with("_id")) %>%
      relocate(any_of(c("Media_Idade","Media_Salarial","Contagem","saldomovimentacao")))

    ncols <- ncol(base)

    base <- base %>%
      select(ncols:1)

    return(base)


  })

  output$table <- DT::renderDT({

    print(base())
    base()

    #return(caged)

  }, options = list(autoWidth = F,pageLength = 10,language = list(url = '//cdn.datatables.net/plug-ins/1.10.11/i18n/Portuguese-Brasil.json')))


  output$downloadData <- downloadHandler(
    filename = paste0("Relatório CAGED ",str_replace_all(str_sub(now(),start = 1,end = 19),":","-"),".xlsx"),
    content = function(file){
      sheets <- list("Relatório" = base())
      write_xlsx(sheets,path = file)}
  )

}
Catho-ThiagoMiranda/CAGED documentation built on Dec. 31, 2020, 10:58 a.m.