Mon objectif est de réaliser des fonds de carte avec, pour chaque parcelles, des graphiques camemberts de la composition végétale.
Mes données sont très simple du style :
Code : Tout sélectionner
data <- data.frame(parcelle = c(1, 2, 3, 4, 5),
résineux = c(25, 45, 45, 60, 75),
chêne = c(45, 50, 45, 20, 15),
lande = c(30, 5, 10, 20, 10),
sum = c(100, 100, 100, 100, 100))
et j'appelle mon fond de carte comme :
Code : Tout sélectionner
read_sf("macarte.shp") %>%
left_join(data, by = "parcelle") %>%
ggplot() +
geom_sf(aes(fill = NULL), color = "black") + theme_bw() +
xlab("") + ylab("") +
scale_fill_distiller(palette = "Spectral") +
geom_sf_text(aes(label = parcelle), colour = "coral4", size = 4)
L'idée était de pouvoir mettre des graphiques camemberts aux mêmes endroits que les
Code : Tout sélectionner
geom_sf_text(aes(label = parcelle))
Avec de l'aide j'ai obtenu le code suivant :
Code : Tout sélectionner
library(sf)
library(tidyr)
library(dplyr)
library(ggplot2)
library(cowplot)
Code : Tout sélectionner
gg_ter <- read_sf("macarte.shp") %>% left_join(data, by = "parcelle")
Code : Tout sélectionner
Parcelles_coords <- st_coordinates(st_centroid(gg_ter)) %>%
data.frame(stringsAsFactors = FALSE) %>%
mutate(UG = gg_ter$parcelle) %>%
mutate(X = (abs(abs(X) - abs(st_bbox(gg_ter)$xmin)) /
as.numeric(abs(st_bbox(gg_ter)$xmin) - abs(st_bbox(gg_ter)$xmax))) +1.44,
Y = (abs(abs(abs(Y) - abs(st_bbox(gg_ter)$ymin)) /
as.numeric(abs(st_bbox(gg_ter)$ymin) - abs(st_bbox(gg_ter)$ymax)))-0.015)) %>%
mutate(X = 1-X)
L'idée derrière Parcelles_coords était de retrouver le centre des parcelles pour appliquer ces positions aux camemberts. Cependant ça ne marche pas bien, et j'ai du faire quelques ajustements manuels du type +1.44 ou -0.15 ou encore inverser X.
par la suite :
Code : Tout sélectionner
res <- tidyr::gather(data, key = "key", value = "value", -parcelle) %>%
left_join(UG_coords)
make_cam <- function(data, title = NA, legend.position = 0){
if(is.na(title)){
title <- unique(data$parcelle)
}
ggplot() +
geom_bar(data = data,
aes(x = "", y = value, fill = key),
stat = "identity", width = 0.5) +
coord_polar("y") +
theme_void() +
theme(legend.position = legend.position) +
ggtitle(title)+
theme(plot.title = element_text(hjust = 0.5))
}
terrparcelle_1 <- make_cam(dplyr::filter(res, parcelle == 1))
terrparcelle_2 <- make_cam(dplyr::filter(res, parcelle == 2))
# etc etc...
pour créer la fonction des camemberts
Code : Tout sélectionner
(gg_terII <- ggplot(data = gg_ter) +
geom_sf() +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0 )) +
theme(legend.position = 0,
plot.margin = unit(c(0,0,0,0), "cm")) + theme_bw() + xlab("") + ylab("")
)
legend <- get_legend(make_cam(res, "", legend.position = "left"))
cam_plot<- function(plot, data){
draw_plot(plot, x = data$X[1], y = data$Y[1],
height = 0.1)
}
TT <-
ggdraw(gg_terII) +
draw_plot_loc(terrparcelle_1, dplyr::filter(res, parcelle == 1)) +
draw_plot_loc(terrparcelle_2, dplyr::filter(res, parcelle == 2))
# etc, etc...
et enfin le plot final :
Code : Tout sélectionner
cowplot::plot_grid(TT, legend, rel_widths = c(0.8, 1))
Malgré ce code les camemberts restent assez décalé (et pas de façon très proportionnelle), et le rel_widths = c(0.8, 1) ne fonctionne pas très bien, et l'effet calque n'est pas terrible, cela créé une marge énorme pour la légende à gauche (get_legend(make_cam(res, "", legend.position = "left")))
J'aurais aimé savoir si vous auriez une solution pour optimiser ce code, ou bien si vous auriez d'autres méthodes pour arriver à ce que je veux faire s'il vous plait (dans mes données j'ai 2 cartes avec pour chacune 30 parcelles).
Merci à tous !