R/mod_radar.R

In tvroylandt/gravitype: Gravity Pole emploi

# Module UI

#' @title   mod_radar_ui and mod_radar_server
#' @description  A shiny Module.
#'
#' @param id shiny id
#' @param input internal
#' @param output internal
#' @param session internal
#'
#' @rdname mod_radar
#'
#' @keywords internal
#' @export
#' @importFrom shiny NS tagList
#' @importFrom plotly plotlyOutput
mod_radar_ui <- function(id) {
  ns <- NS(id)
  tagList(p("\n"), plotlyOutput(ns("radar")))
}

# Module Server

#' @rdname mod_radar
#' @export
#' @import dplyr
#' @import plotly
#' @importFrom stringr str_wrap
#' @keywords internal

mod_radar_server <- function(input, output, session, r) {
  ns <- session$ns
  
  output$radar <- renderPlotly({
    
    df_filtre_fap_nat2017 <- r$df_filtre_fap_nat %>%
      filter(annee == "2017") %>%
      select(
        fap87,
        ind_tension_all,
        ind_int_emb_all,
        ind_specif_form_empl,
        ind_dur_empl_all,
        ind_cond_travail,
        ind_chomage,
        ind_mismatch_geo
      ) %>%
      pivot_longer(-fap87) %>%
      mutate(
        def_ind = fct_recode(
          name,
          "Indicateur de tension" = "ind_tension_all",
          "Nombre de projets et d'offres rapportés à l'emploi" = "ind_int_emb_all",
          "Relation entre la spécialité de formation et l'emploi" = "ind_specif_form_empl",
          "Durabilité de l'emploi" = "ind_dur_empl_all",
          "Conditions de travail" = "ind_cond_travail",
          "Rapport entre la DEFM A et l'emploi" = "ind_chomage",
          "Somme des écarts entre l'offre et la demande d'emploi" = "ind_mismatch_geo"
        ),
        def_ind = paste0(round(value, 3), "\n", str_wrap(def_ind, 30)),
        name = str_wrap(
          fct_recode(
            name,
            "Tension" = "ind_tension_all",
            "Intensité d'embauches" = "ind_int_emb_all",
            "Spécificité formation-emploi" = "ind_specif_form_empl",
            "Durabilité de l'emploi" = "ind_dur_empl_all",
            "Conditions de travail" = "ind_cond_travail",
            "Main d'oeuvre disponible" = "ind_chomage",
            "Mismatch géographique" = "ind_mismatch_geo"
          ),
          20
        ),
        color = fct_recode(
          fap87,
          "#003878" = "Global",
          "#d9001f" = r$fap87_filtre
        ),
        color_alpha = adjustcolor(color, alpha.f = 0.4),
        # on doit réinverser les couleurs des points car plotly les inverse dans marker
        color = fct_recode(
          fap87,
          "#003878" = r$fap87_filtre,
          "#d9001f" = "Global"
        )
      ) %>% 
      left_join(tibble(fap87 = liste_fap87, lib_fap87 = names(liste_fap87)), by = "fap87") %>% 
      mutate(fap87 = if_else(fap87 != "Global", str_wrap(lib_fap87, 20), "Global"))
    
    # max et min
    min_radar <- min(
      data_tensions_nat_fap %>%
        filter(annee == "2017") %>%
        select(
          ind_tension_all,
          ind_int_emb_all,
          ind_specif_form_empl,
          ind_dur_empl_all,
          ind_cond_travail,
          ind_chomage,
          ind_mismatch_geo
        ),
      na.rm = TRUE
    )
    max_radar <- max(
      data_tensions_nat_fap %>%
        filter(annee == "2017") %>%
        select(
          ind_tension_all,
          ind_int_emb_all,
          ind_specif_form_empl,
          ind_dur_empl_all,
          ind_cond_travail,
          ind_chomage,
          ind_mismatch_geo
        ),
      na.rm = TRUE
    )
    
    # graph plotly
    p <- plot_ly(
      data = df_filtre_fap_nat2017,
      type = "scatterpolar",
      fill = "toself",
      hoverinfo = "text",
      text = ~ def_ind,
      r = ~ value,
      theta = ~ name,
      name = ~ fap87,
      marker =  list(color = ~ color),
      fillcolor = ~ color_alpha,
      height = 550
    ) %>%
      layout(polar = list(radialaxis = list(
        visible = T,
        range = c(min_radar, max_radar)
      )))
    
    # sans la barre
    p1 <- config(p, displayModeBar = FALSE)
    
    # affichage 
    p1
    
    # stockage du radar dans le petit r
    r$radar <- p1
    
  })
  

}

## To be copied in the UI
# mod_radar_ui("radar_ui_1")

## To be copied in the server
# callModule(mod_radar_server, "radar_ui_1")