R/mod_tableau.R

In tvroylandt/gravitype: Gravity Pole emploi

# Module UI

#' @title   mod_tableau_ui and mod_tableau_server
#' @description  A shiny Module.
#'
#' @param id shiny id
#' @param input internal
#' @param output internal
#' @param session internal
#'
#' @rdname mod_tableau
#'
#' @keywords internal
#' @export
#' @importFrom shiny NS tagList
#' @importFrom reactable reactableOutput
mod_tableau_ui <- function(id) {
  ns <- NS(id)
  tagList(reactableOutput(ns("tab")))
}

# Module Server

#' @rdname mod_tableau
#' @export
#' @import reactable
#' @import dplyr
#' @import tidyr
#' @import forcats
#' @keywords internal

mod_tableau_server <- function(input, output, session, r) {
  ns <- session$ns
  
  output$tab <- renderReactable({
    # mise au format
    df_tab <- r$df_filtre_fap_nat %>%
      filter(annee == "2017") %>%
      select(
        fap87,
        ind_tension_all,
        bmo_part_diff,
        ratio_o_de_all,
        de_taux_ecoulement,
        ind_chomage,
        ind_dur_empl_all,
        ind_cond_travail,
        ind_int_emb_all,
        ind_mismatch_geo,
        ind_specif_form_empl,
        defm_a,
        oee_all,
        bmo_proj_tot
      ) %>%
      pivot_longer(names_to = "ind",
                   values_to = "val_ind",
                   cols = -c(fap87)) %>%
      mutate(val_ind = case_when(
        ind %in% c("defm_a",
                   "oee_all",
                   "bmo_proj_tot") ~ format(round(val_ind / 100, 0) * 100, big.mark = " "),
        ind %in% c("bmo_part_diff") ~ paste0(round(val_ind, 1), "%"),
        TRUE ~ as.character(round(val_ind, 3))
      )) %>%
      pivot_wider(names_from = fap87, values_from = val_ind) %>%
      mutate(
        ind = fct_relevel(
          ind,
          "ind_tension_all",
          "bmo_part_diff",
          "ratio_o_de_all",
          "de_taux_ecoulement",
          "ind_chomage",
          "ind_specif_form_empl",
          "ind_int_emb_all",
          "ind_dur_empl_all",
          "ind_mismatch_geo",
          "ind_cond_travail",
          "defm_a",
          "oee_all",
          "bmo_proj_tot"
        ),
        type_ind = fct_collapse(
          ind,
          "Indicateur de tension" = c(
            "ind_tension_all",
            "bmo_part_diff",
            "ratio_o_de_all",
            "de_taux_ecoulement"
          ),
          "Indicateurs complémentaires" = c(
            "ind_chomage",
            "ind_specif_form_empl",
            "ind_int_emb_all",
            "ind_dur_empl_all",
            "ind_mismatch_geo",
            "ind_cond_travail"
          )
          ,
          "Données de contexte" = c("defm_a",
                                    "oee_all",
                                    "bmo_proj_tot")
        ),
        ind = fct_recode(
          ind,
          "Tension" = "ind_tension_all",
          "Part de projets difficiles (en %)" = "bmo_part_diff",
          "Ratio offres/demande" = "ratio_o_de_all",
          "Taux d'écoulement de la demande" = "de_taux_ecoulement",
          "Main d'oeuvre disponible" = "ind_chomage",
          "Spécificité formation-emploi" = "ind_specif_form_empl",
          "Intensité d'embauches" = "ind_int_emb_all",
          "Conditions d'emploi" = "ind_dur_empl_all",
          "Conditions de travail" = "ind_cond_travail",
          "Mismatch géographique" = "ind_mismatch_geo",
          "DEFM A" = "defm_a",
          "Offres diffusées" = "oee_all",
          "Projets de recrutement" = "bmo_proj_tot"
        )
      )
    
    # définition des colonnes
    list_col_def <- list(
      colDef(name = "Indicateurs", sortable = FALSE),
      colDef(name = "Famille d'indicateurs", sortable = FALSE),
      colDef(
        name = filter(
          tibble(fap87 = liste_fap87, lib_fap87 = names(liste_fap87)),
          fap87 == r$fap87_filtre
        )$lib_fap87,
        style = f_col_cell,
        sortable = FALSE
      ),
      colDef(style = f_col_cell, sortable = FALSE)
    )
    
    list_col_def <-
      setNames(list_col_def,
               c("ind", "type_ind", r$fap87_filtre, "Global"))
    
    # tableau indicateurs
    reactable(df_tab,
              groupBy = "type_ind",
              columns = list_col_def,
              striped = TRUE)
  })
}

## To be copied in the UI
# mod_tableau_ui("tableau_ui_1")

## To be copied in the server
# callModule(mod_tableau_server, "tableau_ui_1")