R/mt_crea_elements_par_dep.R
In arnaudmilet/medtRucks: Package de préparation et de valorisation des données brutes de mesure d'accès aux soins en France
Defines functions
mt_crea_elements_par_dep
Documented in
mt_crea_elements_par_dep
#' Création d'un ensemble de tables et d'éléments visuels liés aux apl
#'
#' @param code_dep Code INSEE du département (France métropole)
#' @param zonage_cpts Table contenant au moins 3 variables (communes: code INSEE des communes du CPTS, id: code du CPTS et lib: Nom du CPTS)
#' @param Zonage_MG Table du Zonage conventionnel des médecins généralistes de l'ARS-DGOS contenant au moins 3 variables ("Code": Code INSEE des communes,"Libellé": Nom de la zone,"Zonage_MG": Classe de la zone parmi les 8 classes existantes)
#' @param Pop_proj_prepa_communes Table générée par la fonction mt_creation_tables_projections_population
#' @param Pop_proj Table générée par la fonction mt_creation_tables_projections_population
#' @param Pop_passe Table générée par la fonction mt_creation_tables_projections_population
#' @param commune_fr Table sf des limites communales en projection WGS84
#' @param epci_fr Table sf des limites intercommunales en projection WGS84
#' @param dep_fr Table sf des limites départementales en projection WGS84
#' @param Correspondance_communes_tvs Table de correspondance commune-Territoire de vie et de santé ayant au moins 3 variables ("INSEE_COM": code INSEE des communes,"Code_TVS": code du territoire de vie et de santé et "Nom_TVS": nom du territoire de vie et de santé)
#' @param commune_chef_lieu_dep_cible Emplacement de la mairie des communes en projection WGS84. sf généré par la fonction mt_calcul_apl
#' @param commune_fr_dep_cible_Ensemble_APL_calc sf généré par la fonction mt_calcul_apl contenant en particulier la variable apl par spécialité
#' @param ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir table générée par la fonction mt_calcul_apl
#' @param nb_actes_par_praticien Table générée par la fonction mt_crea_nb_actes_par_praticien
#' @param url_osrm Chaîne de caractères contenant l'url du moteur de recherche OSRM. Par défaut, il est NULL
#'
#' @return une liste contenant 8 éléments : dist_mat_commune_chef_lieu_dep_cible,Zonage_ars_communes,Zonage_ars,Ensemble_communes_zonage_geo_nest_dep_cible,Pop_proj_prepa_ensemble_zonage,Pop_passe_ensemble_zonage,Offre_Besoin,Patientele_potentielle_sous_seuil_dep
#' @seealso \code{\link{mt_creation_tables_projections_population}}, \code{\link{Pop_proj_prepa_communes}}, \code{\link{Pop_proj}}, \code{\link{Pop_passe}}, \code{\link{Zonage_MG}},\code{\link{commune_fr}},\code{\link{epci_fr}},\code{\link{dep_fr}},\code{\link{Correspondance_communes_tvs}},\code{\link{commune_chef_lieu_dep_cible}} et \code{\link{mt_crea_nb_actes_par_praticien}}
#' @export
#'
#' @examples
#' \dontrun{
#' library(tidyverse)
#' library(sf)
#' Zonage_MG <- readRDS("data_init/ARS_DGOS/2021/Zonage_MG.rds")
#' Pop_proj_prepa_communes <- readRDS("data_init/INSEE/2018/Pop_proj_prepa_communes.rds")
#' Pop_proj <- readRDS("data_init/INSEE/2018/Pop_proj.rds")
#' Pop_passe <- readRDS("data_init/INSEE/2018/Pop_passe.rds")
#' commune_fr = readRDS("data_init/IGN/2022/commune_fr.rds")
#' epci_fr = readRDS("data_init/IGN/2022/epci_fr.rds")
#' dep_fr = readRDS("data_init/IGN/2022/dep_fr.rds")
#' Correspondance_communes_tvs <- readRDS("data_init/ARS_DGOS/2021/Correspondance_communes_tvs.rds")
#' zonage_cpts=NULL
#' seuil_APL <- c("generaliste" = 2.5, "speciliste" = 1)
#'
#' emplacement_ensemble_data = "data_final/"
#' type_calcul = "departement"
#' url_osrm = "http://51.158.69.224:5999/"
#' nb_actes_par_praticien <- readRDS("data_init/AMELI/2020/nb_actes_par_praticien.rds")
#' walk(as.character(c(52,54,55)),function(code_dep){
#' print(code_dep)
#'
#' chemin_data <- paste0(emplacement_ensemble_data,code_dep)
#'
#' commune_chef_lieu_dep_cible <- readRDS(paste0(chemin_data,"/","commune_chef_lieu_",code_dep,".rds"))
#' commune_fr_dep_cible_Ensemble_APL_calc <- readRDS(paste0(chemin_data,"/","commune_fr_",code_dep,"_Ensemble_APL_calc.rds"))
#' ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir <- readRDS(paste0(chemin_data,"/ExtractionMonoTable_CAT18_ToutePopulation_tampon_",code_dep,"_rens_damir.rds"))
#'
#' data_folder <- paste0(emplacement_ensemble_data,code_dep)
#'
#' valeur <- mt_crea_elements_par_dep(code_dep=code_dep,Zonage_MG=Zonage_MG,Pop_proj_prepa_communes=Pop_proj_prepa_communes,Pop_proj=Pop_proj,Pop_passe=Pop_passe,commune_fr=commune_fr,epci_fr=epci_fr,dep_fr=dep_fr,Correspondance_communes_tvs=Correspondance_communes_tvs,commune_chef_lieu_dep_cible=commune_chef_lieu_dep_cible,commune_fr_dep_cible_Ensemble_APL_calc=commune_fr_dep_cible_Ensemble_APL_calc,ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir=ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir,nb_actes_par_praticien=nb_actes_par_praticien,url_osrm=url_osrm)
#'
#'
#' walk(names(valeur),function(x){
#' nom_enregistrement <- bind_rows(
#' c(Nom_objet="dist_mat_commune_chef_lieu_dep_cible",Nom_enregistre = paste0(data_folder,"/dist_mat_commune_chef_lieu_",code_dep,".rds")),
#' c(Nom_objet="Zonage_ars_communes",Nom_enregistre = paste0(data_folder,"/Zonage_ars_communes_",code_dep,".rds")),
#' c(Nom_objet="Zonage_ars",Nom_enregistre = paste0(data_folder,"/Zonage_ars_",code_dep,".rds")),
#' c(Nom_objet="Ensemble_communes_zonage_geo_nest_dep_cible",Nom_enregistre = paste0(data_folder,"/Ensemble_communes_zonage_geo_nest_",code_dep,".rds")),
#' c(Nom_objet="Pop_proj_prepa_ensemble_zonage",Nom_enregistre = paste0(data_folder,"/Pop_proj_prepa_ensemble_zonage.rds")),
#' c(Nom_objet="Pop_passe_ensemble_zonage",Nom_enregistre =paste0(data_folder,"/Pop_passe_ensemble_zonage.rds")),
#' c(Nom_objet="Offre_Besoin",Nom_enregistre = paste0(data_folder,"/Offre_Besoin.rds")),
#' c(Nom_objet="Patientele_potentielle_sous_seuil_dep",Nom_enregistre =paste0(data_folder,"/Patientele_potentielle_sous_seuil_dep.rds") )
#' )%>%
#' filter(Nom_objet==x) %>%
#' pull(Nom_enregistre)
#'
#' saveRDS(valeur[[x]],nom_enregistrement)
#'
#' })
#' })
#' }
#' @importFrom dplyr filter pull as_tibble select left_join mutate tibble group_by summarise rename distinct bind_rows summarise_all bind_cols arrange n ungroup contains
#' @importFrom osrm osrmTable
#' @importFrom purrr set_names map_df map
#' @importFrom scales percent
#' @importFrom sf st_union
#' @importFrom stats setNames quantile median IQR
#' @importFrom stringr str_to_lower str_remove str_sub str_pad
#' @importFrom tidyr nest spread unnest
mt_crea_elements_par_dep <- function(code_dep,zonage_cpts=NULL,Zonage_MG,Pop_proj_prepa_communes,Pop_proj,Pop_passe,commune_fr,epci_fr,dep_fr,Correspondance_communes_tvs,commune_chef_lieu_dep_cible,commune_fr_dep_cible_Ensemble_APL_calc,ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir,nb_actes_par_praticien,url_osrm=NULL){
if(type_calcul=="commune"){
code_dep <- commune_fr %>%
dplyr::filter(INSEE_COM%in%code_commune) %>%
dplyr::pull(INSEE_DEP) %>%
unique()
}
if(type_calcul!="commune"){
code_reg <- as.data.frame(correspondance_dep_reg)[which(correspondance_dep_reg$departmentCode == stringr::str_to_lower(code_dep)),"regionCode"]
}else{
code_reg <- commune_fr %>%
dplyr::filter(INSEE_COM%in%code_commune) %>%
dplyr::pull(INSEE_REG) %>%
unique()
}
rownames(commune_chef_lieu_dep_cible) <- commune_chef_lieu_dep_cible$INSEE_COM
if(!is.null(url_osrm)){
options(osrm.server = url_osrm)
}
cat("Calcul distance\n")
dist_mat_commune_chef_lieu_dep_cible <- osrm::osrmTable(src = commune_chef_lieu_dep_cible, dst = commune_chef_lieu_dep_cible)
if(type_calcul!="commune"){
commune_fr_zone_cible <- commune_fr %>%
dplyr::filter(INSEE_DEP == code_dep)
}else{
commune_fr_zone_cible <- commune_fr %>%
dplyr::filter(INSEE_COM %in% code_commune)
}
cat("Zonage ARS\n")
Zonage_ars_communes <- commune_fr_zone_cible %>%
dplyr::as_tibble() %>%
dplyr::select(-geometry) %>%
dplyr::left_join(Zonage_MG %>%
dplyr::select(Code,Zonage_MG) %>%
dplyr::mutate(Zonage_MG=factor(Zonage_MG,
labels = c("1 - ZIP ","2 - ZAC ","3 - QPV en ZIP ","4 - QPV en ZAC","5 - Zone de vigilance", "6 - Hors zonage","7 - GQ en ZAC","8 - GQ en ZIP"))
), by=c("INSEE_COM"="Code"))
correspondance_hachures_zonages_MG <- dplyr::tibble(
Zonage_MG = c("1 - ZIP ","2 - ZAC ","3 - QPV en ZIP ","4 - QPV en ZAC","5 - Zone de vigilance", "6 - Hors zonage","7 - GQ en ZAC","8 - GQ en ZIP"),
pattern= c("horizontal", "vertical","left2right","right2left","hexagon","diamond","grid","zigzag"),
angle= round(seq(0,145,length.out=8),0)
)
# Zonage_ars_hach <- commune_fr_zone_cible %>%
# left_join(Zonage_MG %>%
# select(Code,Zonage_MG) %>%
# mutate(Zonage_MG=factor(Zonage_MG,
# labels = c("1 - ZIP ","2 - ZAC ","3 - QPV en ZIP ","4 - QPV en ZAC","5 - Zone de vigilance", "6 - Hors zonage","7 - GQ en ZAC","8 - GQ en ZIP"))
# ), by=c("INSEE_COM"="Code")) %>%
# group_by(Zonage_MG) %>%
# summarise() %>%
# st_cast("POLYGON") %>%
# left_join(
# correspondance_hachures_zonages_MG,by="Zonage_MG"
# )
# mutate(
# geometry = hatched.SpatialPolygons(geometry,density = 40,angle = angle)$geometry
# ) %>%
# select(-angle,-pattern)
Zonage_ars <- commune_fr_zone_cible %>%
dplyr::left_join(Zonage_MG %>%
dplyr::select(Code,Zonage_MG) %>%
dplyr::mutate(Zonage_MG=factor(Zonage_MG,
labels = c("1 - ZIP ","2 - ZAC ","3 - QPV en ZIP ","4 - QPV en ZAC","5 - Zone de vigilance", "6 - Hors zonage","7 - GQ en ZAC","8 - GQ en ZIP"))
), by=c("INSEE_COM"="Code")) %>%
dplyr::group_by(Zonage_MG) %>%
dplyr::summarise()
# test_validite_Zonage_ars_hach <- summarise(Zonage_ars) %>%
# sf::st_cast("POLYGON") %>%
# mutate(
# valid= map_lgl(geometry,function(x){
# # print(x)
# res <- tryCatch( hatched.SpatialPolygons(x,density = 40,angle = rep(c(45,135),length.out=1)), error = function(e) F)
# if(class(res)=="sf"){
# res <- T
# }else{
# res <- F
# }
# res
# })
#
# )
#
# Zonage_ars_hach <- Zonage_ars %>%
# st_intersection(test_validite_Zonage_ars_hach)%>%
# group_by(Zonage_MG,valid) %>%
# nest() %>%
# mutate(data2=pmap(list(data,valid,Zonage_MG),function(x,y,z){
# if(y){
# hatched.SpatialPolygons(x,density = 40,angle = rep(c(45,135),length.out=nrow(x))) %>%
# mutate(Zonage_MG=z)
# }else{
# x %>%
# st_cast("MULTILINESTRING") %>%
# mutate(ID="1",
# Zonage_MG=z)
# }
# })) %>%
# ungroup() %>%
# select(data2) %>%
# do.call("bind_rows",.) %>%
# mutate(ID=as.numeric(Zonage_MG),
# ID=as.character(dense_rank(ID)))
#
cat("Ensemble des d\u00e9coupages\n")
Ensemble_communes_dep_cible <- commune_fr_zone_cible %>%
dplyr::as_tibble() %>%
dplyr::left_join(dep_fr %>%
as.data.frame() %>%
dplyr::select(NOM,INSEE_DEP) %>%
dplyr::rename(lib_dep=NOM),by="INSEE_DEP") %>%
dplyr::left_join(epci_fr %>%
as.data.frame() %>%
dplyr::select(NOM,CODE_SIREN) %>%
dplyr::rename(lib_epci=NOM),by=c("SIREN_EPCI"="CODE_SIREN")) %>%
dplyr::left_join(Correspondance_communes_tvs,by="INSEE_COM") %>%
dplyr::select(INSEE_COM,
NOM,
SIREN_EPCI ,
lib_epci,
Code_TVS,
Nom_TVS,
INSEE_DEP,
lib_dep,
POPULATION) %>%
purrr::set_names("CODGEO",
"LIBGEO",
"EPCI",
"LIB_EPCI",
"Code_TVS",
"Nom_TVS",
"DEP",
"LIB_DEP",
"POPULATION")
if(is.null(zonage_cpts)){
Ensemble_communes_dep_cible <- Ensemble_communes_dep_cible %>%
dplyr::mutate(
Id_cpts=NA,
Nom_cpts=NA)
}else{
Ensemble_communes_dep_cible <- Ensemble_communes_dep_cible %>%
dplyr::mutate(
Id_cpts=ifelse(CODGEO %in% zonage_cpts$communes,zonage_cpts$id,NA),
Nom_cpts=ifelse(CODGEO %in% zonage_cpts$communes,zonage_cpts$lib,NA))
}
Ensemble_communes_commune_dep_cible <- Ensemble_communes_dep_cible %>%
dplyr::distinct(CODGEO,LIBGEO,POPULATION) %>%
dplyr::mutate(
codgeo_zonage=CODGEO,
libgeo_zonage=LIBGEO,
typegeo="commune"
)
Ensemble_communes_EPCI_dep_cible<-Ensemble_communes_dep_cible %>%
dplyr::distinct(EPCI) %>%
as.data.frame() %>%
"["(,"EPCI") %>%
purrr::map_df(function(x){
Ensemble_communes_dep_cible %>%
dplyr::filter(EPCI==x) %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO,
LIBGEO,
EPCI,
LIB_EPCI,
POPULATION) %>%
stats::setNames(c("CODGEO",
"LIBGEO",
"codgeo_zonage",
"libgeo_zonage",
"POPULATION")) %>%
dplyr::mutate(typegeo="EPCI")
})
Ensemble_communes_CPTS_dep_cible<-Ensemble_communes_dep_cible %>%
dplyr::distinct(Id_cpts) %>%
dplyr::filter(!is.na(Id_cpts)) %>%
as.data.frame() %>%
"["(,"Id_cpts") %>%
purrr::map_df(function(x){
Ensemble_communes_dep_cible %>%
dplyr::filter(Id_cpts==x) %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO,
LIBGEO,
Id_cpts,
Nom_cpts,
POPULATION) %>%
stats::setNames(c("CODGEO",
"LIBGEO",
"codgeo_zonage",
"libgeo_zonage",
"POPULATION")) %>%
dplyr::mutate(typegeo="CPTS")
})
Ensemble_communes_DEP_dep_cible<-Ensemble_communes_dep_cible %>%
dplyr::distinct(DEP) %>%
dplyr::filter(!is.na(DEP)) %>%
as.data.frame() %>%
"["(,"DEP") %>%
purrr::map_df(function(x){
Ensemble_communes_dep_cible %>%
dplyr::filter(DEP==x) %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO,
LIBGEO,
DEP,
LIB_DEP,
POPULATION) %>%
stats::setNames(c("CODGEO",
"LIBGEO",
"codgeo_zonage",
"libgeo_zonage",
"POPULATION")) %>%
dplyr::mutate(typegeo="DEP")
})
Ensemble_communes_TVS_dep_cible <- Ensemble_communes_dep_cible %>%
dplyr::distinct(Code_TVS) %>%
dplyr::filter(!is.na(Code_TVS)) %>%
dplyr::pull(Code_TVS) %>%
purrr::map_df(function(x){
Ensemble_communes_dep_cible %>%
dplyr::filter(Code_TVS==x) %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO,
LIBGEO,
Code_TVS,
Nom_TVS,
POPULATION) %>%
stats::setNames(c("CODGEO",
"LIBGEO",
"codgeo_zonage",
"libgeo_zonage",
"POPULATION")) %>%
dplyr::mutate(typegeo="TVS")
})
Ensemble_communes_zonage_geo_dep_cible<-dplyr::bind_rows(
Ensemble_communes_commune_dep_cible,
Ensemble_communes_EPCI_dep_cible,
Ensemble_communes_CPTS_dep_cible,
Ensemble_communes_TVS_dep_cible,
Ensemble_communes_DEP_dep_cible
)
Ensemble_communes_zonage_geo_nest_dep_cible<-Ensemble_communes_zonage_geo_dep_cible %>%
dplyr::group_by(codgeo_zonage,libgeo_zonage,typegeo) %>%
tidyr::nest()
Ensemble_communes_zonage_geo_nest_dep_cible <- Ensemble_communes_zonage_geo_nest_dep_cible %>%
dplyr::mutate(geometry=purrr::map(data, ~ sf::st_union(dplyr::filter(commune_fr_zone_cible,INSEE_COM %in% .$CODGEO)))
)
cat("Projections de population\n")
Pop_proj_prepa_ensemble_zonage <- purrr::map_df(1:nrow(Ensemble_communes_zonage_geo_nest_dep_cible),function(x){
Pop_proj %>%
dplyr::filter(CODGEO %in% Ensemble_communes_zonage_geo_nest_dep_cible$data[[x]]$CODGEO) %>%
dplyr::group_by(sexe,An,Classe_Age) %>%
dplyr::summarise(
Pop=sum(Pop),
Pop_2030_Proj_central =sum(Pop_2030_Proj_central ),
Pop_2030_Proj_basse =sum(Pop_2030_Proj_basse),
Pop_2030_Proj_haute =sum(Pop_2030_Proj_haute )
) %>%
dplyr::mutate(
Pop_Graph = ifelse(sexe=="Homme",-1*Pop,Pop),
Pop_2030_Proj_central_Graph = ifelse(sexe=="Homme",-1*Pop_2030_Proj_central,Pop_2030_Proj_central),
Pop_2030_Proj_basse_Graph = ifelse(sexe=="Homme",-1*Pop_2030_Proj_basse,Pop_2030_Proj_basse),
Pop_2030_Proj_haute_Graph = ifelse(sexe=="Homme",-1*Pop_2030_Proj_haute,Pop_2030_Proj_haute)
)%>%
dplyr::mutate(ageno = as.numeric(Classe_Age) - 0.5)%>%
dplyr::mutate(ageno=ifelse(Classe_Age=="95 ans et +",ageno+1,ageno)) %>%
dplyr::mutate(
codgeo_zonage=Ensemble_communes_zonage_geo_nest_dep_cible$codgeo_zonage[x],
typegeo=Ensemble_communes_zonage_geo_nest_dep_cible$typegeo[x])
})
Pop_proj_prepa_ensemble_zonage <- Pop_proj_prepa_communes %>%
dplyr::filter(dep==code_dep) %>%
dplyr::select(-dep) %>%
dplyr::rename("codgeo_zonage"="CODGEO") %>%
dplyr::bind_rows(
Pop_proj_prepa_ensemble_zonage
)
cat("Population pass\u00e9e\n")
Pop_passe_commune <- Pop_passe %>%
dplyr::filter(DEP==code_dep) %>%
dplyr::select(-DEP) %>%
dplyr::group_by(CODGEO,key) %>%
dplyr::summarise_all(sum,na.rm=T)
Pop_passe_commune <- Pop_passe_commune %>%
dplyr::group_by(CODGEO) %>%
tidyr::nest() %>%
dplyr::mutate(
synthese_pop_passe=purrr::map(data,function(df){
df %>%
dplyr::filter(key!="Indice_Viellissement") %>%
dplyr::bind_rows(
dplyr::tibble(
key="Indice_Viellissement"
) %>%
dplyr::bind_cols(
as.data.frame(df[which(df$key=="Plus de 65 ans"),2:3])/
as.data.frame(df[which(df$key=="Moins de 20 ans"),2:3])*100
)
) %>%
dplyr::mutate(Evol=((.[[length(.)-1]]/.[[length(.)]])^(1/5))-1) %>%
dplyr::filter(
key %in% c("Pop_tot","Plus de 65 ans","Moins de 20 ans","Indice_Viellissement")
) %>%
dplyr::select(key,Evol) %>%
dplyr::mutate(Evol=scales::percent(Evol,accuracy = 0.1)) %>%
tidyr::spread(key=key,value=Evol) %>%
dplyr::select("Pop_tot","Plus de 65 ans","Moins de 20 ans","Indice_Viellissement")
})
)
Pop_passe_ensemble_zonage <- purrr::map_df(1:nrow(Ensemble_communes_zonage_geo_nest_dep_cible),function(x){
Pop_passe_zone <- Pop_passe %>%
dplyr::filter(CODGEO %in% Ensemble_communes_zonage_geo_nest_dep_cible$data[[x]]$CODGEO) %>%
dplyr::select(-c("CODGEO","DEP")) %>%
dplyr::group_by(key) %>%
dplyr::summarise_all(sum,na.rm=T)
Pop_passe_zone <- Pop_passe_zone %>%
dplyr::filter(key!="Indice_Viellissement") %>%
dplyr::bind_rows(
dplyr::tibble(
key="Indice_Viellissement"
) %>%
dplyr::bind_cols(
as.data.frame(Pop_passe_zone[which(Pop_passe_zone$key=="Plus de 65 ans"),2:3])/
as.data.frame(Pop_passe_zone[which(Pop_passe_zone$key=="Moins de 20 ans"),2:3])*100
)
) %>%
dplyr::mutate(Evol=((.[[length(.)-1]]/.[[length(.)]])^(1/5))-1) %>%
dplyr::filter(
key %in% c("Pop_tot","Plus de 65 ans","Moins de 20 ans","Indice_Viellissement")
) %>%
dplyr::select(key,Evol) %>%
dplyr::mutate(Evol=scales::percent(Evol,accuracy = 0.1)) %>%
tidyr::spread(key=key,value=Evol) %>%
dplyr::select("Pop_tot","Plus de 65 ans","Moins de 20 ans","Indice_Viellissement") %>%
dplyr::mutate(
codgeo_zonage=Ensemble_communes_zonage_geo_nest_dep_cible$codgeo_zonage[x],
typegeo=Ensemble_communes_zonage_geo_nest_dep_cible$typegeo[x])
})
Pop_passe_ensemble_zonage <- Pop_passe_commune %>%
dplyr::select(-data) %>%
dplyr::rename("codgeo_zonage"="CODGEO") %>%
dplyr::mutate(
typegeo="commune"
) %>%
tidyr::unnest() %>%
dplyr::bind_rows(
Pop_passe_ensemble_zonage
)
# cat("Pyramide des \u00e2ges\n")
# Pop_proj_prepa_ensemble_zonage_demo_pyr<- Pop_proj_prepa_ensemble_zonage %>%
# # filter(codgeo_zonage==x[2]) %>%
# group_by(codgeo_zonage,typegeo ) %>%
# nest() %>%
# mutate(
# Pyramide = purrr::map(data, ~ ggplot(., aes(x = Classe_Age, y = Pop_Graph , fill = sexe)) +
# geom_bar(data = . %>% filter(sexe == "Femme"), stat = "identity") +
# geom_bar(data = . %>% filter(sexe == "Homme"), stat = "identity") +
# scale_fill_manual("Sexe",values = c("#00a1bd","#005D6E")) +
# geom_step(data =. %>% filter(sexe == "Femme"),
# aes(x = ageno,y=Pop_2030_Proj_central_Graph,color="orange")) +
# geom_step(data =. %>% filter(sexe == "Homme"),
# aes(x = ageno,y = Pop_2030_Proj_central_Graph,color="orange"))+
#
# geom_step(data =. %>% filter(sexe == "Femme"),
# aes(x = ageno,y=Pop_2030_Proj_basse_Graph,color="red")) +
# geom_step(data =. %>% filter(sexe == "Homme"),
# aes(x = ageno,y = Pop_2030_Proj_basse_Graph,color="red"))+
#
# geom_step(data =. %>% filter(sexe == "Femme"),
# aes(x = ageno,y=Pop_2030_Proj_haute_Graph,color="green")) +
# geom_step(data =. %>% filter(sexe == "Homme"),
# aes(x = ageno,y = Pop_2030_Proj_haute_Graph,color="green"))+
# scale_y_continuous(labels = abs)+
# theme(legend.title.align = 0.5)+
# scale_color_identity(name = "Scenario\nde\nprojection\n2030",
# breaks = c("orange", "red", "green"),
# labels = c("Central", "Pop. basse", "Pop. haute"),
# guide = "legend")+
# coord_flip()+
# ylab("Population")+
# xlab("Tranche d\'Age")
# )
# )%>%
# mutate(
# synthese_demo =purrr::map(data, function(df){
# df %>%
# mutate(Classe_Age_Simpli=case_when(
# as.numeric(Classe_Age) < 5 ~ "Moins de 20 ans",
# as.numeric(Classe_Age) > 13 ~"Plus de 65 ans",
# TRUE ~"Autres" )) %>%
# group_by(Classe_Age_Simpli) %>%
# summarise(
# Pop=sum(Pop),
# Pop_2030_Proj_central =sum(Pop_2030_Proj_central ),
# Pop_2030_Proj_basse =sum(Pop_2030_Proj_basse),
# Pop_2030_Proj_haute =sum(Pop_2030_Proj_haute )
# ) %>%
# gather(key="key",value="value",-"Classe_Age_Simpli") %>%
# spread(key = "Classe_Age_Simpli",value = "value") %>%
# mutate(
# Pop_tot=`Plus de 65 ans`+ Autres +`Moins de 20 ans`,
# `Part Plus de 65 ans`=`Plus de 65 ans`/Pop_tot,
# `Part Moins de 20 ans`=`Moins de 20 ans`/Pop_tot,
# Indice_Viellissement=`Plus de 65 ans`/`Moins de 20 ans`*100) %>%
# mutate(
# evol_Pop_tot = scales::percent(Pop_tot/.$Pop_tot[1]-1),
# evol_Moins_20 = scales::percent(`Moins de 20 ans`/.$`Moins de 20 ans`[1]-1),
# evol_Plus_65 = scales::percent(`Plus de 65 ans`/.$`Plus de 65 ans`[1]-1),
# evol_Indice_Viellissement = scales::percent(Indice_Viellissement/.$Indice_Viellissement[1]-1)) %>%
# mutate(key=c("2018","Projection 2030 - Scenario pessimiste (population basse)","Projection 2030 - Scenario central","Projection 2030 - Scenario optimiste (population haute)"))
# })
# ) %>%
# mutate(
# synthese_demo_ValAbso=purrr::map(synthese_demo,function(df){
# df %>%
# select(key,Pop_tot,`Part Moins de 20 ans`,`Part Plus de 65 ans`,Indice_Viellissement) %>%
# mutate_at(vars(3,4),scales::percent,accuracy=0.1) %>%
# set_names(c("Annee/Type de projection","Pop. Totale","Part des moins de 20 ans","Part des plus de 65 ans","Indice de vieillissement"))
# }),
# synthese_demo_Evo = purrr::map(synthese_demo,function(df){
# df %>%
# select(key,evol_Pop_tot,evol_Moins_20,evol_Plus_65,evol_Indice_Viellissement) %>%
# filter(key!="2018") %>%
# set_names(c("Type de projection","Evol. Pop. Totale","Evol. moins de 20 ans","Evol. plus de 65 ans","Evol. Indice de vieillissement"))
# })
# )
#
#
# Pop_proj_prepa_ensemble_zonage_demo_pyr <- Pop_proj_prepa_ensemble_zonage_demo_pyr %>%
# left_join(Pop_passe_ensemble_zonage %>%
# group_by(codgeo_zonage,typegeo) %>%
# nest() %>%
# rename("Pop_passe"="data"),
# by=c("codgeo_zonage","typegeo")
# )
#
cat("Offre et besoin\n")
liste_specialites <- commune_fr_dep_cible_Ensemble_APL_calc %>%
dplyr::as_tibble() %>%
dplyr::select(code_praticien, Lib_praticien) %>%
dplyr::distinct() %>%
dplyr::mutate(Lib_etiquette = ifelse(Lib_praticien == "APL DREES 2018", Lib_praticien, stringr::str_remove(stringr::str_sub(Lib_praticien, 4, 1000), "TOTAL "))) %>%
dplyr::arrange(code_praticien)
Offre_Besoin <- purrr::map_df(1:nrow(Ensemble_communes_zonage_geo_nest_dep_cible), function(x) {
commune_fr_dep_cible_Ensemble_APL_calc %>%
dplyr::as_tibble() %>%
dplyr::mutate(INSEE_COM = stringr::str_pad(INSEE_COM,width=5,side="left",pad="0")) %>%
dplyr::filter(INSEE_COM %in% Ensemble_communes_zonage_geo_nest_dep_cible$data[[x]]$CODGEO) %>%
dplyr::left_join(liste_specialites,
by = "code_praticien"
) %>%
dplyr::left_join(Ensemble_communes_dep_cible %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO, POPULATION), by = c("INSEE_COM" = "CODGEO")) %>%
dplyr::mutate(Pop_sous_seuil = ifelse(apl < ifelse(code_praticien == 1, seuil_APL[1], seuil_APL[2]), Pop, 0)) %>%
dplyr::left_join(
ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir %>%
dplyr::mutate(exe_spe = as.numeric(exe_spe)) %>%
dplyr::left_join(liste_specialites, by = c("exe_spe" = "code_praticien")) %>%
dplyr::group_by(Lib_etiquette, `Code commune (coord. structure)`) %>%
dplyr::summarise("Nombre de praticiens" = dplyr::n()),
by = c("Lib_etiquette", "INSEE_COM" = "Code commune (coord. structure)")
) %>%
dplyr::group_by(code_praticien, Lib_etiquette) %>%
dplyr::summarise(
"Pop - 2018" = sum(PopTot, na.rm = T),
"Nombre de praticiens" = sum(`Nombre de praticiens`, na.rm = T),
"Pop concernee par la specialite - 2018" = sum(Pop, na.rm = T),
"Pop concernee par la specialite et sous le seuil d\'acc\u00e8s - 2018" = sum(Pop_sous_seuil, na.rm = T),
"APL D10(1er decile)" = stats::quantile(apl, na.rm = T, 0.1),
"APL Q25(1er quartile)" = stats::quantile(apl, na.rm = T, 0.25),
"APL median" = stats::median(apl, na.rm = T),
"APL Q75(3eme quartile)" = stats::quantile(apl, na.rm = T, 0.75),
"APL D90(9eme decile)" = stats::quantile(apl, na.rm = T, 0.9),
"Ecart interquartiles" = stats::IQR(apl, na.rm = T),
"Ecart interdeciles" = stats::quantile(apl, 0.9, na.rm = T) - stats::quantile(apl, 0.1, na.rm = T)
) %>%
dplyr::ungroup() %>%
dplyr::select(-code_praticien) %>%
dplyr::mutate(
"Part de la pop concernee par la specialite et sous le seuil d\'acc\u00e8s - 2018" = scales::percent(`Pop concernee par la specialite et sous le seuil d'accès - 2018` / `Pop - 2018`, accuracy = 1L),
) %>%
dplyr::filter(Lib_etiquette != "APL DREES 2018") %>%
dplyr::select(c(
"Lib_etiquette",
"Nombre de praticiens",
"Pop concernee par la specialite - 2018",
"Pop concernee par la specialite et sous le seuil d\'acc\u00e8s - 2018",
"Part de la pop concernee par la specialite et sous le seuil d\'acc\u00e8s - 2018",
"APL D10(1er decile)",
"APL Q25(1er quartile)",
"APL median",
"APL Q75(3eme quartile)",
"APL D90(9eme decile)",
"Ecart interquartiles",
"Ecart interdeciles"
)) %>%
dplyr::mutate(
codgeo_zonage = Ensemble_communes_zonage_geo_nest_dep_cible$codgeo_zonage[x],
typegeo = Ensemble_communes_zonage_geo_nest_dep_cible$typegeo[x]
)
})
Offre_Besoin_2 <- purrr::map_df(1:nrow(Ensemble_communes_zonage_geo_nest_dep_cible), function(x) {
commune_fr_dep_cible_Ensemble_APL_calc %>%
dplyr::as_tibble() %>%
dplyr::mutate(INSEE_COM = stringr::str_pad(INSEE_COM,width=5,side="left",pad="0")) %>%
dplyr::filter(INSEE_COM %in% Ensemble_communes_zonage_geo_nest_dep_cible$data[[x]]$CODGEO) %>%
dplyr::left_join(liste_specialites %>%
dplyr::select(-Lib_praticien), by = "code_praticien") %>%
dplyr::left_join(Ensemble_communes_dep_cible %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO, POPULATION), by = c("INSEE_COM" = "CODGEO")) %>%
dplyr::mutate(
seuil_APL = ifelse(code_praticien == 1, seuil_APL[1], seuil_APL[2]),
Pop_sous_seuil = ifelse(apl < seuil_APL, Pop, 0),
nb_actes_sup = ifelse(apl < seuil_APL, Pop_sous_seuil * (seuil_APL - apl), 0)
) %>%
dplyr::group_by(code_praticien, Lib_praticien, Lib_etiquette) %>%
dplyr::summarise(
"Nombre d\'actes supplementaires estimes" = sum(nb_actes_sup, na.rm = T),
) %>%
dplyr::ungroup() %>%
dplyr::left_join(nb_actes_par_praticien %>%
dplyr::filter(nb_actes_par_praticien$CODE_DEPT == code_dep) %>%
dplyr::select(l_exe_spe, nb_actes_par_praticien_dep_corrige), by = c("Lib_praticien" = "l_exe_spe")) %>%
dplyr::mutate(
nb_actes_par_praticien_dep_corrige = ifelse(Lib_praticien == "APL DREES 2018",
nb_actes_par_praticien$nb_actes_par_praticien_dep_corrige[which(nb_actes_par_praticien$CODE_DEPT == "55" & nb_actes_par_praticien$Specialite == "Generalistes")],
nb_actes_par_praticien_dep_corrige
),
"Nombre de praticiens supplementaires estimes" = ifelse(is.na(nb_actes_par_praticien_dep_corrige),
"n.d",
`Nombre d'actes supplementaires estimes` / nb_actes_par_praticien_dep_corrige
)
) %>%
dplyr::select(-code_praticien, -Lib_praticien) %>%
dplyr::filter(Lib_etiquette != "APL DREES 2018") %>%
dplyr::select(c(
"Lib_etiquette",
"Nombre d\'actes supplementaires estimes", "Nombre de praticiens supplementaires estimes"
)) %>%
dplyr::mutate(
`Nombre d'actes supplementaires estimes` = as.character(`Nombre d'actes supplementaires estimes`),
`Nombre de praticiens supplementaires estimes` = as.character(`Nombre de praticiens supplementaires estimes`),
codgeo_zonage = Ensemble_communes_zonage_geo_nest_dep_cible$codgeo_zonage[x],
typegeo = Ensemble_communes_zonage_geo_nest_dep_cible$typegeo[x]
)
})
Offre_Besoin <- Offre_Besoin %>%
dplyr::group_by(codgeo_zonage, typegeo) %>%
tidyr::nest() %>%
dplyr::rename("diag_offre_besoin" = "data") %>%
dplyr::left_join(
Offre_Besoin_2 %>%
dplyr::group_by(codgeo_zonage, typegeo) %>%
tidyr::nest() %>%
dplyr::rename("potentiel_offre_besoin" = "data"),
by = c("codgeo_zonage", "typegeo")
)
cat("Patientele potentielle sous le seuil d\'acc\u00e8s\n")
Correspondance_TauxAccessibilite_Spe <- readRDS(system.file("extdata","Correspondance_TauxAccessibilite_Spe.rds",package = "medtRucks"))
TauxAccessibilite <- readRDS(system.file("extdata","TauxAccessibilite.rds",package = "medtRucks"))
Temps_max <- Correspondance_TauxAccessibilite_Spe %>%
dplyr::filter(exe_spe == 1) %>%
dplyr::select(dplyr::contains("Taux d")) %>%
as.data.frame()
Temps <- dplyr::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_communes <- length(as.character(Ensemble_communes_zonage_geo_nest_dep_cible$data[[which(Ensemble_communes_zonage_geo_nest_dep_cible$typegeo=="DEP")]]$CODGEO))
nb_communes_traitees <- 0
Patientele_potentielle_sous_seuil_dep <- purrr::map_df(as.character(Ensemble_communes_zonage_geo_nest_dep_cible$data[[which(Ensemble_communes_zonage_geo_nest_dep_cible$typegeo=="DEP")]]$CODGEO), function(x) {
nb_communes_traitees <<- nb_communes_traitees + 1
cat(paste0(x,": ",scales::percent(nb_communes_traitees/nb_communes),"\n"))
if(x %in% commune_chef_lieu_dep_cible$INSEE_COM){
Pop_sous_seuil <- purrr::map_df(1:3,function(y){
communes_zone <- names(which(dist_mat_commune_chef_lieu_dep_cible$durations[x, ] <= Temps$Temps_max[y] & dist_mat_commune_chef_lieu_dep_cible$durations[x, ] > Temps$Temps_min[y]))
if(length(communes_zone)>0){
commune_fr_dep_cible_Ensemble_APL_calc %>%
dplyr::as_tibble() %>%
dplyr::mutate(INSEE_COM=stringr::str_pad(INSEE_COM,5,"left","0")) %>%
dplyr::filter(INSEE_COM %in% communes_zone) %>%
dplyr::mutate(
seuil_APL = ifelse(code_praticien == 1, seuil_APL[1], seuil_APL[2]),
Pop_sous_seuil = ifelse(apl < seuil_APL, Pop, 0)*TauxAccessibilite[y],
nb_actes_sup = ifelse(apl < seuil_APL, Pop_sous_seuil * (seuil_APL - apl), 0)
) %>%
dplyr::group_by(code_praticien) %>%
dplyr::summarise(
Pop_sous_seuil=sum(Pop_sous_seuil,na.rm=T),
nb_actes_sup=sum(nb_actes_sup,na.rm=T)
)
}else{
dplyr::tibble(
code_praticien=NA,
Pop_sous_seuil=0,
nb_actes_sup=0
)
}
}) %>%
dplyr::group_by(code_praticien) %>%
dplyr::summarise(
Pop_sous_seuil=sum(Pop_sous_seuil,na.rm=T),
nb_actes_sup=sum(nb_actes_sup,na.rm=T)
)
}else{
Pop_sous_seuil <- dplyr::tibble(
code_praticien=NA,
Pop_sous_seuil=0,
nb_actes_sup=0
)
}
dplyr::tibble(
CODGEO=x,
"Patients sous seuil"=Pop_sous_seuil$Pop_sous_seuil,
"Actes potentiels suppl\u00e9mentaires"=Pop_sous_seuil$nb_actes_sup,
code_praticien = Pop_sous_seuil$code_praticien
)
})
Patientele_potentielle_sous_seuil_dep<-Patientele_potentielle_sous_seuil_dep %>%
dplyr::left_join(liste_specialites,by="code_praticien")
return(list(
"dist_mat_commune_chef_lieu_dep_cible"=dist_mat_commune_chef_lieu_dep_cible,
"Zonage_ars_communes"=Zonage_ars_communes,
"Zonage_ars"=Zonage_ars,
"Ensemble_communes_zonage_geo_nest_dep_cible"=Ensemble_communes_zonage_geo_nest_dep_cible,
"Pop_proj_prepa_ensemble_zonage"=Pop_proj_prepa_ensemble_zonage,
"Pop_passe_ensemble_zonage"=Pop_passe_ensemble_zonage,
"Offre_Besoin"=Offre_Besoin,
"Patientele_potentielle_sous_seuil_dep"=Patientele_potentielle_sous_seuil_dep
))
}
arnaudmilet/medtRucks documentation built on March 24, 2022, 9:08 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions mt_crea_elements_par_dep
Documented in mt_crea_elements_par_dep
#' Création d'un ensemble de tables et d'éléments visuels liés aux apl
#'
#' @param code_dep Code INSEE du département (France métropole)
#' @param zonage_cpts Table contenant au moins 3 variables (communes: code INSEE des communes du CPTS, id: code du CPTS et lib: Nom du CPTS)
#' @param Zonage_MG Table du Zonage conventionnel des médecins généralistes de l'ARS-DGOS contenant au moins 3 variables ("Code": Code INSEE des communes,"Libellé": Nom de la zone,"Zonage_MG": Classe de la zone parmi les 8 classes existantes)
#' @param Pop_proj_prepa_communes Table générée par la fonction mt_creation_tables_projections_population
#' @param Pop_proj Table générée par la fonction mt_creation_tables_projections_population
#' @param Pop_passe Table générée par la fonction mt_creation_tables_projections_population
#' @param commune_fr Table sf des limites communales en projection WGS84
#' @param epci_fr Table sf des limites intercommunales en projection WGS84
#' @param dep_fr Table sf des limites départementales en projection WGS84
#' @param Correspondance_communes_tvs Table de correspondance commune-Territoire de vie et de santé ayant au moins 3 variables ("INSEE_COM": code INSEE des communes,"Code_TVS": code du territoire de vie et de santé et "Nom_TVS": nom du territoire de vie et de santé)
#' @param commune_chef_lieu_dep_cible Emplacement de la mairie des communes en projection WGS84. sf généré par la fonction mt_calcul_apl
#' @param commune_fr_dep_cible_Ensemble_APL_calc sf généré par la fonction mt_calcul_apl contenant en particulier la variable apl par spécialité
#' @param ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir table générée par la fonction mt_calcul_apl
#' @param nb_actes_par_praticien Table générée par la fonction mt_crea_nb_actes_par_praticien
#' @param url_osrm Chaîne de caractères contenant l'url du moteur de recherche OSRM. Par défaut, il est NULL
#'
#' @return une liste contenant 8 éléments : dist_mat_commune_chef_lieu_dep_cible,Zonage_ars_communes,Zonage_ars,Ensemble_communes_zonage_geo_nest_dep_cible,Pop_proj_prepa_ensemble_zonage,Pop_passe_ensemble_zonage,Offre_Besoin,Patientele_potentielle_sous_seuil_dep
#' @seealso \code{\link{mt_creation_tables_projections_population}}, \code{\link{Pop_proj_prepa_communes}}, \code{\link{Pop_proj}}, \code{\link{Pop_passe}}, \code{\link{Zonage_MG}},\code{\link{commune_fr}},\code{\link{epci_fr}},\code{\link{dep_fr}},\code{\link{Correspondance_communes_tvs}},\code{\link{commune_chef_lieu_dep_cible}} et \code{\link{mt_crea_nb_actes_par_praticien}}
#' @export
#'
#' @examples
#' \dontrun{
#' library(tidyverse)
#' library(sf)
#' Zonage_MG <- readRDS("data_init/ARS_DGOS/2021/Zonage_MG.rds")
#' Pop_proj_prepa_communes <- readRDS("data_init/INSEE/2018/Pop_proj_prepa_communes.rds")
#' Pop_proj <- readRDS("data_init/INSEE/2018/Pop_proj.rds")
#' Pop_passe <- readRDS("data_init/INSEE/2018/Pop_passe.rds")
#' commune_fr = readRDS("data_init/IGN/2022/commune_fr.rds")
#' epci_fr = readRDS("data_init/IGN/2022/epci_fr.rds")
#' dep_fr = readRDS("data_init/IGN/2022/dep_fr.rds")
#' Correspondance_communes_tvs <- readRDS("data_init/ARS_DGOS/2021/Correspondance_communes_tvs.rds")
#' zonage_cpts=NULL
#' seuil_APL <- c("generaliste" = 2.5, "speciliste" = 1)
#'
#' emplacement_ensemble_data = "data_final/"
#' type_calcul = "departement"
#' url_osrm = "http://51.158.69.224:5999/"
#' nb_actes_par_praticien <- readRDS("data_init/AMELI/2020/nb_actes_par_praticien.rds")
#' walk(as.character(c(52,54,55)),function(code_dep){
#' print(code_dep)
#'
#' chemin_data <- paste0(emplacement_ensemble_data,code_dep)
#'
#' commune_chef_lieu_dep_cible <- readRDS(paste0(chemin_data,"/","commune_chef_lieu_",code_dep,".rds"))
#' commune_fr_dep_cible_Ensemble_APL_calc <- readRDS(paste0(chemin_data,"/","commune_fr_",code_dep,"_Ensemble_APL_calc.rds"))
#' ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir <- readRDS(paste0(chemin_data,"/ExtractionMonoTable_CAT18_ToutePopulation_tampon_",code_dep,"_rens_damir.rds"))
#'
#' data_folder <- paste0(emplacement_ensemble_data,code_dep)
#'
#' valeur <- mt_crea_elements_par_dep(code_dep=code_dep,Zonage_MG=Zonage_MG,Pop_proj_prepa_communes=Pop_proj_prepa_communes,Pop_proj=Pop_proj,Pop_passe=Pop_passe,commune_fr=commune_fr,epci_fr=epci_fr,dep_fr=dep_fr,Correspondance_communes_tvs=Correspondance_communes_tvs,commune_chef_lieu_dep_cible=commune_chef_lieu_dep_cible,commune_fr_dep_cible_Ensemble_APL_calc=commune_fr_dep_cible_Ensemble_APL_calc,ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir=ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir,nb_actes_par_praticien=nb_actes_par_praticien,url_osrm=url_osrm)
#'
#'
#' walk(names(valeur),function(x){
#' nom_enregistrement <- bind_rows(
#' c(Nom_objet="dist_mat_commune_chef_lieu_dep_cible",Nom_enregistre = paste0(data_folder,"/dist_mat_commune_chef_lieu_",code_dep,".rds")),
#' c(Nom_objet="Zonage_ars_communes",Nom_enregistre = paste0(data_folder,"/Zonage_ars_communes_",code_dep,".rds")),
#' c(Nom_objet="Zonage_ars",Nom_enregistre = paste0(data_folder,"/Zonage_ars_",code_dep,".rds")),
#' c(Nom_objet="Ensemble_communes_zonage_geo_nest_dep_cible",Nom_enregistre = paste0(data_folder,"/Ensemble_communes_zonage_geo_nest_",code_dep,".rds")),
#' c(Nom_objet="Pop_proj_prepa_ensemble_zonage",Nom_enregistre = paste0(data_folder,"/Pop_proj_prepa_ensemble_zonage.rds")),
#' c(Nom_objet="Pop_passe_ensemble_zonage",Nom_enregistre =paste0(data_folder,"/Pop_passe_ensemble_zonage.rds")),
#' c(Nom_objet="Offre_Besoin",Nom_enregistre = paste0(data_folder,"/Offre_Besoin.rds")),
#' c(Nom_objet="Patientele_potentielle_sous_seuil_dep",Nom_enregistre =paste0(data_folder,"/Patientele_potentielle_sous_seuil_dep.rds") )
#' )%>%
#' filter(Nom_objet==x) %>%
#' pull(Nom_enregistre)
#'
#' saveRDS(valeur[[x]],nom_enregistrement)
#'
#' })
#' })
#' }
#' @importFrom dplyr filter pull as_tibble select left_join mutate tibble group_by summarise rename distinct bind_rows summarise_all bind_cols arrange n ungroup contains
#' @importFrom osrm osrmTable
#' @importFrom purrr set_names map_df map
#' @importFrom scales percent
#' @importFrom sf st_union
#' @importFrom stats setNames quantile median IQR
#' @importFrom stringr str_to_lower str_remove str_sub str_pad
#' @importFrom tidyr nest spread unnest
mt_crea_elements_par_dep <- function(code_dep,zonage_cpts=NULL,Zonage_MG,Pop_proj_prepa_communes,Pop_proj,Pop_passe,commune_fr,epci_fr,dep_fr,Correspondance_communes_tvs,commune_chef_lieu_dep_cible,commune_fr_dep_cible_Ensemble_APL_calc,ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir,nb_actes_par_praticien,url_osrm=NULL){
if(type_calcul=="commune"){
code_dep <- commune_fr %>%
dplyr::filter(INSEE_COM%in%code_commune) %>%
dplyr::pull(INSEE_DEP) %>%
unique()
}
if(type_calcul!="commune"){
code_reg <- as.data.frame(correspondance_dep_reg)[which(correspondance_dep_reg$departmentCode == stringr::str_to_lower(code_dep)),"regionCode"]
}else{
code_reg <- commune_fr %>%
dplyr::filter(INSEE_COM%in%code_commune) %>%
dplyr::pull(INSEE_REG) %>%
unique()
}
rownames(commune_chef_lieu_dep_cible) <- commune_chef_lieu_dep_cible$INSEE_COM
if(!is.null(url_osrm)){
options(osrm.server = url_osrm)
}
cat("Calcul distance\n")
dist_mat_commune_chef_lieu_dep_cible <- osrm::osrmTable(src = commune_chef_lieu_dep_cible, dst = commune_chef_lieu_dep_cible)
if(type_calcul!="commune"){
commune_fr_zone_cible <- commune_fr %>%
dplyr::filter(INSEE_DEP == code_dep)
}else{
commune_fr_zone_cible <- commune_fr %>%
dplyr::filter(INSEE_COM %in% code_commune)
}
cat("Zonage ARS\n")
Zonage_ars_communes <- commune_fr_zone_cible %>%
dplyr::as_tibble() %>%
dplyr::select(-geometry) %>%
dplyr::left_join(Zonage_MG %>%
dplyr::select(Code,Zonage_MG) %>%
dplyr::mutate(Zonage_MG=factor(Zonage_MG,
labels = c("1 - ZIP ","2 - ZAC ","3 - QPV en ZIP ","4 - QPV en ZAC","5 - Zone de vigilance", "6 - Hors zonage","7 - GQ en ZAC","8 - GQ en ZIP"))
), by=c("INSEE_COM"="Code"))
correspondance_hachures_zonages_MG <- dplyr::tibble(
Zonage_MG = c("1 - ZIP ","2 - ZAC ","3 - QPV en ZIP ","4 - QPV en ZAC","5 - Zone de vigilance", "6 - Hors zonage","7 - GQ en ZAC","8 - GQ en ZIP"),
pattern= c("horizontal", "vertical","left2right","right2left","hexagon","diamond","grid","zigzag"),
angle= round(seq(0,145,length.out=8),0)
)
# Zonage_ars_hach <- commune_fr_zone_cible %>%
# left_join(Zonage_MG %>%
# select(Code,Zonage_MG) %>%
# mutate(Zonage_MG=factor(Zonage_MG,
# labels = c("1 - ZIP ","2 - ZAC ","3 - QPV en ZIP ","4 - QPV en ZAC","5 - Zone de vigilance", "6 - Hors zonage","7 - GQ en ZAC","8 - GQ en ZIP"))
# ), by=c("INSEE_COM"="Code")) %>%
# group_by(Zonage_MG) %>%
# summarise() %>%
# st_cast("POLYGON") %>%
# left_join(
# correspondance_hachures_zonages_MG,by="Zonage_MG"
# )
# mutate(
# geometry = hatched.SpatialPolygons(geometry,density = 40,angle = angle)$geometry
# ) %>%
# select(-angle,-pattern)
Zonage_ars <- commune_fr_zone_cible %>%
dplyr::left_join(Zonage_MG %>%
dplyr::select(Code,Zonage_MG) %>%
dplyr::mutate(Zonage_MG=factor(Zonage_MG,
labels = c("1 - ZIP ","2 - ZAC ","3 - QPV en ZIP ","4 - QPV en ZAC","5 - Zone de vigilance", "6 - Hors zonage","7 - GQ en ZAC","8 - GQ en ZIP"))
), by=c("INSEE_COM"="Code")) %>%
dplyr::group_by(Zonage_MG) %>%
dplyr::summarise()
# test_validite_Zonage_ars_hach <- summarise(Zonage_ars) %>%
# sf::st_cast("POLYGON") %>%
# mutate(
# valid= map_lgl(geometry,function(x){
# # print(x)
# res <- tryCatch( hatched.SpatialPolygons(x,density = 40,angle = rep(c(45,135),length.out=1)), error = function(e) F)
# if(class(res)=="sf"){
# res <- T
# }else{
# res <- F
# }
# res
# })
#
# )
#
# Zonage_ars_hach <- Zonage_ars %>%
# st_intersection(test_validite_Zonage_ars_hach)%>%
# group_by(Zonage_MG,valid) %>%
# nest() %>%
# mutate(data2=pmap(list(data,valid,Zonage_MG),function(x,y,z){
# if(y){
# hatched.SpatialPolygons(x,density = 40,angle = rep(c(45,135),length.out=nrow(x))) %>%
# mutate(Zonage_MG=z)
# }else{
# x %>%
# st_cast("MULTILINESTRING") %>%
# mutate(ID="1",
# Zonage_MG=z)
# }
# })) %>%
# ungroup() %>%
# select(data2) %>%
# do.call("bind_rows",.) %>%
# mutate(ID=as.numeric(Zonage_MG),
# ID=as.character(dense_rank(ID)))
#
cat("Ensemble des d\u00e9coupages\n")
Ensemble_communes_dep_cible <- commune_fr_zone_cible %>%
dplyr::as_tibble() %>%
dplyr::left_join(dep_fr %>%
as.data.frame() %>%
dplyr::select(NOM,INSEE_DEP) %>%
dplyr::rename(lib_dep=NOM),by="INSEE_DEP") %>%
dplyr::left_join(epci_fr %>%
as.data.frame() %>%
dplyr::select(NOM,CODE_SIREN) %>%
dplyr::rename(lib_epci=NOM),by=c("SIREN_EPCI"="CODE_SIREN")) %>%
dplyr::left_join(Correspondance_communes_tvs,by="INSEE_COM") %>%
dplyr::select(INSEE_COM,
NOM,
SIREN_EPCI ,
lib_epci,
Code_TVS,
Nom_TVS,
INSEE_DEP,
lib_dep,
POPULATION) %>%
purrr::set_names("CODGEO",
"LIBGEO",
"EPCI",
"LIB_EPCI",
"Code_TVS",
"Nom_TVS",
"DEP",
"LIB_DEP",
"POPULATION")
if(is.null(zonage_cpts)){
Ensemble_communes_dep_cible <- Ensemble_communes_dep_cible %>%
dplyr::mutate(
Id_cpts=NA,
Nom_cpts=NA)
}else{
Ensemble_communes_dep_cible <- Ensemble_communes_dep_cible %>%
dplyr::mutate(
Id_cpts=ifelse(CODGEO %in% zonage_cpts$communes,zonage_cpts$id,NA),
Nom_cpts=ifelse(CODGEO %in% zonage_cpts$communes,zonage_cpts$lib,NA))
}
Ensemble_communes_commune_dep_cible <- Ensemble_communes_dep_cible %>%
dplyr::distinct(CODGEO,LIBGEO,POPULATION) %>%
dplyr::mutate(
codgeo_zonage=CODGEO,
libgeo_zonage=LIBGEO,
typegeo="commune"
)
Ensemble_communes_EPCI_dep_cible<-Ensemble_communes_dep_cible %>%
dplyr::distinct(EPCI) %>%
as.data.frame() %>%
"["(,"EPCI") %>%
purrr::map_df(function(x){
Ensemble_communes_dep_cible %>%
dplyr::filter(EPCI==x) %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO,
LIBGEO,
EPCI,
LIB_EPCI,
POPULATION) %>%
stats::setNames(c("CODGEO",
"LIBGEO",
"codgeo_zonage",
"libgeo_zonage",
"POPULATION")) %>%
dplyr::mutate(typegeo="EPCI")
})
Ensemble_communes_CPTS_dep_cible<-Ensemble_communes_dep_cible %>%
dplyr::distinct(Id_cpts) %>%
dplyr::filter(!is.na(Id_cpts)) %>%
as.data.frame() %>%
"["(,"Id_cpts") %>%
purrr::map_df(function(x){
Ensemble_communes_dep_cible %>%
dplyr::filter(Id_cpts==x) %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO,
LIBGEO,
Id_cpts,
Nom_cpts,
POPULATION) %>%
stats::setNames(c("CODGEO",
"LIBGEO",
"codgeo_zonage",
"libgeo_zonage",
"POPULATION")) %>%
dplyr::mutate(typegeo="CPTS")
})
Ensemble_communes_DEP_dep_cible<-Ensemble_communes_dep_cible %>%
dplyr::distinct(DEP) %>%
dplyr::filter(!is.na(DEP)) %>%
as.data.frame() %>%
"["(,"DEP") %>%
purrr::map_df(function(x){
Ensemble_communes_dep_cible %>%
dplyr::filter(DEP==x) %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO,
LIBGEO,
DEP,
LIB_DEP,
POPULATION) %>%
stats::setNames(c("CODGEO",
"LIBGEO",
"codgeo_zonage",
"libgeo_zonage",
"POPULATION")) %>%
dplyr::mutate(typegeo="DEP")
})
Ensemble_communes_TVS_dep_cible <- Ensemble_communes_dep_cible %>%
dplyr::distinct(Code_TVS) %>%
dplyr::filter(!is.na(Code_TVS)) %>%
dplyr::pull(Code_TVS) %>%
purrr::map_df(function(x){
Ensemble_communes_dep_cible %>%
dplyr::filter(Code_TVS==x) %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO,
LIBGEO,
Code_TVS,
Nom_TVS,
POPULATION) %>%
stats::setNames(c("CODGEO",
"LIBGEO",
"codgeo_zonage",
"libgeo_zonage",
"POPULATION")) %>%
dplyr::mutate(typegeo="TVS")
})
Ensemble_communes_zonage_geo_dep_cible<-dplyr::bind_rows(
Ensemble_communes_commune_dep_cible,
Ensemble_communes_EPCI_dep_cible,
Ensemble_communes_CPTS_dep_cible,
Ensemble_communes_TVS_dep_cible,
Ensemble_communes_DEP_dep_cible
)
Ensemble_communes_zonage_geo_nest_dep_cible<-Ensemble_communes_zonage_geo_dep_cible %>%
dplyr::group_by(codgeo_zonage,libgeo_zonage,typegeo) %>%
tidyr::nest()
Ensemble_communes_zonage_geo_nest_dep_cible <- Ensemble_communes_zonage_geo_nest_dep_cible %>%
dplyr::mutate(geometry=purrr::map(data, ~ sf::st_union(dplyr::filter(commune_fr_zone_cible,INSEE_COM %in% .$CODGEO)))
)
cat("Projections de population\n")
Pop_proj_prepa_ensemble_zonage <- purrr::map_df(1:nrow(Ensemble_communes_zonage_geo_nest_dep_cible),function(x){
Pop_proj %>%
dplyr::filter(CODGEO %in% Ensemble_communes_zonage_geo_nest_dep_cible$data[[x]]$CODGEO) %>%
dplyr::group_by(sexe,An,Classe_Age) %>%
dplyr::summarise(
Pop=sum(Pop),
Pop_2030_Proj_central =sum(Pop_2030_Proj_central ),
Pop_2030_Proj_basse =sum(Pop_2030_Proj_basse),
Pop_2030_Proj_haute =sum(Pop_2030_Proj_haute )
) %>%
dplyr::mutate(
Pop_Graph = ifelse(sexe=="Homme",-1*Pop,Pop),
Pop_2030_Proj_central_Graph = ifelse(sexe=="Homme",-1*Pop_2030_Proj_central,Pop_2030_Proj_central),
Pop_2030_Proj_basse_Graph = ifelse(sexe=="Homme",-1*Pop_2030_Proj_basse,Pop_2030_Proj_basse),
Pop_2030_Proj_haute_Graph = ifelse(sexe=="Homme",-1*Pop_2030_Proj_haute,Pop_2030_Proj_haute)
)%>%
dplyr::mutate(ageno = as.numeric(Classe_Age) - 0.5)%>%
dplyr::mutate(ageno=ifelse(Classe_Age=="95 ans et +",ageno+1,ageno)) %>%
dplyr::mutate(
codgeo_zonage=Ensemble_communes_zonage_geo_nest_dep_cible$codgeo_zonage[x],
typegeo=Ensemble_communes_zonage_geo_nest_dep_cible$typegeo[x])
})
Pop_proj_prepa_ensemble_zonage <- Pop_proj_prepa_communes %>%
dplyr::filter(dep==code_dep) %>%
dplyr::select(-dep) %>%
dplyr::rename("codgeo_zonage"="CODGEO") %>%
dplyr::bind_rows(
Pop_proj_prepa_ensemble_zonage
)
cat("Population pass\u00e9e\n")
Pop_passe_commune <- Pop_passe %>%
dplyr::filter(DEP==code_dep) %>%
dplyr::select(-DEP) %>%
dplyr::group_by(CODGEO,key) %>%
dplyr::summarise_all(sum,na.rm=T)
Pop_passe_commune <- Pop_passe_commune %>%
dplyr::group_by(CODGEO) %>%
tidyr::nest() %>%
dplyr::mutate(
synthese_pop_passe=purrr::map(data,function(df){
df %>%
dplyr::filter(key!="Indice_Viellissement") %>%
dplyr::bind_rows(
dplyr::tibble(
key="Indice_Viellissement"
) %>%
dplyr::bind_cols(
as.data.frame(df[which(df$key=="Plus de 65 ans"),2:3])/
as.data.frame(df[which(df$key=="Moins de 20 ans"),2:3])*100
)
) %>%
dplyr::mutate(Evol=((.[[length(.)-1]]/.[[length(.)]])^(1/5))-1) %>%
dplyr::filter(
key %in% c("Pop_tot","Plus de 65 ans","Moins de 20 ans","Indice_Viellissement")
) %>%
dplyr::select(key,Evol) %>%
dplyr::mutate(Evol=scales::percent(Evol,accuracy = 0.1)) %>%
tidyr::spread(key=key,value=Evol) %>%
dplyr::select("Pop_tot","Plus de 65 ans","Moins de 20 ans","Indice_Viellissement")
})
)
Pop_passe_ensemble_zonage <- purrr::map_df(1:nrow(Ensemble_communes_zonage_geo_nest_dep_cible),function(x){
Pop_passe_zone <- Pop_passe %>%
dplyr::filter(CODGEO %in% Ensemble_communes_zonage_geo_nest_dep_cible$data[[x]]$CODGEO) %>%
dplyr::select(-c("CODGEO","DEP")) %>%
dplyr::group_by(key) %>%
dplyr::summarise_all(sum,na.rm=T)
Pop_passe_zone <- Pop_passe_zone %>%
dplyr::filter(key!="Indice_Viellissement") %>%
dplyr::bind_rows(
dplyr::tibble(
key="Indice_Viellissement"
) %>%
dplyr::bind_cols(
as.data.frame(Pop_passe_zone[which(Pop_passe_zone$key=="Plus de 65 ans"),2:3])/
as.data.frame(Pop_passe_zone[which(Pop_passe_zone$key=="Moins de 20 ans"),2:3])*100
)
) %>%
dplyr::mutate(Evol=((.[[length(.)-1]]/.[[length(.)]])^(1/5))-1) %>%
dplyr::filter(
key %in% c("Pop_tot","Plus de 65 ans","Moins de 20 ans","Indice_Viellissement")
) %>%
dplyr::select(key,Evol) %>%
dplyr::mutate(Evol=scales::percent(Evol,accuracy = 0.1)) %>%
tidyr::spread(key=key,value=Evol) %>%
dplyr::select("Pop_tot","Plus de 65 ans","Moins de 20 ans","Indice_Viellissement") %>%
dplyr::mutate(
codgeo_zonage=Ensemble_communes_zonage_geo_nest_dep_cible$codgeo_zonage[x],
typegeo=Ensemble_communes_zonage_geo_nest_dep_cible$typegeo[x])
})
Pop_passe_ensemble_zonage <- Pop_passe_commune %>%
dplyr::select(-data) %>%
dplyr::rename("codgeo_zonage"="CODGEO") %>%
dplyr::mutate(
typegeo="commune"
) %>%
tidyr::unnest() %>%
dplyr::bind_rows(
Pop_passe_ensemble_zonage
)
# cat("Pyramide des \u00e2ges\n")
# Pop_proj_prepa_ensemble_zonage_demo_pyr<- Pop_proj_prepa_ensemble_zonage %>%
# # filter(codgeo_zonage==x[2]) %>%
# group_by(codgeo_zonage,typegeo ) %>%
# nest() %>%
# mutate(
# Pyramide = purrr::map(data, ~ ggplot(., aes(x = Classe_Age, y = Pop_Graph , fill = sexe)) +
# geom_bar(data = . %>% filter(sexe == "Femme"), stat = "identity") +
# geom_bar(data = . %>% filter(sexe == "Homme"), stat = "identity") +
# scale_fill_manual("Sexe",values = c("#00a1bd","#005D6E")) +
# geom_step(data =. %>% filter(sexe == "Femme"),
# aes(x = ageno,y=Pop_2030_Proj_central_Graph,color="orange")) +
# geom_step(data =. %>% filter(sexe == "Homme"),
# aes(x = ageno,y = Pop_2030_Proj_central_Graph,color="orange"))+
#
# geom_step(data =. %>% filter(sexe == "Femme"),
# aes(x = ageno,y=Pop_2030_Proj_basse_Graph,color="red")) +
# geom_step(data =. %>% filter(sexe == "Homme"),
# aes(x = ageno,y = Pop_2030_Proj_basse_Graph,color="red"))+
#
# geom_step(data =. %>% filter(sexe == "Femme"),
# aes(x = ageno,y=Pop_2030_Proj_haute_Graph,color="green")) +
# geom_step(data =. %>% filter(sexe == "Homme"),
# aes(x = ageno,y = Pop_2030_Proj_haute_Graph,color="green"))+
# scale_y_continuous(labels = abs)+
# theme(legend.title.align = 0.5)+
# scale_color_identity(name = "Scenario\nde\nprojection\n2030",
# breaks = c("orange", "red", "green"),
# labels = c("Central", "Pop. basse", "Pop. haute"),
# guide = "legend")+
# coord_flip()+
# ylab("Population")+
# xlab("Tranche d\'Age")
# )
# )%>%
# mutate(
# synthese_demo =purrr::map(data, function(df){
# df %>%
# mutate(Classe_Age_Simpli=case_when(
# as.numeric(Classe_Age) < 5 ~ "Moins de 20 ans",
# as.numeric(Classe_Age) > 13 ~"Plus de 65 ans",
# TRUE ~"Autres" )) %>%
# group_by(Classe_Age_Simpli) %>%
# summarise(
# Pop=sum(Pop),
# Pop_2030_Proj_central =sum(Pop_2030_Proj_central ),
# Pop_2030_Proj_basse =sum(Pop_2030_Proj_basse),
# Pop_2030_Proj_haute =sum(Pop_2030_Proj_haute )
# ) %>%
# gather(key="key",value="value",-"Classe_Age_Simpli") %>%
# spread(key = "Classe_Age_Simpli",value = "value") %>%
# mutate(
# Pop_tot=`Plus de 65 ans`+ Autres +`Moins de 20 ans`,
# `Part Plus de 65 ans`=`Plus de 65 ans`/Pop_tot,
# `Part Moins de 20 ans`=`Moins de 20 ans`/Pop_tot,
# Indice_Viellissement=`Plus de 65 ans`/`Moins de 20 ans`*100) %>%
# mutate(
# evol_Pop_tot = scales::percent(Pop_tot/.$Pop_tot[1]-1),
# evol_Moins_20 = scales::percent(`Moins de 20 ans`/.$`Moins de 20 ans`[1]-1),
# evol_Plus_65 = scales::percent(`Plus de 65 ans`/.$`Plus de 65 ans`[1]-1),
# evol_Indice_Viellissement = scales::percent(Indice_Viellissement/.$Indice_Viellissement[1]-1)) %>%
# mutate(key=c("2018","Projection 2030 - Scenario pessimiste (population basse)","Projection 2030 - Scenario central","Projection 2030 - Scenario optimiste (population haute)"))
# })
# ) %>%
# mutate(
# synthese_demo_ValAbso=purrr::map(synthese_demo,function(df){
# df %>%
# select(key,Pop_tot,`Part Moins de 20 ans`,`Part Plus de 65 ans`,Indice_Viellissement) %>%
# mutate_at(vars(3,4),scales::percent,accuracy=0.1) %>%
# set_names(c("Annee/Type de projection","Pop. Totale","Part des moins de 20 ans","Part des plus de 65 ans","Indice de vieillissement"))
# }),
# synthese_demo_Evo = purrr::map(synthese_demo,function(df){
# df %>%
# select(key,evol_Pop_tot,evol_Moins_20,evol_Plus_65,evol_Indice_Viellissement) %>%
# filter(key!="2018") %>%
# set_names(c("Type de projection","Evol. Pop. Totale","Evol. moins de 20 ans","Evol. plus de 65 ans","Evol. Indice de vieillissement"))
# })
# )
#
#
# Pop_proj_prepa_ensemble_zonage_demo_pyr <- Pop_proj_prepa_ensemble_zonage_demo_pyr %>%
# left_join(Pop_passe_ensemble_zonage %>%
# group_by(codgeo_zonage,typegeo) %>%
# nest() %>%
# rename("Pop_passe"="data"),
# by=c("codgeo_zonage","typegeo")
# )
#
cat("Offre et besoin\n")
liste_specialites <- commune_fr_dep_cible_Ensemble_APL_calc %>%
dplyr::as_tibble() %>%
dplyr::select(code_praticien, Lib_praticien) %>%
dplyr::distinct() %>%
dplyr::mutate(Lib_etiquette = ifelse(Lib_praticien == "APL DREES 2018", Lib_praticien, stringr::str_remove(stringr::str_sub(Lib_praticien, 4, 1000), "TOTAL "))) %>%
dplyr::arrange(code_praticien)
Offre_Besoin <- purrr::map_df(1:nrow(Ensemble_communes_zonage_geo_nest_dep_cible), function(x) {
commune_fr_dep_cible_Ensemble_APL_calc %>%
dplyr::as_tibble() %>%
dplyr::mutate(INSEE_COM = stringr::str_pad(INSEE_COM,width=5,side="left",pad="0")) %>%
dplyr::filter(INSEE_COM %in% Ensemble_communes_zonage_geo_nest_dep_cible$data[[x]]$CODGEO) %>%
dplyr::left_join(liste_specialites,
by = "code_praticien"
) %>%
dplyr::left_join(Ensemble_communes_dep_cible %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO, POPULATION), by = c("INSEE_COM" = "CODGEO")) %>%
dplyr::mutate(Pop_sous_seuil = ifelse(apl < ifelse(code_praticien == 1, seuil_APL[1], seuil_APL[2]), Pop, 0)) %>%
dplyr::left_join(
ExtractionMonoTable_CAT18_ToutePopulation_tampon_dep_cible_rens_damir %>%
dplyr::mutate(exe_spe = as.numeric(exe_spe)) %>%
dplyr::left_join(liste_specialites, by = c("exe_spe" = "code_praticien")) %>%
dplyr::group_by(Lib_etiquette, `Code commune (coord. structure)`) %>%
dplyr::summarise("Nombre de praticiens" = dplyr::n()),
by = c("Lib_etiquette", "INSEE_COM" = "Code commune (coord. structure)")
) %>%
dplyr::group_by(code_praticien, Lib_etiquette) %>%
dplyr::summarise(
"Pop - 2018" = sum(PopTot, na.rm = T),
"Nombre de praticiens" = sum(`Nombre de praticiens`, na.rm = T),
"Pop concernee par la specialite - 2018" = sum(Pop, na.rm = T),
"Pop concernee par la specialite et sous le seuil d\'acc\u00e8s - 2018" = sum(Pop_sous_seuil, na.rm = T),
"APL D10(1er decile)" = stats::quantile(apl, na.rm = T, 0.1),
"APL Q25(1er quartile)" = stats::quantile(apl, na.rm = T, 0.25),
"APL median" = stats::median(apl, na.rm = T),
"APL Q75(3eme quartile)" = stats::quantile(apl, na.rm = T, 0.75),
"APL D90(9eme decile)" = stats::quantile(apl, na.rm = T, 0.9),
"Ecart interquartiles" = stats::IQR(apl, na.rm = T),
"Ecart interdeciles" = stats::quantile(apl, 0.9, na.rm = T) - stats::quantile(apl, 0.1, na.rm = T)
) %>%
dplyr::ungroup() %>%
dplyr::select(-code_praticien) %>%
dplyr::mutate(
"Part de la pop concernee par la specialite et sous le seuil d\'acc\u00e8s - 2018" = scales::percent(`Pop concernee par la specialite et sous le seuil d'accès - 2018` / `Pop - 2018`, accuracy = 1L),
) %>%
dplyr::filter(Lib_etiquette != "APL DREES 2018") %>%
dplyr::select(c(
"Lib_etiquette",
"Nombre de praticiens",
"Pop concernee par la specialite - 2018",
"Pop concernee par la specialite et sous le seuil d\'acc\u00e8s - 2018",
"Part de la pop concernee par la specialite et sous le seuil d\'acc\u00e8s - 2018",
"APL D10(1er decile)",
"APL Q25(1er quartile)",
"APL median",
"APL Q75(3eme quartile)",
"APL D90(9eme decile)",
"Ecart interquartiles",
"Ecart interdeciles"
)) %>%
dplyr::mutate(
codgeo_zonage = Ensemble_communes_zonage_geo_nest_dep_cible$codgeo_zonage[x],
typegeo = Ensemble_communes_zonage_geo_nest_dep_cible$typegeo[x]
)
})
Offre_Besoin_2 <- purrr::map_df(1:nrow(Ensemble_communes_zonage_geo_nest_dep_cible), function(x) {
commune_fr_dep_cible_Ensemble_APL_calc %>%
dplyr::as_tibble() %>%
dplyr::mutate(INSEE_COM = stringr::str_pad(INSEE_COM,width=5,side="left",pad="0")) %>%
dplyr::filter(INSEE_COM %in% Ensemble_communes_zonage_geo_nest_dep_cible$data[[x]]$CODGEO) %>%
dplyr::left_join(liste_specialites %>%
dplyr::select(-Lib_praticien), by = "code_praticien") %>%
dplyr::left_join(Ensemble_communes_dep_cible %>%
dplyr::as_tibble() %>%
dplyr::select(CODGEO, POPULATION), by = c("INSEE_COM" = "CODGEO")) %>%
dplyr::mutate(
seuil_APL = ifelse(code_praticien == 1, seuil_APL[1], seuil_APL[2]),
Pop_sous_seuil = ifelse(apl < seuil_APL, Pop, 0),
nb_actes_sup = ifelse(apl < seuil_APL, Pop_sous_seuil * (seuil_APL - apl), 0)
) %>%
dplyr::group_by(code_praticien, Lib_praticien, Lib_etiquette) %>%
dplyr::summarise(
"Nombre d\'actes supplementaires estimes" = sum(nb_actes_sup, na.rm = T),
) %>%
dplyr::ungroup() %>%
dplyr::left_join(nb_actes_par_praticien %>%
dplyr::filter(nb_actes_par_praticien$CODE_DEPT == code_dep) %>%
dplyr::select(l_exe_spe, nb_actes_par_praticien_dep_corrige), by = c("Lib_praticien" = "l_exe_spe")) %>%
dplyr::mutate(
nb_actes_par_praticien_dep_corrige = ifelse(Lib_praticien == "APL DREES 2018",
nb_actes_par_praticien$nb_actes_par_praticien_dep_corrige[which(nb_actes_par_praticien$CODE_DEPT == "55" & nb_actes_par_praticien$Specialite == "Generalistes")],
nb_actes_par_praticien_dep_corrige
),
"Nombre de praticiens supplementaires estimes" = ifelse(is.na(nb_actes_par_praticien_dep_corrige),
"n.d",
`Nombre d'actes supplementaires estimes` / nb_actes_par_praticien_dep_corrige
)
) %>%
dplyr::select(-code_praticien, -Lib_praticien) %>%
dplyr::filter(Lib_etiquette != "APL DREES 2018") %>%
dplyr::select(c(
"Lib_etiquette",
"Nombre d\'actes supplementaires estimes", "Nombre de praticiens supplementaires estimes"
)) %>%
dplyr::mutate(
`Nombre d'actes supplementaires estimes` = as.character(`Nombre d'actes supplementaires estimes`),
`Nombre de praticiens supplementaires estimes` = as.character(`Nombre de praticiens supplementaires estimes`),
codgeo_zonage = Ensemble_communes_zonage_geo_nest_dep_cible$codgeo_zonage[x],
typegeo = Ensemble_communes_zonage_geo_nest_dep_cible$typegeo[x]
)
})
Offre_Besoin <- Offre_Besoin %>%
dplyr::group_by(codgeo_zonage, typegeo) %>%
tidyr::nest() %>%
dplyr::rename("diag_offre_besoin" = "data") %>%
dplyr::left_join(
Offre_Besoin_2 %>%
dplyr::group_by(codgeo_zonage, typegeo) %>%
tidyr::nest() %>%
dplyr::rename("potentiel_offre_besoin" = "data"),
by = c("codgeo_zonage", "typegeo")
)
cat("Patientele potentielle sous le seuil d\'acc\u00e8s\n")
Correspondance_TauxAccessibilite_Spe <- readRDS(system.file("extdata","Correspondance_TauxAccessibilite_Spe.rds",package = "medtRucks"))
TauxAccessibilite <- readRDS(system.file("extdata","TauxAccessibilite.rds",package = "medtRucks"))
Temps_max <- Correspondance_TauxAccessibilite_Spe %>%
dplyr::filter(exe_spe == 1) %>%
dplyr::select(dplyr::contains("Taux d")) %>%
as.data.frame()
Temps <- dplyr::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_communes <- length(as.character(Ensemble_communes_zonage_geo_nest_dep_cible$data[[which(Ensemble_communes_zonage_geo_nest_dep_cible$typegeo=="DEP")]]$CODGEO))
nb_communes_traitees <- 0
Patientele_potentielle_sous_seuil_dep <- purrr::map_df(as.character(Ensemble_communes_zonage_geo_nest_dep_cible$data[[which(Ensemble_communes_zonage_geo_nest_dep_cible$typegeo=="DEP")]]$CODGEO), function(x) {
nb_communes_traitees <<- nb_communes_traitees + 1
cat(paste0(x,": ",scales::percent(nb_communes_traitees/nb_communes),"\n"))
if(x %in% commune_chef_lieu_dep_cible$INSEE_COM){
Pop_sous_seuil <- purrr::map_df(1:3,function(y){
communes_zone <- names(which(dist_mat_commune_chef_lieu_dep_cible$durations[x, ] <= Temps$Temps_max[y] & dist_mat_commune_chef_lieu_dep_cible$durations[x, ] > Temps$Temps_min[y]))
if(length(communes_zone)>0){
commune_fr_dep_cible_Ensemble_APL_calc %>%
dplyr::as_tibble() %>%
dplyr::mutate(INSEE_COM=stringr::str_pad(INSEE_COM,5,"left","0")) %>%
dplyr::filter(INSEE_COM %in% communes_zone) %>%
dplyr::mutate(
seuil_APL = ifelse(code_praticien == 1, seuil_APL[1], seuil_APL[2]),
Pop_sous_seuil = ifelse(apl < seuil_APL, Pop, 0)*TauxAccessibilite[y],
nb_actes_sup = ifelse(apl < seuil_APL, Pop_sous_seuil * (seuil_APL - apl), 0)
) %>%
dplyr::group_by(code_praticien) %>%
dplyr::summarise(
Pop_sous_seuil=sum(Pop_sous_seuil,na.rm=T),
nb_actes_sup=sum(nb_actes_sup,na.rm=T)
)
}else{
dplyr::tibble(
code_praticien=NA,
Pop_sous_seuil=0,
nb_actes_sup=0
)
}
}) %>%
dplyr::group_by(code_praticien) %>%
dplyr::summarise(
Pop_sous_seuil=sum(Pop_sous_seuil,na.rm=T),
nb_actes_sup=sum(nb_actes_sup,na.rm=T)
)
}else{
Pop_sous_seuil <- dplyr::tibble(
code_praticien=NA,
Pop_sous_seuil=0,
nb_actes_sup=0
)
}
dplyr::tibble(
CODGEO=x,
"Patients sous seuil"=Pop_sous_seuil$Pop_sous_seuil,
"Actes potentiels suppl\u00e9mentaires"=Pop_sous_seuil$nb_actes_sup,
code_praticien = Pop_sous_seuil$code_praticien
)
})
Patientele_potentielle_sous_seuil_dep<-Patientele_potentielle_sous_seuil_dep %>%
dplyr::left_join(liste_specialites,by="code_praticien")
return(list(
"dist_mat_commune_chef_lieu_dep_cible"=dist_mat_commune_chef_lieu_dep_cible,
"Zonage_ars_communes"=Zonage_ars_communes,
"Zonage_ars"=Zonage_ars,
"Ensemble_communes_zonage_geo_nest_dep_cible"=Ensemble_communes_zonage_geo_nest_dep_cible,
"Pop_proj_prepa_ensemble_zonage"=Pop_proj_prepa_ensemble_zonage,
"Pop_passe_ensemble_zonage"=Pop_passe_ensemble_zonage,
"Offre_Besoin"=Offre_Besoin,
"Patientele_potentielle_sous_seuil_dep"=Patientele_potentielle_sous_seuil_dep
))
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.