ggplot, graphique camembert sur fond de carte sf package

Postez ici vos questions, réponses, commentaires ou suggestions - Les sujets seront ultérieurement répartis dans les archives par les modérateurs

Modérateur : Groupe des modérateurs

Tomas leon
Messages : 48
Enregistré le : 09 Jan 2018, 16:12

ggplot, graphique camembert sur fond de carte sf package

Messagepar Tomas leon » 10 Juin 2019, 19:21

Bonjour à tous,

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))
qui sont automatique aux centres (barycentre ?) des parcelles (et donc sans utiliser des coordonées ou trucs comme ça).

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 !

Retourner vers « Questions en cours »

Qui est en ligne

Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité