Skip to content

Instantly share code, notes, and snippets.

@rCarto
Last active July 13, 2022 02:19
  • Star 4 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save rCarto/ef52aa4e96a7b628956fbf531143ae68 to your computer and use it in GitHub Desktop.
Script to build the cartomix figure
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
@rCarto
Copy link
Author

rCarto commented Sep 19, 2017

adapted to version 2.0.0 of cartography

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment