cartomix.R

## cartomix.R
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