Last active
July 13, 2022 02:19
-
-
Save rCarto/ef52aa4e96a7b628956fbf531143ae68 to your computer and use it in GitHub Desktop.
Script to build the cartomix figure
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(cartography) | |
library(sp) | |
library(sf) | |
# Load data | |
data(nuts2006) | |
# Save image | |
sizes <- getFigDim(x = nuts0.spdf, width = 700, mar = c(0,0,0,0), res = 100) | |
png('./img/map8.png', width = sizes[1], height = sizes[2], res = 100) | |
# set margins | |
opar <- par(mar = c(0,0,0,0)) | |
# Plot basemaps | |
plot(nuts0.spdf, border = NA, col = NA, bg = "aliceblue") | |
plot(world.spdf, col = "#E3DEBF80", border=NA, add=TRUE) | |
plot(nuts0.spdf, border = "white", col = "#E3DEBF", lwd= 1.1, add=T) | |
# Plot an OSM Layer | |
spdf <- nuts3.spdf[substr(nuts3.spdf$id,1,2) %in% c('AT', 'CH', "SI", "IT"),] | |
OSMTILES <- getTiles(x = spdf, type = "osm", zoom = 5, crop = TRUE) | |
tilesLayer(x = OSMTILES, add=TRUE) | |
# Plot a choropleth layer | |
spdf <- nuts2.spdf[substr(nuts2.spdf$id,1,2) =="DE",] | |
nuts2.df$gdppercap <- nuts2.df$gdppps2008 / nuts2.df$pop2008 | |
choroLayer(spdf = spdf, df = nuts2.df, var = "gdppercap", border = "white", | |
lwd = 0.4, col = carto.pal(pal1 = "sand.pal", n1 = ), | |
legend.pos = "n", add= TRUE) | |
# Plot proportional squares | |
spdf <- nuts1.spdf[substr(nuts1.spdf$id,1,2) %in% c("BE", "NL", "LU"),] | |
propSymbolsLayer(spdf = spdf, df = nuts1.df, var = "pop2008", | |
border = "#7C000C", | |
symbols = "square", inches = 0.2, col = "#ff000080", | |
legend.pos = "n") | |
# Plot Penciled region | |
spdf <- nuts1.spdf[substr(nuts1.spdf$id,1,2) %in% c("TR"),] | |
spdf@data <- nuts1.df[substr(nuts1.df$id,1,2) %in% c("TR"),] | |
spdf <- getPencilLayer(x = st_as_sf(spdf), buffer = 50000, size = 200) | |
typoLayer(x = spdf, var = "id", add=T, col = carto.pal(pal1 = "multi.pal", 12), | |
legend.pos ="n") | |
# Plot a typologie layer | |
spdf <- nuts3.spdf[substr(nuts3.spdf$id,1,2) %in% c("EE","LT",'LV'),] | |
typoLayer(spdf = spdf, df = nuts3.df, var = "id", add=T, legend.pos = "n") | |
# Plot proportional circles | |
spdf <- nuts3.spdf[substr(nuts3.spdf$id,1,2) %in% c("FI"),] | |
propSymbolsLayer(spdf = spdf, df = nuts3.df, var = "pop2008", | |
inches = 0.15, col = "#301551", legend.pos = "n", | |
border = "white") | |
# Create and plot a grid layer (absolute) | |
spdf <- nuts3.spdf[substr(nuts3.spdf$id,1,2) %in% c("FR"),] | |
spdf@data <- nuts3.df[match(spdf$id, nuts3.df$id),] | |
mygrid <- getGridLayer(x = spdf, cellsize = 50000*50000, var = "pop2008") | |
propSymbolsLayer(x = mygrid, legend.pos = "n", border = "white", | |
var = "pop2008", inches = 0.1, col="darkblue", | |
add=TRUE) | |
# Create and plot a grid layer (relative) | |
spdf <- nuts3.spdf[substr(nuts3.spdf$id,1,2) %in% c("ES", "PT"),] | |
spdf@data <- nuts3.df[match(spdf$id, nuts3.df$id),] | |
mygrid <- getGridLayer(x = spdf, cellsize = 75000 * 75000, var = "pop2008") | |
mygrid$densitykm <- mygrid$pop2008 * 1000 * 1000 / mygrid$gridarea | |
cols <- carto.pal(pal1 = "wine.pal", n1 = 6) | |
choroLayer(x = mygrid, var = "densitykm", add=TRUE, | |
border = "grey80",col=cols, | |
legend.pos = "n", method = "q6") | |
# Plot a dot density layer | |
spdf <- nuts3.spdf[substr(nuts3.spdf$id,1,2) %in% c("SE", "NO"),] | |
dotDensityLayer(spdf = spdf, df=nuts3.df,var="pop2008", add = TRUE, | |
col = "grey30", | |
n = 100000, pch = 20, cex = 0.5, legend.pos = "n") | |
# Plot a proportional links layer | |
twincities.df <- twincities.df[substr(twincities.df$i,1,2) %in% c("IT") & | |
substr(twincities.df$j,1,2) %in% c("IT",'AT', "SI", | |
"GR", "CH"), ] | |
twincities.sf <- getLinkLayer(x = nuts2.spdf, df = twincities.df[,1:2]) | |
gradLinkLayer(x = twincities.sf, df = twincities.df,var = "fij", | |
legend.pos = "n", | |
breaks = c(1,2,4,10), lwd = c(0.5,4,10), | |
col = "#92000090", add = TRUE) | |
# Plot a label layer | |
spdf <- nuts0.spdf[nuts0.spdf$id %in% c("IS", "CY"),] | |
df <- data.frame(id = spdf$id, names = c("Cyprus", "Iceland")) | |
labelLayer(spdf = spdf, df = df, txt = "names", font = 2, halo = T) | |
# Plot Discontinuities | |
spdf <- nuts3.spdf[substr(nuts3.spdf$id,1,2) %in% c("PL", "CZ", "SK", "HU"),] | |
bord <- getBorders(x = spdf) | |
cols <- carto.pal(pal1 = "blue.pal", n1 = 3, pal2 = "green.pal", n2 = 3) | |
nuts3.df$gdppercap <- nuts3.df$gdppps2008/nuts3.df$pop2008 | |
choroLayer(spdf = spdf, df = nuts3.df, var = "gdppercap", method = "q6", | |
col = cols, add=T, border = NA, legend.pos = F) | |
discLayer(x = bord, df = nuts3.df, | |
var = "gdppercap", col = "red", nclass = 5, | |
method = "quantile", threshold = 0.25, sizemin = 1, | |
sizemax = 3, type = "rel", | |
legend.pos = "n", add = TRUE) | |
# Plot a double proportional triangles layer | |
spdf <- nuts1.spdf[substr(nuts1.spdf$id,1,2) %in% c("IE","UK"),] | |
propTrianglesLayer(spdf = spdf, df = nuts1.df, var1 = "birth_2008", | |
var2 = "death_2008", legend.pos = "n", k = 0.075) | |
# Plot a proportional symbols layer + choro | |
spdf <- nuts3.spdf[substr(nuts3.spdf$id,1,2) %in% c("GR", "BG", "MK"),] | |
propSymbolsChoroLayer(spdf = spdf, df = nuts3.df, var2 = "gdppercap", | |
var = "gdppps2008",add=T, inches = 0.15, | |
col = carto.pal(pal1 = "orange.pal", 8), | |
legend.var.pos = "n", legend.var2.pos = "n") | |
# Plot a proportional symbol layer + typo | |
spdf <- nuts2.spdf[substr(nuts2.spdf$id,1,2) %in% c("DK"),] | |
nuts2.df$bidon <- 5 | |
propSymbolsTypoLayer(spdf = spdf, df = nuts2.df, var = "bidon", var2 = "id", | |
add=T, inches = 0.05, col = carto.pal(pal1 = "multi.pal", 5), | |
legend.var.pos = "n", legend.var2.pos = "n") | |
# smooth Layer | |
spdf <- nuts2.spdf[substr(nuts2.spdf$id,1,2) %in% c("RO"),] | |
smoothLayer(spdf = spdf, df = nuts2.df, var = "pop2008", legend.pos = "n", | |
col = carto.pal(pal1 = "wine.pal", 3, "turquoise.pal", 3), nclass=6, | |
typefct = "exponential", span = 100000, beta = 3, add=T, mask = spdf, | |
lwd =0.5) | |
# Plot a layout (sources, scale, text, etc.) | |
layoutLayer(title = "", | |
sources = "Eurostat - 2008, OpenStreetMap & contributors - 2018", | |
author = "T. Giraud & N. Lambert © UMS RIATE - 2018 - cartography v2.1.3", | |
scale = NULL, | |
col = NA, | |
coltitle = "black", | |
frame = FALSE, north = FALSE) | |
# plot a scale bar | |
barscale(size = 500, lwd = 1.3, cex = 0.7) | |
# plot a north arrow | |
north(south = T) | |
dev.off() | |
sessionInfo() | |
# R version 3.5.1 (2018-07-02) | |
# Platform: x86_64-pc-linux-gnu (64-bit) | |
# Running under: Debian GNU/Linux 9 (stretch) | |
# | |
# Matrix products: default | |
# BLAS: /usr/lib/libblas/libblas.so.3.7.0 | |
# LAPACK: /usr/lib/lapack/liblapack.so.3.7.0 | |
# | |
# locale: | |
# [1] LC_CTYPE=fr_FR.UTF-8 LC_NUMERIC=C LC_TIME=fr_FR.UTF-8 | |
# [4] LC_COLLATE=fr_FR.UTF-8 LC_MONETARY=fr_FR.UTF-8 LC_MESSAGES=fr_FR.UTF-8 | |
# [7] LC_PAPER=fr_FR.UTF-8 LC_NAME=C LC_ADDRESS=C | |
# [10] LC_TELEPHONE=C LC_MEASUREMENT=fr_FR.UTF-8 LC_IDENTIFICATION=C | |
# | |
# attached base packages: | |
# [1] stats graphics grDevices utils datasets methods base | |
# | |
# other attached packages: | |
# [1] SpatialPosition_1.2.0 sf_0.7-1 sp_1.3-1 | |
# [4] cartography_2.1.3 | |
# | |
# loaded via a namespace (and not attached): | |
# [1] Rcpp_1.0.0 codetools_0.2-15 lattice_0.20-35 png_0.1-7 | |
# [5] class_7.3-14 plyr_1.8.4 grid_3.5.1 spData_0.2.9.6 | |
# [9] DBI_1.0.0 magrittr_1.5 e1071_1.7-0 units_0.6-2 | |
# [13] curl_3.2 raster_2.8-4 rgdal_1.3-6 tools_3.5.1 | |
# [17] rosm_0.2.2 abind_1.4-5 yaml_2.2.0 compiler_3.5.1 | |
# [21] classInt_0.2-3 rgeos_0.4-2 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
adapted to version 2.0.0 of cartography