R/mt_calcul_apl.R

Defines functions mt_calcul_apl

Documented in mt_calcul_apl

#' Création d'un ensemble de fichiers liés aux apl
#'
#' @param code_dep Code INSEE du département (France métropole)
#' @param chemin_RXXXX Chemin vers les données Remboursement mensuel de l'Assurance Maladie par departement de la DAMIR
#' @param nom_generique_RXXXX Nom générique des fichiers Remboursement mensuel de l'Assurance Maladie par departement de la DAMIR
#' @param chemin_AXXXX Chemin vers les données d'extraction du Système National Inter Régimes d'Assurance Maladie (SNIIRAM) par departement de la DAMIR
#' @param nom_generique_AXXXX Nom générique des fichiers d'extraction du Système National Inter Régimes d'Assurance Maladie (SNIIRAM) par departement de la DAMIR
#' @param dep_fr objet de classe sf projete en WGS84 des limites départementales
#' @param commune_fr objet de classe sf projete en WGS84 des limites communales
#' @param ExtractionMonoTable_CAT18_ToutePopulation objet data.frame des professionnels de santé autorisés à exercer.
#' @param nb_actes_par_praticien data.frame du nombre d'actes par praticien, par spécialité et par département
#' @param BTX_TD_POP1B data.frame issu de la table INSEE de la population par age et par sexe empilé
#' @param correspondance_dep_reg data.frame de correspondance département/région
#' @param APL_2018_DREES data.frame des données DRESS concernant l'APL des généralistes en 2018 par commune
#' @param type_calcul Chaîne de caractères prenant la valeur "departement" ou "commune". Elle définit l'échelle de calcul: Toutes les communes d'un département (departement) ou une sélection de communes d'un département (commune)
#' @param code_commune Vecteur de caractères contenant les codes communes INSEE des communes à traitées. Il faut que les communes appartiennent à un même département. Par défaut, la valeur est NULL
#' @param url_osrm Chaîne de caractères contenant l'url du moteur de recherche OSRM. Par défaut, il est NULL
#' @param taille_max_matrice_osrm Valeur numérique entière positive de la taille maximale des tables utilisées pour le calcul des matrices de distance. Par défaut, elle est de 500.
#'
#' @return une liste contenant 10 éléments : dep_cible, commune_chef_lieu_dep_cible,commune_chef_lieu_tampon_dep_cible_195, commune_chef_lieu_tampon_dep_cible_130,commune_chef_lieu_tampon_dep_cible_97.5, commune_chef_lieu_tampon_dep_cible_65,ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir,dist_mat_communes_dep_cible_praticien,apl,commune_fr_dep_cible_Ensemble_APL_calc
#' @seealso \code{\link{mt_calcul_apl}}
#' @export
#'
#' @examples
#'\dontrun{
#'liste_osrm <- tibble(
#' DEP=c("971","972","973","974","976","000"),
#' Nom_DEP=c("Guadeloupe","Martinique","Guyane","La Reunion","Mayotte","metro"),
#' ip=c("http://51.158.69.224:5971/","http://51.158.69.224:5972/","http://51.158.69.224:5973/","http://51.158.69.224:5974/","http://51.158.69.224:5976/","http://51.158.69.224:5999/")
#' )
#'
#'url_osrm = liste_osrm %>%
#'  filter(Nom_DEP=="metro") %>%
#'  pull(ip)
#'
#'dep_fr = readRDS("../data_init/IGN/2022/dep_fr.rds")
#'commune_fr = readRDS("../data_init/IGN/2022/commune_fr.rds")
#'commune_chef_lieu_fr = readRDS("../data_init/IGN/2022/commune_chef_lieu_fr.rds")
#'ExtractionMonoTable_CAT18_ToutePopulation = readRDS("../data_init/Annuaire Sante/2022/ExtractionMonoTable_CAT18_ToutePopulation.rds")
#'
#'nb_actes_par_praticien <- readRDS("D:/d-sidd Dropbox/Arnaud milet/synchro d-sidd/Partenariat/MedTrucks/2019 - 09 - E-Meuse Sante/Phase 4 - Industrialisation/data_init/AMELI/2020/nb_actes_par_praticien.rds")
#'BTX_TD_POP1B <- readRDS("D:/d-sidd Dropbox/Arnaud milet/synchro d-sidd/Partenariat/MedTrucks/2019 - 09 - E-Meuse Sante/Phase 4 - Industrialisation/data_init/INSEE/2018/BTX_TD_POP1B.rds")
#'correspondance_dep_reg <- readRDS(system.file("extdata","correspondance_dep_reg.rds",package = "medtRucks"))
#'BTX_TD_POP1B <- BTX_TD_POP1B %>%
#'  mutate(code_dep=ifelse(str_sub(CODGEO,1,2) %in% c("97","98"),str_sub(CODGEO,1,3),str_sub(CODGEO,1,2))) %>%
#'  left_join(correspondance_dep_reg,by=c("code_dep"="departmentCode")) %>%
#'  select("CODGEO","LIBGEO","code_dep","departmentName","regionCode","regionName",everything())
#'
#'APL_2018_DREES <- read_excel("D:/d-sidd Dropbox/Arnaud milet/synchro d-sidd/Partenariat/MedTrucks/2019 - 09 - E-Meuse Sante/Phase 4 - Industrialisation/data_init/DREES/APL_2018_DREES.xlsx",
#'                               sheet = "APL_2018", skip = 8
#'                             )
#'names(APL_2018_DREES) <- c("depcom", "libcom", "APL DREES 2018", "APL DREES 2018 moins de 65 ans", "Pop 2016")
#'
#'chemin_RXXXX = "D:/d-sidd Dropbox/Arnaud milet/synchro d-sidd/Partenariat/MedTrucks/2019 - 09 - E-Meuse Sante/Phase 4 - Industrialisation/data_init/damir/2020/R/R2020"
#'nom_generique_RXXXX = "R2020"
#'chemin_AXXXX = "D:/d-sidd Dropbox/Arnaud milet/synchro d-sidd/Partenariat/MedTrucks/2019 - 09 - E-Meuse Sante/Phase 4 - Industrialisation/data_init/damir/2020/A"
#'nom_generique_AXXXX = "A2020"
#'
#'code_dep = "55"
#'valeur <- mt_calcul_apl(code_dep,chemin_RXXXX,nom_generique_RXXXX,chemin_AXXXX,nom_generique_AXXXX,dep_fr,commune_fr,ExtractionMonoTable_CAT18_ToutePopulation,nb_actes_par_praticien,BTX_TD_POP1B,correspondance_dep_reg,APL_2018_DREES,url_osrm=url_osrm)


