/cartomix.R
Last active Apr 30, 2018
| 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 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 - 2018", | |
| author = "T. Giraud & N. Lambert © UMS RIATE - 2018 - cartography v2.0.3", | |
| 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.4.4 (2018-03-15) | |
| # 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 | |
| # [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] raster_2.6-7 sp_1.2-7 sf_0.6-2 cartography_2.0.3 | |
| # | |
| # loaded via a namespace (and not attached): | |
| # [1] Rcpp_0.12.16 lattice_0.20-35 png_0.1-7 class_7.3-14 | |
| # [5] plyr_1.8.4 grid_3.4.4 spData_0.2.8.3 DBI_0.8 | |
| # [9] magrittr_1.5 e1071_1.6-8 units_0.5-1 curl_3.2 | |
| # [13] RPostgreSQL_0.6-2 rgdal_1.2-18 tools_3.4.4 udunits2_0.13 | |
| # [17] rosm_0.2.2 abind_1.4-5 yaml_2.1.18 compiler_3.4.4 | |
| # [21] classInt_0.2-3 rgeos_0.3-26 |
This comment has been minimized.
Show comment
Hide comment
This comment has been minimized.
Show comment Hide comment
|
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
adapted to version 2.0.0 of cartography