Created
August 12, 2022 13:17
-
-
Save schochastics/0bef65871180daab76183278176cc9fa to your computer and use it in GitHub Desktop.
ggraph circlepack on maps
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(tidyverse) | |
library(sf) | |
library(ggraph) | |
library(igraph) | |
# create some random data | |
country <- mapSpain::esp_get_prov(moveCAN=TRUE) | |
provinces <- st_cast(country,"MULTIPOLYGON") |> st_cast("POLYGON") | |
centroids <- distinct(provinces,iso2.prov.name.es,.keep_all = TRUE) |> | |
dplyr::filter(!iso2.prov.name.es%in%c("Baleares","Las Palmas","Santa Cruz de Tenerife","Ceuta","Melilla")) |> | |
st_centroid() | |
################## | |
circ_tbl <- as_tibble(st_coordinates(centroids$geometry)) |> | |
mutate(low=sample(10:50,nrow(centroids),replace = TRUE), | |
moderate=sample(10:50,nrow(centroids),replace = TRUE), | |
extreme=sample(10:50,nrow(centroids),replace = TRUE)) | |
# create the small networks | |
star_list <- suppressWarnings(lapply(seq_len(nrow(circ_tbl)), function(i) { | |
g <- graph.star(4,"out") | |
V(g)$size <- c(0,circ_tbl$low[i],circ_tbl$moderate[i],circ_tbl$extreme[i]) | |
V(g)$fill <- c(NA,"low","moderate","extreme") | |
V(g)$showlabel <- c(F,F,F,T) | |
gt_plot <- ggplotGrob( | |
ggraph(g, layout = 'circlepack', weight=size) + | |
geom_node_circle(aes(fill=fill,col=fill),show.legend = FALSE) + | |
# geom_node_label( aes(label=size, filter=showlabel),size=1,label.padding = unit(0.1, "lines")) + | |
scale_fill_manual(values = c(low="#FAC983",moderate="#F0816B",extreme="#C94D69"), | |
na.value = "transparent")+ | |
scale_color_manual(values = c(low="white",moderate="white",extreme="white"), | |
na.value = "transparent")+ | |
scale_size(limits=c(0,50))+ | |
theme_void()+ | |
coord_fixed(expand = FALSE,clip = "off") | |
) | |
panel_coords <- gt_plot$layout[gt_plot$layout$name == "panel", ] | |
gt_plot[panel_coords$t:panel_coords$b, panel_coords$l:panel_coords$r] | |
})) | |
# convert to custom annotation | |
offset <- 0.3 | |
annot_list <- lapply(seq_len(nrow(circ_tbl)), function(i) { | |
xmin <- circ_tbl$X[i] - offset | |
xmax <- circ_tbl$X[i] + offset | |
ymin <- circ_tbl$Y[i] - offset | |
ymax <- circ_tbl$Y[i] + offset | |
annotation_custom( | |
star_list[[i]], | |
xmin = xmin, | |
xmax = xmax, | |
ymin = ymin, | |
ymax = ymax | |
) | |
}) | |
p <- ggplot() + | |
geom_sf(data=provinces,fill = "#333333", color = "white",size=0.2) + | |
theme_void() | |
# put everything together | |
Reduce("+", annot_list, p) | |
ggsave("spain.png",width = 10,height=10,bg = "white") | |
# cant get it to work this way | |
gList <- lapply(seq_len(nrow(circ_tbl)),function(i){ | |
g <- graph.star(4,"out") | |
V(g)$vid <- i | |
V(g)$size <- c(0,circ_tbl$low[i],circ_tbl$moderate[i],circ_tbl$extreme[i]) | |
V(g)$fill <- c(NA,"low","moderate","extreme") | |
return(g) | |
}) | |
gfull <- Reduce("+",gList) | |
circ_layout <- create_layout(gfull,"circlepack",weight = size) | |
circ_tbl$offsetx <- circ_layout$x[!circ_layout$leaf] | |
circ_tbl$offsety <- circ_layout$y[!circ_layout$leaf] | |
circ_layout$x <- circ_layout$x-circ_tbl$offsetx[circ_layout$vid]+circ_tbl$X[circ_layout$vid] | |
circ_layout$y <- circ_layout$y-circ_tbl$offsety[circ_layout$vid]+circ_tbl$Y[circ_layout$vid] | |
ggraph(circ_layout)+ | |
geom_sf(data=provinces,fill = "#333333", color = "white",size=0.2) + | |
geom_node_circle(aes(fill=fill,col=fill,r=0.1*r),show.legend = FALSE) + | |
scale_fill_manual(values = c(low="#FAC983",moderate="#F0816B",extreme="#C94D69"), | |
na.value = "transparent")+ | |
scale_color_manual(values = c(low="white",moderate="white",extreme="white"), | |
na.value = "transparent")+ | |
theme_void()+ | |
coord_sf(expand = FALSE) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Would probably not recommend doing it this way :D. I was hoping the second part would work (line 79 onward) but I could not get it to work.