#'emplacement_ensemble_data = "D:/d-sidd Dropbox/Arnaud milet/synchro d-sidd/Partenariat/MedTrucks/2019 - 09 - E-Meuse Sante/Phase 4 - Industrialisation/data_final/"
#'data_folder <- paste0(emplacement_ensemble_data,code_dep)
#'dir.create(data_folder, showWarnings = FALSE)
#'
#'walk(names(valeur),function(x){
#'     nom_enregistrement <- bind_rows(
#'                              c(Nom_objet="dep_cible", Nom_enregistre = paste0(data_folder,"/dep_",code_dep,".rds")),
#'                              c(Nom_objet="commune_chef_lieu_dep_cible", Nom_enregistre =paste0(data_folder,"/commune_chef_lieu_",code_dep,".rds")),
#'                              c(Nom_objet="commune_chef_lieu_tampon_dep_cible_195", Nom_enregistre =paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_195.rds")),
#'                              c(Nom_objet="commune_chef_lieu_tampon_dep_cible_130", Nom_enregistre =paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_130.rds")),
#'                              c(Nom_objet="commune_chef_lieu_tampon_dep_cible_97.5", Nom_enregistre =paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_97.5.rds")),
#'                              c(Nom_objet="commune_chef_lieu_tampon_dep_cible_65", Nom_enregistre =paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_65.rds")),
#'                              c(Nom_objet="ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir",Nom_enregistre =paste0(data_folder,"/ExtractionMonoTable_CAT18_ToutePopulation_tampon_",code_dep,"_rens_damir.rds")),
#'                              c(Nom_objet="dist_mat_communes_dep_cible_praticien", Nom_enregistre =paste0(data_folder,"/dist_mat_communes_",code_dep,"_praticien.rds")),
#'                              c(Nom_objet="apl", Nom_enregistre =paste0(data_folder,"/apl_",code_dep,".rds")),
#'                              c(Nom_objet="commune_fr_dep_cible_Ensemble_APL_calc", Nom_enregistre =paste0(data_folder,"/commune_fr_",code_dep,"_Ensemble_APL_calc.rds"))
#'                              ) %>%
#'             filter(Nom_objet==x) %>%
#'             pull(Nom_enregistre)
#'
#'      saveRDS(valeur[[x]],nom_enregistrement)
#'})


