cartomix.R

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