Skip to content
Snippets Groups Projects
Commit ba94a276 authored by Daniel.Kalioudjoglou's avatar Daniel.Kalioudjoglou
Browse files

Merge branch '34-definir-l-aspect-des-cartes' into 'master'

Resolve "définir l'aspect des cartes"

Closes #34

See merge request !23
parents ccb34155 550f8725
No related branches found
No related tags found
1 merge request!23Resolve "définir l'aspect des cartes"
Pipeline #235991 failed
...@@ -18,7 +18,6 @@ Imports: ...@@ -18,7 +18,6 @@ Imports:
COGiter, COGiter,
dplyr, dplyr,
drealdown, drealdown,
drealthemes,
forcats, forcats,
geofacet, geofacet,
ggforce, ggforce,
......
...@@ -131,12 +131,14 @@ creer_carte_volume<-function(data=indic_ecln, ...@@ -131,12 +131,14 @@ creer_carte_volume<-function(data=indic_ecln,
#' @export #' @export
#' @importFrom COGiter filtrer_cog_geo list_epci_in_reg nom_zone #' @importFrom COGiter filtrer_cog_geo list_epci_in_reg nom_zone
#' @importFrom dplyr filter rename left_join mutate #' @importFrom dplyr filter rename left_join mutate
#' @importFrom forcats fct_explicit_na #' @importFrom forcats fct_explicit_na fct_relevel
#' @importFrom ggplot2 ggplot geom_sf aes scale_fill_manual coord_sf guides guide_legend theme element_rect element_blank labs #' @importFrom ggplot2 ggplot geom_sf aes scale_fill_manual coord_sf guides guide_legend theme element_rect element_blank labs
#' @importFrom ggspatial annotation_north_arrow north_arrow_fancy_orienteering annotation_scale #' @importFrom ggspatial annotation_north_arrow north_arrow_fancy_orienteering annotation_scale
#' @importFrom gouvdown theme_gouv_map #' @importFrom gouvdown theme_gouv_map
#' @importFrom mapfactory fond_carto #' @importFrom mapfactory fond_carto
#' @importFrom sf st_bbox st_crs #' @importFrom sf st_bbox st_crs
#' @importFrom stringr str_split_fixed
#'
creer_carte_evolution<-function(data=indic_ecln, creer_carte_evolution<-function(data=indic_ecln,
code_region = params$reg, code_region = params$reg,
indicateurs = c("Encours","Mises en vente","Ventes"), indicateurs = c("Encours","Mises en vente","Ventes"),
...@@ -162,76 +164,76 @@ creer_carte_evolution<-function(data=indic_ecln, ...@@ -162,76 +164,76 @@ creer_carte_evolution<-function(data=indic_ecln,
data_prep<-epci_geo %>% data_prep<-epci_geo %>%
dplyr::left_join(data_pour_carte) %>% dplyr::left_join(data_pour_carte) %>%
dplyr::mutate(TauxEvolution12Moisc=cut(.data$TauxEvolution12Mois,breaks=c(-Inf,-10,0,10,50,Inf), dplyr::filter(!is.na(.data$Source))
labels=c("-10%","0%","10%","50%",""),
ordered_result = T,include.lowest = T), bks <- c(-Inf,-10,0,10,50,Inf)
TauxEvolution12Moisc=forcats::fct_explicit_na(.data$TauxEvolution12Moisc,na_level="Pas d'activit\u00e9"),
epci_reg = .data$EPCI %in% epci_reg, data_prep<-data_prep %>%
indicateur_positif = .data$Valeur>0) %>% dplyr::mutate(TauxEvolution12Moisc=cut(.data$TauxEvolution12Mois,breaks=bks,
dplyr::filter(!is.na(.data$Source)) %>% labels=c(
paste("Inf\u00e9rieur \u00e0",round(bks[2],0),"%"),
paste("De",round(bks[2],0),"% \u00e0",round(bks[3],0),"% inclus"),
paste("De",round(bks[3],0),"% \u00e0",round(bks[4],0),"% inclus"),
paste("De",round(bks[4],0),"% \u00e0",round(bks[5],0),"% inclus"),
paste("Plus de",round(bks[5],0),"%")),
# labels=c("-10%","0%","10%","50%",""),
ordered_result = T,include.lowest = T),
TauxEvolution12Moisc=forcats::fct_explicit_na(.data$TauxEvolution12Moisc,na_level="Secret statistique\nou non significatif"),
epci_reg = .data$EPCI %in% epci_reg,
indicateur_positif = .data$Valeur>0)
liste_facteurs <- c("Pas d\'activit\u00e9",levels(data_prep$TauxEvolution12Moisc))
data_prep<-data_prep %>%
dplyr::mutate(TauxEvolution12Moisc= dplyr::case_when(
.data$TauxEvolution12Mois == Inf ~ "Secret statistique\nou non significatif",
.data$TauxEvolution12Mois == "NaN" ~ "Pas d\'activit\u00e9",
TRUE ~ .data$TauxEvolution12Moisc )) %>%
dplyr::mutate(Indicateur = forcats::fct_drop(.data$Indicateur), dplyr::mutate(Indicateur = forcats::fct_drop(.data$Indicateur),
Indicateur = forcats::fct_relevel(.data$Indicateur,"Ventes - Appartements", Indicateur = forcats::fct_relevel(.data$Indicateur,"Ventes - Appartements",
"Mises en vente - Appartements","Encours - Appartements", "Mises en vente - Appartements","Encours - Appartements",
"Ventes - Maisons", "Ventes - Maisons",
"Mises en vente - Maisons","Encours - Maisons")) "Mises en vente - Maisons","Encours - Maisons"))%>%
dplyr::mutate(TauxEvolution12Moisc=forcats::fct_relevel(.data$TauxEvolution12Moisc,liste_facteurs))%>%
dplyr::mutate(Indicateur2 = .data$Indicateur %>%
stringr::str_split_fixed(., pattern = "-", n = 2) %>% # scinde la colonne en 2
.[, 1]) #garde la 1ere valeur
color<-c("white",
gouvdown::gouv_palettes$pal_gouv_m[4],
gouvdown::gouv_palettes$pal_gouv_m[3],
gouvdown::gouv_palettes$pal_gouv_m[2],
gouvdown::gouv_palettes$pal_gouv_m[1],
gouvdown::gouv_palettes$pal_gouv_q[2],
"dark grey")
color<-c(rev(gouvdown::gouv_palettes$pal_gouv_m[1:nlevels(data_prep$TauxEvolution12Moisc)-1]),"dark grey")
# Pour la Corse : définition de l'emprise de la carte : on veut 30 km de vide autour de la région et une carte plus large que haute
bbox_reg <- sf::st_bbox(data_prep %>% filter(epci_reg))
fond_carte <- mapfactory::fond_carto(nom_reg = COGiter::nom_zone("R\u00e9gions",code_region)) fond_carte <- mapfactory::fond_carto(nom_reg = COGiter::nom_zone("R\u00e9gions",code_region))
if(code_region == "94"){
hauteur = bbox_reg$ymax - bbox_reg$ymin + 30000
largeur = bbox_reg$xmax - bbox_reg$xmin + 30000
x_mil = bbox_reg$xmin + largeur/2
y_min = bbox_reg$ymin - 15000
y_max = bbox_reg$ymax + 15000
x_min = ifelse(largeur >= hauteur, bbox_reg$xmin - 15000, x_mil - hauteur/2)
x_max = ifelse(largeur >= hauteur, bbox_reg$xmax + 15000, x_mil + hauteur/2)
} else {
y_min = bbox_reg$ymin
y_max = bbox_reg$ymax
x_min = bbox_reg$xmin
x_max = bbox_reg$xmax
}
p <- ggplot2::ggplot() + p <- ggplot2::ggplot() +
ggplot2::geom_sf(data = fond_carte$epci, fill = "light grey", color = "white", size = .1) + ggplot2::geom_sf(data = fond_carte$epci, fill = "light grey", color = "white", size = .1) +
ggplot2::geom_sf(data = fond_carte$regions %>% filter(.data$REG == code_region), fill = "grey", color = "white",size = .2) + ggplot2::geom_sf(data = fond_carte$regions %>% filter(.data$REG == code_region), fill = "grey", color = "white",size = .2) +
ggplot2::geom_sf(data=data_prep %>% filter(!.data$epci_reg), ggplot2::geom_sf(data=data_prep %>% filter(!.data$epci_reg),
fill = "light grey", fill = "light grey",
color="white",size=.1)+ color="white",size=.1)+
ggplot2::geom_sf(data = fond_carte$reg_ombre, fill = "dark grey", color = "light grey") + # ggplot2::geom_sf(data = fond_carte$reg_ombre, fill = "dark grey", color = "light grey") +
ggplot2::geom_sf(data=data_prep %>% filter(.data$epci_reg), ggplot2::geom_sf(data=data_prep %>% filter(.data$epci_reg),
ggplot2::aes(fill=.data$TauxEvolution12Moisc, ggplot2::aes(fill=.data$TauxEvolution12Moisc,
color=""), color=""),
color="white",size=.1)+ color="white",size=.1)+
ggplot2::scale_fill_manual(values=color)+ ggplot2::scale_fill_manual(values=color)+
ggplot2::geom_sf(data = fond_carte$departements,fill=NA,color = "white",size = .2) + ggplot2::geom_sf(data = fond_carte$departements,fill=NA,color = "dark grey",size = .2) +
ggplot2::coord_sf( ggplot2::coord_sf(
xlim = c(x_min, x_max), # xlim = c(x_min, x_max),
ylim = c(y_min, y_max), # ylim = c(y_min, y_max),
expand = FALSE, expand = FALSE,
crs = sf::st_crs(fond_carte$epci), crs = sf::st_crs(fond_carte$epci),
datum = NA datum = NA
) + ) +
ggplot2::guides(colour=F,
order=0,
fill=ggplot2::guide_legend(direction="horizontal",
keyheight=unit(2,units="mm"),
keywidth=unit(20,units="mm"),
order=1,
title.position="top",
title.hjust=0.5,
nrow=1,
label.position="bottom",
label.hjust=1)) +
gouvdown::theme_gouv_map(base_size=12, gouvdown::theme_gouv_map(base_size=12,
strip_text_size = 12, strip_text_size = 12,
plot_title_size = 20, plot_title_size = 20,
subtitle_size = 16) + subtitle_size = 16) +
ggplot2::theme(panel.background = ggplot2::element_rect(fill = "light blue"), ggplot2::theme(panel.background = ggplot2::element_rect(fill = "light blue",color="light blue"),
plot.background=ggplot2::element_rect(fill="#ffffff",color="#ffffff"), plot.background=ggplot2::element_rect(fill="#ffffff",color="#ffffff"),
legend.position = "bottom", legend.position = "bottom",
legend.title = ggplot2::element_blank(), legend.title = ggplot2::element_blank(),
...@@ -239,13 +241,11 @@ creer_carte_evolution<-function(data=indic_ecln, ...@@ -239,13 +241,11 @@ creer_carte_evolution<-function(data=indic_ecln,
) + ) +
ggplot2::labs(fill=titre_legende, ggplot2::labs(fill=titre_legende,
caption=bas_de_page, caption=bas_de_page,
title=titre) + title=titre)
ggspatial::annotation_north_arrow(location = "br", style = ggspatial::north_arrow_fancy_orienteering) +
ggspatial::annotation_scale()
if (length(indic) > 1) { if (length(indic) > 1) {
p <-p+ facet_wrap(~Indicateur,ncol=3) p <-p+ facet_wrap(~Indicateur2,ncol=3)+
ggplot2::theme(panel.spacing = unit(1, "lines"))
} }
return(p) return(p)
...@@ -265,13 +265,14 @@ creer_carte_evolution<-function(data=indic_ecln, ...@@ -265,13 +265,14 @@ creer_carte_evolution<-function(data=indic_ecln,
#' @return une carte en ggplot2 #' @return une carte en ggplot2
#' @export #' @export
#' @importFrom COGiter filtrer_cog_geo list_epci_in_reg nom_zone #' @importFrom COGiter filtrer_cog_geo list_epci_in_reg nom_zone
#' @importFrom dplyr filter rename left_join mutate pull #' @importFrom dplyr filter rename left_join mutate pull case_when
#' @importFrom ggplot2 ggplot geom_sf stat_sf_coordinates coord_sf scale_size theme element_rect element_blank labs facet_wrap #' @importFrom ggplot2 ggplot geom_sf stat_sf_coordinates coord_sf scale_size theme element_rect element_blank labs facet_wrap theme
#' @importFrom ggspatial annotation_north_arrow north_arrow_fancy_orienteering annotation_scale #' @importFrom ggspatial annotation_north_arrow north_arrow_fancy_orienteering annotation_scale
#' @importFrom gouvdown theme_gouv_map #' @importFrom gouvdown theme_gouv_map
#' @importFrom mapfactory fond_carto #' @importFrom mapfactory fond_carto
#' @importFrom sf st_bbox st_crs #' @importFrom sf st_bbox st_crs
#' @importFrom forcats fct_drop fct_relevel #' @importFrom forcats fct_drop fct_relevel
#' @importFrom stringr str_split_fixed
#' #'
#' #'
creer_carte_volume2<-function(data=indic_ecln, creer_carte_volume2<-function(data=indic_ecln,
...@@ -283,7 +284,19 @@ creer_carte_volume2<-function(data=indic_ecln, ...@@ -283,7 +284,19 @@ creer_carte_volume2<-function(data=indic_ecln,
titre_legende="", titre_legende="",
bas_de_page=""){ bas_de_page=""){
color<-c(drealthemes::dreal_pal("continuous")(5),"dark grey") # color<-c(drealthemes::dreal_pal("continuous")(5),"dark grey")
# color<-c(rev(gouvdown::gouv_palettes$pal_gouv_m[1:nlevels(data_prep$TauxEvolution12Moisc)-1]),"dark grey")
# color<-c(rev(gouvdown::gouv_palettes$pal_gouv_m[2:5]),gouvdown::gouv_palettes$pal_gouv_q[2],"dark grey")
color<-c("white",
gouvdown::gouv_palettes$pal_gouv_m[4],
gouvdown::gouv_palettes$pal_gouv_m[3],
gouvdown::gouv_palettes$pal_gouv_m[2],
gouvdown::gouv_palettes$pal_gouv_m[1],
gouvdown::gouv_palettes$pal_gouv_q[2],
"dark grey")
# color<-c(rev(gouvdown::gouv_palettes$pal_gouv_a[1:5]),"dark grey")
indic <- paste0(indicateurs," - ",type_logement) indic <- paste0(indicateurs," - ",type_logement)
...@@ -301,7 +314,6 @@ creer_carte_volume2<-function(data=indic_ecln, ...@@ -301,7 +314,6 @@ creer_carte_volume2<-function(data=indic_ecln,
epci_reg <- COGiter::list_epci_in_reg(code_region) epci_reg <- COGiter::list_epci_in_reg(code_region)
data_prep<- epci_geo %>% data_prep<- epci_geo %>%
# dplyr::filter(.data$EPCI %in% epci_reg) %>%
dplyr::left_join(data_pour_carte) %>% dplyr::left_join(data_pour_carte) %>%
dplyr::mutate(epci_reg = .data$EPCI %in% epci_reg) %>% dplyr::mutate(epci_reg = .data$EPCI %in% epci_reg) %>%
dplyr::filter(!is.na(.data$Source)) %>% dplyr::filter(!is.na(.data$Source)) %>%
...@@ -311,25 +323,36 @@ creer_carte_volume2<-function(data=indic_ecln, ...@@ -311,25 +323,36 @@ creer_carte_volume2<-function(data=indic_ecln,
"Ventes - Maisons", "Ventes - Maisons",
"Mises en vente - Maisons","Encours - Maisons")) "Mises en vente - Maisons","Encours - Maisons"))
bks<-cartography::getBreaks(data_prep %>% data_prep2 <- data_prep %>%
dplyr::mutate(Valeur2 = dplyr::case_when(
Valeur == 0 ~ NA,
TRUE ~ Valeur
))
bks<-cartography::getBreaks(data_prep2 %>%
dplyr::filter(!is.na(.data$Valeur)) %>% dplyr::filter(!is.na(.data$Valeur)) %>%
dplyr::filter(.data$Indicateur == paste0("Ventes - ",type_logement)) %>% dplyr::filter(.data$Indicateur == paste0("Ventes - ",type_logement)) %>%
dplyr::pull(.data$Valeur), dplyr::pull(.data$Valeur),
method="fisher-jenks", method="fisher-jenks",
nclass=4) nclass=4)
bks2 <- c(bks,Inf) # bks2 <- c(bks,Inf)
bks2 <- c(0,0.9,bks[2:5],Inf)
data_prep<- data_prep %>% data_prep<- data_prep %>%
dplyr::mutate(Valeur=cut(Valeur,breaks=bks2, dplyr::mutate(Valeur=cut(Valeur,breaks=bks2,
# labels=c(paste("moins de ",round(bks[2:length(bks)],0)),paste("plus de",max(bks))), # labels=c(paste("moins de ",round(bks[2:length(bks)],0)),paste("plus de",max(bks))),
labels=c(paste("moins de",round(bks[2],0)), labels=c("Pas d\'activit\u00e9",
paste("entre",round(bks[2],0),"et",round(bks[3],0)), paste("De 1 \u00e0",round(bks[2],0)),
paste("entre",round(bks[3],0),"et",round(bks[4],0)), paste("De",round(bks[2],0)+1,"\u00e0",round(bks[3],0)),
paste("entre",round(bks[4],0),"et",round(bks[5],0)), paste("De",round(bks[3],0)+1,"\u00e0",round(bks[4],0)),
paste("plus de",max(bks))), paste("De",round(bks[4],0)+1,"\u00e0",round(bks[5],0)),
include.lowest = T, paste("Plus de",max(bks))),
ordered_result = T), include.lowest = T,
Valeur=forcats::fct_explicit_na(Valeur,na_level="Secret statistique")) ordered_result = T),
Valeur=forcats::fct_explicit_na(Valeur,na_level="Secret statistique"))%>%
dplyr::mutate(Indicateur2 = .data$Indicateur %>%
stringr::str_split_fixed(., pattern = "-", n = 2) %>% # scinde la colonne en 2
.[, 1]) #garde la 1ere valeur
fond_carte <- mapfactory::fond_carto(nom_reg = COGiter::nom_zone("R\u00e9gions",code_region)) fond_carte <- mapfactory::fond_carto(nom_reg = COGiter::nom_zone("R\u00e9gions",code_region))
...@@ -339,13 +362,13 @@ creer_carte_volume2<-function(data=indic_ecln, ...@@ -339,13 +362,13 @@ creer_carte_volume2<-function(data=indic_ecln,
ggplot2::geom_sf(data=data_prep %>% filter(!.data$epci_reg), ggplot2::geom_sf(data=data_prep %>% filter(!.data$epci_reg),
fill = "light grey", fill = "light grey",
color="white",size=.1)+ color="white",size=.1)+
ggplot2::geom_sf(data = fond_carte$reg_ombre, fill = "dark grey", color = "light grey") + # ggplot2::geom_sf(data = fond_carte$reg_ombre, fill = "dark grey", color = "light grey") +
ggplot2::geom_sf(data=data_prep, ggplot2::geom_sf(data=data_prep,
ggplot2::aes(fill=.data$Valeur, ggplot2::aes(fill=.data$Valeur,
color=""), color=""),
color="white",size=.1)+ color="white",size=.1)+
ggplot2::scale_fill_manual(values=color)+ ggplot2::scale_fill_manual(values=color)+
ggplot2::geom_sf(data = fond_carte$departements,fill=NA,color = "white",size = .2) + ggplot2::geom_sf(data = fond_carte$departements,fill=NA,color = "dark grey",size = .2) +
ggplot2::coord_sf( ggplot2::coord_sf(
expand = FALSE, expand = FALSE,
crs = sf::st_crs(fond_carte$epci), crs = sf::st_crs(fond_carte$epci),
...@@ -355,19 +378,18 @@ creer_carte_volume2<-function(data=indic_ecln, ...@@ -355,19 +378,18 @@ creer_carte_volume2<-function(data=indic_ecln,
strip_text_size = 12, strip_text_size = 12,
plot_title_size = 20, plot_title_size = 20,
subtitle_size = 16) + subtitle_size = 16) +
ggplot2::theme(panel.background = ggplot2::element_rect(fill = "light blue"), ggplot2::theme(panel.background = ggplot2::element_rect(fill = "light blue",color="light blue"),
plot.background=ggplot2::element_rect(fill="#ffffff",color="#ffffff"), plot.background=ggplot2::element_rect(fill="#ffffff",color="#ffffff"),
legend.position = "bottom", legend.position = "bottom",
legend.title = ggplot2::element_blank(), legend.title = ggplot2::element_blank(),
plot.caption.position = "plot")+ plot.caption.position = "plot")+
ggplot2::labs(fill=titre_legende, ggplot2::labs(fill=titre_legende,
caption = bas_de_page, caption = bas_de_page,
title=titre) + title=titre)
ggspatial::annotation_north_arrow(location = "br", style = ggspatial::north_arrow_fancy_orienteering) +
ggspatial::annotation_scale()
if (length(indic) > 1) { if (length(indic) > 1) {
p <-p+ ggplot2::facet_wrap(~Indicateur,ncol=3) p <-p+ ggplot2::facet_wrap(~Indicateur2,ncol=3)+
ggplot2::theme(panel.spacing = unit(1, "lines"))
} }
return(p) return(p)
} }
......
utils::globalVariables( utils::globalVariables(
c("liste_zone", "indic_ecln", "%m-%","mygrid","params","Valeur") c("liste_zone", "indic_ecln", "%m-%","mygrid","params","Valeur",".")
) )
...@@ -155,17 +155,6 @@ creer_graphique_series_temporelles_prix( ...@@ -155,17 +155,6 @@ creer_graphique_series_temporelles_prix(
### 1.5 - La commercialisation par EPCI ### 1.5 - La commercialisation par EPCI
```{r logementscartes_volume}
creer_carte_volume(data=indic_ecln,
code_region = params$reg,
indicateurs = c("Encours","Mises en vente","Ventes"),
type_logement="Logements",
type_indicateur="Cumul annuel",
titre="Volumes de ventes, mises en vente et encours de logements",
titre_legende="",
bas_de_page=caption_carte_logements)
```
```{r ensemble_cartes_volume2_epci} ```{r ensemble_cartes_volume2_epci}
creer_carte_volume2(data=indic_ecln, creer_carte_volume2(data=indic_ecln,
code_region = params$reg, code_region = params$reg,
...@@ -177,7 +166,6 @@ creer_carte_volume2(data=indic_ecln, ...@@ -177,7 +166,6 @@ creer_carte_volume2(data=indic_ecln,
bas_de_page=caption_carte_logements) bas_de_page=caption_carte_logements)
``` ```
```{r logementscartes_evol} ```{r logementscartes_evol}
creer_carte_evolution(data=indic_ecln, creer_carte_evolution(data=indic_ecln,
code_region = params$reg, code_region = params$reg,
...@@ -190,37 +178,6 @@ creer_carte_evolution(data=indic_ecln, ...@@ -190,37 +178,6 @@ creer_carte_evolution(data=indic_ecln,
``` ```
### 1.9 - tests à supprimer
```{r, logements_temp,fig.height=5, fig.width=12}
creer_graphique_series_temporelles(data = indic_ecln %>% dplyr::filter(TypeZone %in% c("France","Régions")),
type_logement = "Logements")
```
```{r ensembleprix,fig.height=3, fig.width=4}
creer_graphique_series_temporelles_prix(
data = indic_ecln %>% dplyr::filter(TypeZone == "France"),
type_logement = "Logements",
type_zone = typezone,
titre = "Prix de vente au m2",
bas_de_page = captionprix,
type_facet = "grille"
)
```
## 2 - Les appartements ## 2 - Les appartements
### 2.1 - Les ventes d'appartements ### 2.1 - Les ventes d'appartements
...@@ -312,8 +269,8 @@ creer_graphique_series_temporelles_prix( ...@@ -312,8 +269,8 @@ creer_graphique_series_temporelles_prix(
### 2.5 - La commercialisation par EPCI ### 2.5 - La commercialisation par EPCI
```{r collectifcartes_volume} ```{r collectifcartes_volume2}
creer_carte_volume(data=indic_ecln, creer_carte_volume2(data=indic_ecln,
code_region = params$reg, code_region = params$reg,
indicateurs = c("Encours","Mises en vente","Ventes"), indicateurs = c("Encours","Mises en vente","Ventes"),
type_logement="Appartements", type_logement="Appartements",
...@@ -428,8 +385,8 @@ creer_graphique_series_temporelles_prix( ...@@ -428,8 +385,8 @@ creer_graphique_series_temporelles_prix(
### 3.5 - La commercialisation par EPCI ### 3.5 - La commercialisation par EPCI
```{r collectifcartes_volume_epci} ```{r individuelcartes_volume2}
creer_carte_volume(data=indic_ecln, creer_carte_volume2(data=indic_ecln,
code_region = params$reg, code_region = params$reg,
indicateurs = c("Encours","Mises en vente","Ventes"), indicateurs = c("Encours","Mises en vente","Ventes"),
type_logement="Maisons", type_logement="Maisons",
...@@ -440,7 +397,7 @@ creer_carte_volume(data=indic_ecln, ...@@ -440,7 +397,7 @@ creer_carte_volume(data=indic_ecln,
``` ```
```{r collectifcartes_evol_epci} ```{r individuelcartes_evol}
creer_carte_evolution(data=indic_ecln, creer_carte_evolution(data=indic_ecln,
code_region = params$reg, code_region = params$reg,
indicateurs = c("Encours","Mises en vente","Ventes"), indicateurs = c("Encours","Mises en vente","Ventes"),
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
\alias{indic_ecln} \alias{indic_ecln}
\title{Table contenant les différents indicateurs de la source ecln utiles pour la publication.} \title{Table contenant les différents indicateurs de la source ecln utiles pour la publication.}
\format{ \format{
Table de 2197156 lignes et 9 colonnes: Table de 96720 lignes et 10 colonnes:
\describe{ \describe{
\item{TypeZone}{Type de territoire} \item{TypeZone}{Type de territoire}
\item{CodeZone}{Code du territoire} \item{CodeZone}{Code du territoire}
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment