mise à jour intégration des données DROM

data-raw/admin-express_2019.R

@@ -14,41 +14,61 @@ load("data/table_passage_com_historique.rda")
 ## probleme sur la table commune_carto sur la métropole, on utilise donc une simplification de commune via mapshaper :
 #simplification utilisant une simplification à 5% en décochant la possibilité d'un
 
-com_metro<- st_read("data-raw/source/2019/adminexpress/metro_simplifie/COMMUNE.shp") %>%
-  st_set_crs(2154)
+com_metro<- st_read("data-raw/source/2019/adminexpress/metro_simplifie/COMMUNE.shp")
 
 origine_metro <- c(st_as_sfc(st_bbox(com_metro))[[1]][[1]][[1,1]], st_as_sfc(st_bbox(com_metro))[[1]][[1]][[1,2]] )
-doms<-c("971", "972", "973", "974", "976")
 
+translate_dom <- function(code_dom,destination,scale=1,angle=0,epsg=2154) {
 
-for (i in 1:5) {
+  if (code_dom != '976'){
 
-  dom <- doms[[i]]
-if (i<5){
-  com_dom <- st_read(paste0("data-raw/source/2019/adminexpress/",dom,"/COMMUNE_CARTO.shp")) %>%
-    st_set_crs(st_crs(com_metro))
-}
-  else {  com_dom <- st_read(paste0("data-raw/source/2019/adminexpress/",dom,"/COMMUNE.shp")) %>%
-    st_set_crs(st_crs(com_metro))
+    com_dom <- st_read(paste0("data-raw/source/2019/adminexpress/",code_dom,"/COMMUNE_CARTO.shp")) %>%
+      st_transform(epsg)
+  }
+  else {
+
+    com_dom <- st_read(paste0("data-raw/source/2019/adminexpress/",code_dom,"/COMMUNE.shp")) %>%
+      st_transform(epsg)
   }
-  ctrd_com_dom <- st_centroid(st_geometry(com_dom)) # vecteur des centroïdes de communes du dom
-  bbox_dom <- st_bbox(com_dom)
-  ctrd_dom <- st_centroid(st_as_sfc(bbox_dom)) # centre de la bbox du dom
-  alpha <- 160000/(bbox_dom$ymax - bbox_dom$ymin) # rapport de proportionnalité (pour un emplacement de 210 km de hauteur)
 
-  st_geometry(com_dom) <- (st_geometry(com_dom) - ctrd_com_dom ) * alpha + ctrd_com_dom * alpha  # agrandissement de la géometrie du dom
-  st_geometry(com_dom) <- st_geometry(com_dom) - ctrd_dom * alpha + origine_metro + c(-175000,7110500-6049646-210000*(i-0.5)) # translation vers l'emplacement
+  # centroid d'origine
+  centroid_com_dom_sfc <- st_centroid(st_geometry(com_dom %>%
+                                                    summarise()))
+  origine <- centroid_com_dom_sfc[[1]]
 
-  assign(paste0("com_",dom), com_dom)
+  com_dom_sfc <- st_geometry(com_dom)
+  rotation = function(a){
+    r = a * pi / 180 #degrees to radians
+    matrix(c(cos(r), sin(r), -sin(r), cos(r)), nrow = 2, ncol = 2)
+  }
+
+  com_dom_sfc_middle <- (com_dom_sfc-centroid_com_dom_sfc)*scale* rotation(angle) + centroid_com_dom_sfc
+  com_dom_sfc_trans <- com_dom_sfc_middle + c(destination[1]-origine[1], destination[2]-origine[2])
+  com_dom_trans <- st_set_geometry(com_dom, com_dom_sfc_trans)
+  st_crs(com_dom_trans) <- st_crs(com_dom)
 
+  return(com_dom_trans)
 }
 
-communes_geo <- bind_rows(com_metro, com_971, com_972, com_973, com_974, com_976) %>%
+arg <- list(code_dom=c("971", "972", "973", "974", "976"),
+            destination=list(c(144008.229673723,6497197.13214097),
+                             c(168304.796604606,6353491.45368567),
+                             c(211011.372716378, 6164488.37843379),
+                             c(279617.056312069, 6398160.72995736),
+                             c(297376.58755285, 6507015.666758)
+            ),
+            scale=c(1,1.2,0.5,1,1.2),
+            angle=c(-50,-50,-45,30,30))
+
+l <- pmap(arg,translate_dom)
+dom_geo <- rbind(l[[1]],l[[2]],l[[3]],l[[4]],l[[5]])
+
+
+communes_geo <- rbind(com_metro, dom_geo) %>%
   as_tibble %>%
   select(DEPCOM=INSEE_COM, geometry)%>%
   st_as_sf()%>%
   st_set_crs(2154)
-
 rm(i, origine_metro, doms, dom, com_dom, com_metro, com_971, com_972, com_973, com_974, com_976, ctrd_com_dom, bbox_dom, ctrd_dom, alpha, url_admin_express)
 
 # gestion des arrondissements de Paris, Lyon, Marseille dorénavant intégré à admin express
@@ -61,6 +81,13 @@ communes_geo<-communes_geo %>%
   summarise(do_union=T) %>%
   mutate(AREA=st_area(geometry))
 
+
+communes_metro_geo <- com_metro %>%
+  as_tibble %>%
+  select(DEPCOM=INSEE_COM, geometry)%>%
+  st_as_sf()%>%
+  st_set_crs(2154)
+
 epci_geo <- filter(communes_info_supra, NOM_EPCI != "Sans objet")%>%
   inner_join(communes_geo %>% select(DEPCOM), ., by="DEPCOM") %>%
   select(EPCI) %>%
@@ -69,6 +96,14 @@ epci_geo <- filter(communes_info_supra, NOM_EPCI != "Sans objet")%>%
   ungroup() %>%
   mutate(AREA=st_area(geometry))
 
+epci_metro_geo <- filter(communes_info_supra, NOM_EPCI != "Sans objet")%>%
+  inner_join(communes_metro_geo %>% select(DEPCOM), ., by="DEPCOM") %>%
+  select(EPCI) %>%
+  group_by(EPCI) %>%
+  summarise(do_union=T) %>%
+  ungroup() %>%
+  mutate(AREA=st_area(geometry))
+
 departements_geo <- inner_join(communes_geo %>% select(DEPCOM),
                                communes_info_supra,
                                by = "DEPCOM") %>%
@@ -77,7 +112,15 @@ departements_geo <- inner_join(communes_geo %>% select(DEPCOM),
   summarise(do_union=T) %>%
   ungroup() %>%
   mutate(AREA=st_area(geometry))
-
+departements_metro_geo <- inner_join(communes_metro_geo %>% select(DEPCOM),
+                                     communes_info_supra,
+                                     by = "DEPCOM") %>%
+  select(DEP) %>%
+  group_by(DEP) %>%
+  summarise(do_union=T) %>%
+  ungroup() %>%
+  mutate(AREA=st_area(geometry))
+plot(departements_metro_geo)
 regions_geo <- inner_join(communes_geo %>% select(DEPCOM),
                           communes_info_supra,
                           by = "DEPCOM") %>%
@@ -87,8 +130,11 @@ regions_geo <- inner_join(communes_geo %>% select(DEPCOM),
   ungroup() %>%
   mutate(AREA=st_area(geometry))
 
+
 # sauvegarde des données --------------------------------------------------------
 use_data(communes_geo,internal=F, overwrite = T)
 use_data(departements_geo,internal=F,overwrite = T)
 use_data(epci_geo,internal=F,overwrite = T)
 use_data(regions_geo,internal=F,overwrite = T)
+
+rm(i, origine_metro, doms, dom, com_dom, com_metro, com_971, com_972, com_973, com_974, com_976, ctrd_com_dom, bbox_dom, ctrd_dom, alpha, url_admin_express)