#' walk(c("52","54","55"),function(code_dep){
#'   print(code_dep)
#'
#'   valeur <- mt_calcul_apl(code_dep,chemin_RXXXX,nom_generique_RXXXX,chemin_AXXXX,nom_generique_AXXXX,dep_fr,commune_fr,ExtractionMonoTable_CAT18_ToutePopulation,nb_actes_par_praticien,BTX_TD_POP1B,correspondance_dep_reg,APL_2018_DREES,url_osrm = url_osrm)
#'
#'   data_folder <- paste0(emplacement_ensemble_data,code_dep)
#'   dir.create(data_folder, showWarnings = FALSE)
#'
#'   walk(names(valeur),function(x){
#'     nom_enregistrement <- bind_rows(
#'       c(Nom_objet="dep_cible", Nom_enregistre = paste0(data_folder,"/dep_",code_dep,".rds")),
#'       c(Nom_objet="commune_chef_lieu_dep_cible", Nom_enregistre =paste0(data_folder,"/commune_chef_lieu_",code_dep,".rds")),
#'       c(Nom_objet="commune_chef_lieu_tampon_dep_cible_195", Nom_enregistre =paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_195.rds")),
#'       c(Nom_objet="commune_chef_lieu_tampon_dep_cible_130", Nom_enregistre =paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_130.rds")),
#'       c(Nom_objet="commune_chef_lieu_tampon_dep_cible_97.5", Nom_enregistre =paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_97.5.rds")),
#'       c(Nom_objet="commune_chef_lieu_tampon_dep_cible_65", Nom_enregistre =paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_65.rds")),
#'       c(Nom_objet="ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir",Nom_enregistre =paste0(data_folder,"/ExtractionMonoTable_CAT18_ToutePopulation_tampon_",code_dep,"_rens_damir.rds")),
#'       c(Nom_objet="dist_mat_communes_dep_cible_praticien", Nom_enregistre =paste0(data_folder,"/dist_mat_communes_",code_dep,"_praticien.rds")),
#'       c(Nom_objet="apl", Nom_enregistre =paste0(data_folder,"/apl_",code_dep,".rds")),
#'       c(Nom_objet="commune_fr_dep_cible_Ensemble_APL_calc", Nom_enregistre =paste0(data_folder,"/commune_fr_",code_dep,"_Ensemble_APL_calc.rds")),
#'     ) %>%
#'       filter(Nom_objet==x) %>%
#'       pull(Nom_enregistre)
#'
#'     saveRDS(valeur[[x]],nom_enregistrement)
#'
#'   })
#'
#' })
#'}
#' @importFrom dplyr filter mutate left_join as_tibble select rename group_by n summarise ungroup arrange distinct contains tibble
#' @importFrom purrr map_dfr map_dbl map_df
#' @importFrom sf st_transform st_buffer st_intersects st_crs
#' @importFrom stringr str_sub str_detect str_split_fixed str_remove
#' @importFrom tidyr gather
#' @importFrom units as_units
mt_calcul_apl <- function(code_dep,chemin_RXXXX,nom_generique_RXXXX,chemin_AXXXX,nom_generique_AXXXX,dep_fr,commune_fr,ExtractionMonoTable_CAT18_ToutePopulation,nb_actes_par_praticien,BTX_TD_POP1B,correspondance_dep_reg,APL_2018_DREES,type_calcul="departement",code_commune=NULL,url_osrm=NULL,taille_max_matrice_osrm=500){
  if(type_calcul=="commune"){
    code_dep  <- commune_fr %>%
      filter(INSEE_COM%in%code_commune) %>%
      pull(INSEE_DEP) %>%
      unique()
  }
  if(type_calcul!="commune"){
    code_reg <- as.data.frame(correspondance_dep_reg)[which(correspondance_dep_reg$departmentCode == str_to_lower(code_dep)),"regionCode"]
  }else{
    code_reg <- commune_fr %>%
      filter(INSEE_COM%in%code_commune) %>%
      pull(INSEE_REG) %>%
      unique()
  }

  # data_folder <- paste0(emplacement_ensemble_data,code_dep)
  # dir.create(data_folder, showWarnings = FALSE)

  # 1-Création des zones tampons ----
  # Création d'une zone tampon autour du département de la Meuse qui permettrait de selectionner
  # toutes les communes (tous les praticiens: annuaire.santé, tous les établissements: finess)
  # à moins de 195 kms (1h30 en roulant à 130 kms/h).

  ## 1.1 zone_cible ----
  if(type_calcul!="commune"){
    zone_cible <-  dep_fr %>%
      filter(INSEE_DEP == code_dep)
  }else{
    zone_cible <-  commune_fr %>%
      filter(INSEE_COM %in% code_commune) %>%
      summarise()
  }

  # saveRDS(zone_cible, paste0(data_folder,"/dep_",code_dep,".rds"))

  ## 1.2 tampons zone_cible ----

  tampon_zone_cible_195 <- zone_cible %>%
    st_transform(2154) %>%
    st_buffer(units::as_units(195000, "m")) %>%
    st_transform(4326)

  tampon_zone_cible_130 <- zone_cible %>%
    st_transform(2154) %>%
    st_buffer(units::as_units(130000, "m")) %>%
    st_transform(4326)

  tampon_zone_cible_97.5 <- zone_cible %>%
    st_transform(2154) %>%
    st_buffer(units::as_units(97500, "m")) %>%
    st_transform(4326)

  tampon_zone_cible_65 <- zone_cible %>%
    st_transform(2154) %>%
    st_buffer(units::as_units(65000, "m")) %>%
    st_transform(4326)

  ## 1.3 communes zone_cible ----

  if(type_calcul!="commune"){

    commune_fr_zone_cible <- commune_fr %>%
      filter(INSEE_DEP == code_dep)

  }else{
    commune_fr_zone_cible <- commune_fr %>%
      filter(INSEE_COM %in% code_commune)
  }

  commune_chef_lieu_zone_cible <- commune_chef_lieu_fr %>%
    filter(ID_COM %in% commune_fr_zone_cible$ID) %>%
    left_join(as_tibble(commune_fr) %>% select(-geometry),by=c("ID_COM"="ID"))

  # saveRDS(commune_chef_lieu_zone_cible, paste0(data_folder,"/commune_chef_lieu_",code_dep,".rds"))

  ## 1.4 communes tampon zone_cible ----

  logique_intersection_communes_fr_tampon_zone_cible_195 <- commune_chef_lieu_fr %>%
    st_intersects(tampon_zone_cible_195, sparse = F) %>%
    "["(, 1)

  logique_intersection_communes_fr_tampon_zone_cible_130 <- commune_chef_lieu_fr %>%
    st_intersects(tampon_zone_cible_130, sparse = F) %>%
    "["(, 1)

  logique_intersection_communes_fr_tampon_zone_cible_97.5 <- commune_chef_lieu_fr %>%
    st_intersects(tampon_zone_cible_97.5, sparse = F) %>%
    "["(, 1)

  logique_intersection_communes_fr_tampon_zone_cible_65 <- commune_chef_lieu_fr %>%
    st_intersects(tampon_zone_cible_65, sparse = F) %>%
    "["(, 1)

  commune_chef_lieu_tampon_zone_cible_195 <- commune_chef_lieu_fr[logique_intersection_communes_fr_tampon_zone_cible_195, ]%>%
    rename(NOM_CHEF_LIEU=NOM) %>%
    left_join(as_tibble(commune_fr) %>% select(-geometry),by=c("ID_COM"="ID"))
  commune_chef_lieu_tampon_zone_cible_130 <- commune_chef_lieu_fr[logique_intersection_communes_fr_tampon_zone_cible_130, ]%>%
    rename(NOM_CHEF_LIEU=NOM) %>%
    left_join(as_tibble(commune_fr) %>% select(-geometry),by=c("ID_COM"="ID"))
  commune_chef_lieu_tampon_zone_cible_97.5 <- commune_chef_lieu_fr[logique_intersection_communes_fr_tampon_zone_cible_97.5, ] %>%
    rename(NOM_CHEF_LIEU=NOM) %>%
    left_join(as_tibble(commune_fr) %>% select(-geometry),by=c("ID_COM"="ID"))
  commune_chef_lieu_tampon_zone_cible_65 <- commune_chef_lieu_fr[logique_intersection_communes_fr_tampon_zone_cible_65, ]%>%
    rename(NOM_CHEF_LIEU=NOM) %>%
    left_join(as_tibble(commune_fr) %>% select(-geometry),by=c("ID_COM"="ID"))

  # saveRDS(commune_chef_lieu_tampon_zone_cible_195, paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_195.rds"))
  # saveRDS(commune_chef_lieu_tampon_zone_cible_130, paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_130.rds"))
  # saveRDS(commune_chef_lieu_tampon_zone_cible_97.5, paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_97.5.rds"))
  # saveRDS(commune_chef_lieu_tampon_zone_cible_65, paste0(data_folder,"/commune_chef_lieu_tampon_",code_dep,"_65.rds"))


  #2 - Annuaire de santé ----

  ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible <- ExtractionMonoTable_CAT18_ToutePopulation %>%
    filter(`Code commune (coord. structure)` %in% commune_chef_lieu_tampon_zone_cible_97.5$INSEE_COM , `Code catégorie professionnelle`=="C")

  correspondances_damir_annuaire <- readRDS(system.file("extdata","correspondances_damir_annuaire.rds",package = "medtRucks"))

  ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir<-ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible %>%
    filter(`Code profession` %in% c(10,40) ) %>%
    left_join(correspondances_damir_annuaire %>% select(`Code savoir-faire`,exe_spe,l_exe_spe),by="Code savoir-faire") %>%
    mutate(exe_spe=ifelse(`Code profession`==40,19,exe_spe),
           l_exe_spe=ifelse(`Code profession`==40,"19-TOTAL Chirurgie dentaire",l_exe_spe))


  ##2-1 -Prise en compte des multiples sites de pratiques
  # ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir<-ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir %>%
  #   left_join(
  #     ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir%>%
  #       group_by(`Identification nationale PP`) %>%
  #       # summarise(nb_site=n()) %>%
  #       mutate(
  #         nb_site=n(),
  #         repartition_site=1/nb_site), by="Identification nationale PP"
  #   )

  ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir <- ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir%>%
    group_by(`Identification nationale PP`) %>%
    mutate(
      nb_site=n(),
      repartition_site=1/nb_site
    )

  # saveRDS(ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir,paste0(data_folder,"/ExtractionMonoTable_CAT18_ToutePopulation_tampon_",code_dep,"_rens_damir.rds"))

  # 2- Création d'une matrice des distances ----
  # Création d'une matrice des distances entre toutes ces communes: sauvegarder cette matrice
  # pour l'interroger quand nécessaire

  # Pour enlever la notation scientifique par 1.9e-05 au lieu de 0.000019 (pose probleme dans osrm).
  # Pour reinitialiser cette option, il suffit de mettre options(scipen=0)
  options(scipen = 999)

  if(!is.null(url_osrm)){
    options(osrm.server = url_osrm)
  }
  rownames(commune_chef_lieu_tampon_zone_cible_195) <- commune_chef_lieu_tampon_zone_cible_195$INSEE_COM
  Communes_praticiens <- commune_chef_lieu_tampon_zone_cible_195 %>%
    filter(INSEE_COM %in% unique(ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir$`Code commune (coord. structure)`))

  rownames(Communes_praticiens) <- Communes_praticiens$INSEE_COM

  dist_mat_communes_zone_cible_praticien <- dsidd_split_osrmTable(source = Communes_praticiens, destination = commune_chef_lieu_tampon_zone_cible_195, nb=taille_max_matrice_osrm)

  # saveRDS(dist_mat_communes_zone_cible_praticien, paste0(data_folder,"/dist_mat_communes_",code_dep,"_praticien.rds"))

  # 3 - calcul nb actes par spécialité et par médecin ----
  RXXXX_zone_cible <- readRDS(paste0(chemin_RXXXX,"/",nom_generique_RXXXX,"_",code_dep,".rds"))
  correspondance_spe <- readRDS(system.file("extdata","correspondance_spe.rds",package = "medtRucks"))
  nb_actes_spe <- ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir %>%
    filter(str_sub(`Code commune (coord. structure)`, 1, 2) == code_dep & !is.na(l_exe_spe)) %>%
    mutate(exe_spe = as.numeric(exe_spe)) %>%
    group_by(exe_spe, l_exe_spe) %>%
    summarise(nb_praticien = sum(repartition_site)) %>%
    left_join(RXXXX_zone_cible %>%
                group_by(exe_spe) %>%
                summarise(act_dnb = sum(act_dnb)) %>%
                ungroup() %>%
                left_join(correspondance_spe, by = "exe_spe"), by = c("exe_spe", "l_exe_spe")) %>%
    mutate(
      acte_par_praticien = act_dnb / nb_praticien,
      acte_par_praticien_par_jour = acte_par_praticien / 365,
      acte_par_praticien_par_jour_travaille = acte_par_praticien / 220
    )

  # Etape 4 ----
  # Pour chaque specialité présente dans la Meuse,
  # On détermine pour chaque commune j d’implantation de médecins de la spécialité,
  # l’ensemble des communes i accessibles avec un déplacement dont la distance est
  # inférieure à un seuil de référence d0.
  # On calcule ainsi un ratio Rj qui rapporte l’offre de médecins en j à la population
  # située dans une aire d’attraction de rayon d0 centrée sur la commune j
  # (zone de patientèle).

  BTX_TD_POP1B_tampon_195<-BTX_TD_POP1B %>%
    select(-c("code_dep", "departmentName", "regionCode","regionName")) %>%
    filter(CODGEO %in% commune_chef_lieu_tampon_zone_cible_195$INSEE_COM)

  Pop_tot_tampon_195<-BTX_TD_POP1B_tampon_195 %>%
    as.data.frame() %>%
    mutate(Pop = rowSums(.[which(str_detect(names(.),"AGED100"))])) %>%
    select(CODGEO,Pop)

  Specialite_concernee <- ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir %>%
    filter(!is.na(l_exe_spe) & str_sub(`Code commune (coord. structure)`, 1, 2) == code_dep) %>%
    as.data.frame() %>%
    "["(, "exe_spe") %>%
    unique()

  Specialite_concernee_presentation <- ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir %>%
    filter(!is.na(l_exe_spe) & str_sub(`Code commune (coord. structure)`, 1, 2) == code_dep) %>%
    select(l_exe_spe) %>%
    arrange(l_exe_spe) %>%
    distinct() %>%
    mutate(
      Code = str_sub(l_exe_spe, 1, 2),
      l_exe_spe = str_sub(l_exe_spe, 4, nchar(l_exe_spe))
    ) %>%
    select(Code, l_exe_spe) %>%
    rename("Specialite" = l_exe_spe)

  Age <- readRDS(system.file("extdata","Age.rds",package = "medtRucks"))

  BTX_TD_POP1B_resume <- BTX_TD_POP1B %>%
    gather(key="Age_Sexe",value = "Pop",-c("CODGEO","LIBGEO","code_dep","departmentName","regionCode","regionName")) %>%
    mutate(Sexe=str_split_fixed(Age_Sexe,"_",2)[,1],
           Age=str_split_fixed(Age_Sexe,"_",2)[,2],
           Sexe=as.numeric(str_remove(Sexe,"SEXE")),
           Age=as.numeric(str_remove(Age,"AGED100"))) %>%
    left_join(Age, by=c("Age"="Age_Insee")) %>%
    group_by(regionCode,regionName,Sexe,Age_Damir) %>%
    summarise(Pop=sum(Pop,na.rm=T)) %>%
    ungroup()

  BTX_TD_POP1B_reg_cible_resume <- BTX_TD_POP1B_resume %>%
    filter(regionCode==code_reg) %>%
    select(-regionCode,-regionName)

  if(code_reg=="94"){
    AXXXX <- readRDS(paste0(chemin_AXXXX,"/",nom_generique_AXXXX,"_93.rds"))
  }else{
    AXXXX <- readRDS(paste0(chemin_AXXXX,"/",nom_generique_AXXXX,"_",code_reg,".rds"))
  }
  Correspondance_Damir_Open_Damir <- readRDS(system.file("extdata","Correspondance_Damir_Open_Damir.rds",package = "medtRucks"))

  Facteur_multi_Age_Sexe_Spe <- AXXXX %>%
    left_join(Correspondance_Damir_Open_Damir %>%
                select(PSE_SPE_SNDS,exe_spe),by="PSE_SPE_SNDS") %>%
    group_by(AGE_BEN_SNDS,BEN_SEX_COD,exe_spe) %>%
    summarise(nb_act=sum(nb_act,na.rm=T)) %>%
    ungroup() %>%
    left_join(BTX_TD_POP1B_reg_cible_resume,by=c("AGE_BEN_SNDS"="Age_Damir","BEN_SEX_COD"="Sexe")) %>%
    mutate(nb_act_par_hab=nb_act/Pop) %>%
    left_join(AXXXX %>%
                left_join(Correspondance_Damir_Open_Damir %>%
                            select(PSE_SPE_SNDS,exe_spe),by="PSE_SPE_SNDS") %>%
                group_by(exe_spe) %>%
                summarise(nb_act=sum(nb_act,na.rm=T)) %>%
                ungroup() %>%
                mutate(Pop=sum(BTX_TD_POP1B_reg_cible_resume$Pop),
                       nb_act_par_hab_moy=nb_act/Pop) %>%
                select(exe_spe,nb_act_par_hab_moy),by="exe_spe") %>%
    mutate(Multiplicateur=nb_act_par_hab/nb_act_par_hab_moy)

  Correspondance_TauxAccessibilite_Spe <- readRDS(system.file("extdata","Correspondance_TauxAccessibilite_Spe.rds",package = "medtRucks"))
  TauxAccessibilite <- readRDS(system.file("extdata","TauxAccessibilite.rds",package = "medtRucks"))
  Specialite_ameli <- unique(nb_actes_par_praticien$exe_spe)

  Temps_max <- Correspondance_TauxAccessibilite_Spe %>%
    filter(exe_spe == 1) %>%
    select(contains("Taux d")) %>%
    as.data.frame()

  Temps <- tibble(Temps_min = c(0, as.numeric(Temps_max[1:length(Temps_max) - 1])), Temps_max = as.numeric(Temps_max))
  Temps$Temps_min[1] <- -Inf
  Temps$Temps_max[nrow(Temps)] <- Inf

  nb_actes_par_hab_zone_praticien <- map_dfr(Specialite_concernee, function(x) {
    print(x)
    communes_Specialite_concernee <- ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir %>%
      filter(exe_spe == x) %>%
      as.data.frame() %>%
      "["(, "Code commune (coord. structure)") %>%
      unique()



    map_dfr(communes_Specialite_concernee, function(y) {
      Pop <- map_dbl(
        1:3,
        function(z) {
          communes_zone <- names(which(dist_mat_communes_zone_cible_praticien$durations[y, ] <= Temps$Temps_max[z] & dist_mat_communes_zone_cible_praticien$durations[y, ] > Temps$Temps_min[z]))
          BTX_TD_POP1B_tampon_195 %>%
            filter(CODGEO %in% communes_zone) %>%
            gather(key = "Age_Sexe", value = "Pop", -c("CODGEO", "LIBGEO")) %>%
            mutate(
              Sexe = str_split_fixed(Age_Sexe, "_", 2)[, 1],
              Age = str_split_fixed(Age_Sexe, "_", 2)[, 2],
              Sexe = as.numeric(str_remove(Sexe, "SEXE")),
              Age = as.numeric(str_remove(Age, "AGED100"))
            ) %>%
            left_join(Age, by = c("Age" = "Age_Insee")) %>%
            group_by(Sexe, Age_Damir) %>%
            summarise(Pop = sum(Pop, na.rm = T)) %>%
            ungroup() %>%
            left_join(
              Facteur_multi_Age_Sexe_Spe %>%
                filter(exe_spe == x) %>%
                select(AGE_BEN_SNDS, BEN_SEX_COD, Multiplicateur),
              by = c("Age_Damir" = "AGE_BEN_SNDS", "Sexe" = "BEN_SEX_COD")
            ) %>%
            mutate(Pop = Pop * Multiplicateur) %>%
            select(-Multiplicateur) %>%
            summarise(Pop = sum(Pop)) %>%
            mutate(Pop = Pop * TauxAccessibilite[z]) %>%
            as.data.frame() %>%
            "["(, "Pop")
        }
      ) %>%
        sum(na.rm = T)


      res <- ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir %>%
        filter(exe_spe == x, `Code commune (coord. structure)` == y) %>%
        summarise(nb_praticien = sum(repartition_site)) %>%
        mutate(
          code_commune_praticien = y,
          code_praticien = x,
          nb_actes_total = nb_praticien * (if (x %in% Specialite_ameli) {
            nb_actes_par_praticien %>%
              filter(exe_spe == x & CODE_DEPT == str_sub(y, 1, 2)) %>%
              rename(acte_par_praticien = nb_actes_par_praticien_dep_corrige) %>%
              as.data.frame() %>%
              "["(, "acte_par_praticien")
          } else {
            temp <- nb_actes_spe %>%
              filter(exe_spe == x) %>%
              as.data.frame() %>%
              "["(, "acte_par_praticien")

            if(is.na(temp)) 0 else temp
          }),
          Pop_zone = Pop,
          nb_actes_par_hab_zone = ifelse(Pop_zone == 0, 0, nb_actes_total / Pop_zone)
        )
      res
    })
  })


  apl <- map_dfr(Specialite_concernee, function(x) {
    communes_spe <- nb_actes_par_hab_zone_praticien %>%
      filter(code_praticien == x) %>%
      as.data.frame() %>%
      "["(, "code_commune_praticien")
    map_dfr(commune_chef_lieu_zone_cible$INSEE_COM, function(y) {
      apl <- map_dbl(
        1:3,
        function(z) {
          communes_zone_from_patient <- names(which(dist_mat_communes_zone_cible_praticien$durations[communes_spe, as.character(y)] <= Temps$Temps_max[z] & dist_mat_communes_zone_cible_praticien$durations[communes_spe, as.character(y)] > Temps$Temps_min[z]))
          nb_actes_par_hab_zone_praticien %>%
            filter(code_commune_praticien %in% communes_zone_from_patient) %>%
            summarise(nb_actes_par_hab_zone = sum(nb_actes_par_hab_zone, na.rm = T)) %>%
            mutate(nb_actes_par_hab_zone = nb_actes_par_hab_zone * TauxAccessibilite[z]) %>%
            as.data.frame() %>%
            "["(, "nb_actes_par_hab_zone")
        }
      ) %>%
        sum(na.rm = T)

      res <- tibble(
        depcom = y,
        code_praticien = x,
        apl = apl
      )
    })
  })

  # saveRDS(apl, paste0(data_folder,"/apl_",code_dep,".rds"))


  commune_fr_zone_cible_Ensemble_APL_calc <- commune_fr_zone_cible %>%
    left_join(apl %>%
                mutate(depcom = as.character(depcom)), by = c("INSEE_COM" = "depcom"))


  commune_fr_zone_cible_Ensemble_APL_calc <- commune_fr_zone_cible_Ensemble_APL_calc %>%
    mutate(code_praticien = as.numeric(code_praticien)) %>%
    left_join(
      Specialite_concernee_presentation %>%
        ungroup() %>%
        distinct(Code,Specialite) %>%
        mutate(Lib_praticien = paste0(Code, "-", Specialite)) %>%
        mutate(Code = as.numeric(Code)),
      by = c("code_praticien" = "Code")
    )


  commune_fr_zone_cible_Ensemble_APL_calc<-commune_fr_zone_cible_Ensemble_APL_calc %>%
    rbind(
      commune_fr_zone_cible %>%
        left_join(APL_2018_DREES %>%
                    select(depcom, `APL DREES 2018`) %>%
                    mutate(depcom = as.character(depcom)), by = c("INSEE_COM" = "depcom")) %>%
        rename(apl = "APL DREES 2018") %>%
        mutate(
          "code_praticien" = 0,
          "Specialite" = "APL DREES 2018",
          "Lib_praticien" = "APL DREES 2018"
        )
    )


  BTX_TD_POP1B_zone_cible <- BTX_TD_POP1B_tampon_195 %>%
    filter(str_sub(CODGEO,1,2)==code_dep)

  pop_concernee_communes <- map_df(sort(unique(Facteur_multi_Age_Sexe_Spe$exe_spe)),function(x){
    BTX_TD_POP1B_zone_cible %>%
      gather(key = "Age_Sexe", value = "Pop", -c("CODGEO", "LIBGEO")) %>%
      mutate(
        Sexe = str_split_fixed(Age_Sexe, "_", 2)[, 1],
        Age = str_split_fixed(Age_Sexe, "_", 2)[, 2],
        Sexe = as.numeric(str_remove(Sexe, "SEXE")),
        Age = as.numeric(str_remove(Age, "AGED100"))
      ) %>%
      left_join(Age, by = c("Age" = "Age_Insee")) %>%
      group_by(CODGEO,Sexe, Age_Damir) %>%
      summarise(Pop = sum(Pop, na.rm = T)) %>%
      ungroup()  %>%
      left_join(
        Facteur_multi_Age_Sexe_Spe %>%
          filter(exe_spe == x) %>%
          select(AGE_BEN_SNDS, BEN_SEX_COD, Multiplicateur),
        by = c("Age_Damir" = "AGE_BEN_SNDS", "Sexe" = "BEN_SEX_COD")
      ) %>%
      mutate(Pop = Pop * Multiplicateur) %>%
      select(-Multiplicateur) %>%
      group_by(CODGEO) %>%
      summarise(Pop = sum(Pop)) %>%
      mutate(exe_spe=x)
  })

  commune_fr_zone_cible_Ensemble_APL_calc <- commune_fr_zone_cible_Ensemble_APL_calc %>%
    left_join(pop_concernee_communes %>%
                mutate(CODGEO=as.character(CODGEO)),
              by=c("INSEE_COM"="CODGEO","code_praticien"="exe_spe")
    )
  commune_fr_zone_cible_Ensemble_APL_calc <- commune_fr_zone_cible_Ensemble_APL_calc %>%
    left_join(Pop_tot_tampon_195 %>%
                mutate(CODGEO=as.character(CODGEO)) %>%
                rename(PopTot=Pop),
              by=c("INSEE_COM"="CODGEO")
    ) %>%
    mutate(Pop=ifelse(is.na(Pop),PopTot,
                      ifelse(Pop>PopTot,PopTot,Pop)))

  st_crs(commune_fr_zone_cible_Ensemble_APL_calc) <- 4326

  # saveRDS(commune_fr_zone_cible_Ensemble_APL_calc, paste0(data_folder,"/commune_fr_",code_dep,"_Ensemble_APL_calc.rds"))
  return(list(
    "zone_cible"=zone_cible,
    "commune_chef_lieu_zone_cible"=commune_chef_lieu_zone_cible,
    "commune_chef_lieu_tampon_zone_cible_195"=commune_chef_lieu_tampon_zone_cible_195,
    "commune_chef_lieu_tampon_zone_cible_130"=commune_chef_lieu_tampon_zone_cible_130,
    "commune_chef_lieu_tampon_zone_cible_97.5"=commune_chef_lieu_tampon_zone_cible_97.5,
    "commune_chef_lieu_tampon_zone_cible_65"=commune_chef_lieu_tampon_zone_cible_65,
    "ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir"=ExtractionMonoTable_CAT18_ToutePopulation_tampon_zone_cible_rens_damir,
    "dist_mat_communes_zone_cible_praticien"=dist_mat_communes_zone_cible_praticien,
    "apl"=apl,
    "commune_fr_zone_cible_Ensemble_APL_calc"=commune_fr_zone_cible_Ensemble_APL_calc))
}
arnaudmilet/medtRucks documentation built on March 24, 2022, 9:08 p.m.