Create a gist now

Instantly share code, notes, and snippets.

@rCarto /cartomix.R
Last active Sep 19, 2017

What would you like to do?
Script to build the cartomix figure
library(cartography)
# 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 = "#A6CAE0")
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 proportional bars
spdf <- nuts1.spdf[substr(nuts1.spdf$id,1,2) %in% c("TR"),]
plot(spdf, add=T, col = NA, border = "grey50", lwd = 0.5, lty = 2)
propSymbolsLayer(spdf = spdf, df = nuts1.df, var = "pop2008",
symbols = "bar", inches = 1, col = "#155F28",
legend.pos = "n", border = "grey")
# 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", "RO", "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")
# Plot a layout (sources, scale, text, etc.)
layoutLayer(title = "",
sources = "Eurostat - 2008, OpenStreetMap & contributors - 2016",
author = "T. Giraud & N. Lambert © UMS RIATE - 2017",
scale = NULL,
col = NA,
coltitle = "black",
frame = FALSE, north = FALSE)
# plot a scale bar
barscale(size = 500, lwd = 1.5, cex = 0.9)
# plot a north arrow
north(south = T)
# add a text
text(x = 6278256, y = 4273436, labels = "Cartographic mix
made with\nthe cartography\nR package",
cex = 1.2, adj = 1, pos = 1, font=2)
# dev.off()
sessionInfo()
# R version 3.4.1 (2017-06-30)
# Platform: x86_64-pc-linux-gnu (64-bit)
# Running under: Ubuntu 16.04.3 LTS
#
# Matrix products: default
# BLAS: /usr/lib/libblas/libblas.so.3.6.0
# LAPACK: /usr/lib/lapack/liblapack.so.3.6.0
#
# locale:
# [1] LC_CTYPE=fr_FR.UTF-8 LC_NUMERIC=C
# [3] LC_TIME=fr_FR.UTF-8 LC_COLLATE=fr_FR.UTF-8
# [5] LC_MONETARY=fr_FR.UTF-8 LC_MESSAGES=fr_FR.UTF-8
# [7] LC_PAPER=fr_FR.UTF-8 LC_NAME=C
# [9] LC_ADDRESS=C LC_TELEPHONE=C
# [11] LC_MEASUREMENT=fr_FR.UTF-8 LC_IDENTIFICATION=C
#
# attached base packages:
# [1] stats graphics grDevices utils datasets methods base
#
# other attached packages:
# [1] cartography_2.0.0 sf_0.5-4 sp_1.2-5
#
# loaded via a namespace (and not attached):
# [1] Rcpp_0.12.12 lattice_0.20-35 class_7.3-14 grid_3.4.1
# [5] DBI_0.7 magrittr_1.5 e1071_1.6-8 units_0.4-6
# [9] raster_2.5-8 rgdal_1.2-8 tools_3.4.1 udunits2_0.13
# [13] markdown_0.8 yaml_2.1.14 compiler_3.4.1 classInt_0.1-24
# [17] rgeos_0.3-23
Owner

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