Instantly share code, notes, and snippets.

@rCarto /cartomix.R
Last active Jun 27, 2018

Embed
What would you like to do?
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.1",
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)
dev.off()
sessionInfo()
# R version 3.5.0 (2018-04-23)
# 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.6-3 sp_1.3-1
# [4] cartography_2.1.1
#
# loaded via a namespace (and not attached):
# [1] Rcpp_0.12.17 lattice_0.20-35 png_0.1-7 class_7.3-14 plyr_1.8.4
# [6] grid_3.5.0 spData_0.2.8.3 DBI_1.0.0 magrittr_1.5 e1071_1.6-8
# [11] units_0.6-0 curl_3.2 raster_2.6-7 rgdal_1.3-2 tools_3.5.0
# [16] rosm_0.2.2 abind_1.4-5 yaml_2.1.19 compiler_3.5.0 classInt_0.2-3
# [21] rgeos_0.3-28
@rCarto

This comment has been minimized.

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