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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This comment has been minimized.
rCarto commentedSep 19, 2017
adapted to version 2.0.0 of cartography