#' 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))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.