![\"Five](\"https://dieghernan.github.io/assets/img/blog/2026-11-06-postal-codes-voronoi-toy-example-1.webp\")
I recently published my project Postal codes of\nSpain, with estimated postal\nareas, an interactive map and GeoPackage downloads. But there is something we\nhave not looked at yet: how do those address points become polygons? The answer\nis… Voronoi polygons.
\n\nImagine a few shops on a flat map. Which one is closest to your house? Ask that\nquestion for every location and give each shop its own color. The result is a\nVoronoi diagram, also known as a Voronoi tessellation, Voronoi\ndecomposition, Voronoi partition or Dirichlet tessellation. This\ntechnique divides a plane into regions based on the distance to a given set of\npoints.
\n\nIn our example, each shop is a site, or generating point. Its Voronoi\ncell, also called a Thiessen polygon, contains the locations at least as\nclose to that site as to any other. Along a shared edge, two sites are\nequally close. Where several cells meet, there may be a tie between more sites.\nWith ordinary straight-line distance, the edges follow perpendicular bisectors\nbetween sites. Some cells extend indefinitely, so maps usually show them clipped\nto a study area.
\n\nThe name honors Georgy Voronoi, who studied these partitions in the early\ntwentieth century. The idea has earlier roots, including Dirichlet’s\nnineteenth-century work (hence the name Dirichlet tessellation). Pokojski and\nPokojska (2018) review the history and\ngeographical applications.
\n\nThese partitions are useful for exploring proximity to shops or public services,\nassigning areas to weather stations and studying spatial patterns. For example,\nThiessen polygons can supply area weights when estimating rainfall from rain\ngauges. The underlying question is always about the chosen distance: the nearest\nhospital in a straight line may not be the quickest one to reach.
\n\nLet’s start with five points in an imaginary square, including one at its\ncenter, using just sf and ggplot2. The coordinates have arbitrary units\nand no geographical coordinate reference system.
\n\nlibrary(sf)\nlibrary(ggplot2)\n\n# Define a common theme for the maps.\nbackground <- \"#faf8f2\"\nink <- \"#203b47\"\n\ntheme_set(\n theme_void() +\n theme(\n plot.background = element_rect(fill = background, colour = NA),\n panel.background = element_rect(fill = background, colour = NA),\n plot.title = element_text(face = \"bold\", colour = ink),\n plot.subtitle = element_text(colour = ink),\n plot.caption = element_text(colour = \"grey40\", hjust = 0),\n legend.position = \"bottom\",\n plot.margin = margin(10, 10, 10, 10)\n )\n)\n\nsites <- data.frame(\n site = c(\"A\", \"B\", \"C\", \"D\", \"E\"),\n x = c(2, 7, 3, 8, 5),\n y = c(2, 3, 8, 7, 5)\n)\n\ntoy_points <- st_as_sf(sites, coords = c(\"x\", \"y\"))\n\nstudy_area <- st_as_sfc(st_bbox(c(xmin = 0, ymin = 0, xmax = 10, ymax = 10)))\n\ntoy_cells <- toy_points |>\n st_union() |>\n st_voronoi(envelope = study_area) |>\n st_collection_extract(\"POLYGON\") |>\n st_intersection(study_area)\n\nggplot() +\n geom_sf(\n data = toy_cells,\n fill = c(\"#a8dadc\", \"#f4c89a\", \"#c6b8df\", \"#bfd59b\", \"#f2b5c4\"),\n colour = \"white\", linewidth = 1\n ) +\n geom_sf(data = toy_points, colour = \"#203b47\", size = 3) +\n geom_text(\n data = sites, aes(x, y, label = site),\n nudge_y = 0.5, colour = \"#203b47\", fontface = \"bold\"\n ) +\n coord_sf(datum = NA) +\n labs(\n title = \"Five points, five Voronoi cells\",\n subtitle = \"Each location belongs to the closest site\"\n )\n
Five points, five cells. The point E at (5, 5) has a bounded cell\nsurrounded by the other four. The outer cells extend beyond the square and are\nclipped to its edges. st_union() collects the points into one geometry,\nst_voronoi() builds the diagram and st_intersection() clips it to our\nsquare. The colors help us tell the cells apart. We have not assigned any postal\ncodes yet.
The diagram knows nothing about roads, rivers or administrative boundaries. As\nwe move to postal points, we will need to make our choices about those\nboundaries explicit.
\n\nThe Spanish project uses CartoCiudad address points with their postal codes. It\nfollows Goerlich (2022), who develops an\nidea presented by Sánchez\n(2020).\nThe updated online version\ndescribes the method in detail.
\n\nFor Slovenia, we will use GISCO’s postal points, retrieved with giscoR.\nThere is an important difference here: a representative point for a code tells\nus much less than thousands of addresses with that code. Detailed addresses help\nthe partition follow their distribution more closely, although proximity alone\nstill cannot reproduce postal delivery decisions.
\n\nWe have not established that Slovenian postal areas should follow municipal\nboundaries. Imposing those boundaries is a modeling choice for this exercise,\ninspired by the Spanish workflow, rather than a verified property of the\nSlovenian postal system.
\n\nThis post explains the workflow. The\npolygons we create are not official postal boundaries, and this exercise does\nnot validate the GISCO postal data.
\n\nFirst, let’s get the municipal boundaries and postal points. We use the 2024\nrelease of both datasets.
\n\nlibrary(giscoR)\nlibrary(sf)\nlibrary(dplyr)\n\nmunicipalities <- gisco_get_lau(\n year = 2024, country = \"SI\", epsg = 3035\n) |>\n select(GISCO_ID, LAU_NAME) |>\n st_make_valid()\n\nraw_points <- gisco_get_postalcodes(\n year = 2024, country = \"SI\", epsg = 3035\n)\nWe work in ETRS89 / LAEA Europe (EPSG:3035), a projected coordinate system\nwith coordinates in meters. This makes the 200 m and 50 m margins used later\nmeaningful. Voronoi uses Euclidean distances in this plane, rather than road\ndistances. The projection does not preserve every distance exactly either.
\n\nBefore we start drawing, what have we actually downloaded?
\n\npostal_points <- raw_points |>\n mutate(POSTCODE = trimws(as.character(POSTCODE))) |>\n filter(!is.na(POSTCODE), POSTCODE != \"\") |>\n select(POSTCODE)\n\ncode_counts <- postal_points |>\n st_drop_geometry() |>\n count(POSTCODE, name = \"points_per_code\")\n\nknitr::kable(data.frame(\n Indicator = c(\n \"Municipalities\", \"Downloaded points\", \"Points with a postal code\",\n \"Distinct postal codes\", \"Codes represented by one point\"\n ),\n Value = c(\n nrow(municipalities), nrow(raw_points), nrow(postal_points),\n nrow(code_counts), sum(code_counts$points_per_code == 1)\n )\n))\n| Indicator | \nValue | \n
|---|---|
| Municipalities | \n212 | \n
| Downloaded points | \n557 | \n
| Points with a postal code | \n557 | \n
| Distinct postal codes | \n557 | \n
| Codes represented by one point | \n557 | \n
These counts give us a first look at the file, but they are not a quality check.\nThey do not establish whether every code is present or whether the coordinates\nare correct. With one point per code, we will be drawing areas around\nrepresentatives rather than estimating them from individual addresses.
\n\nTwo points at exactly the same coordinates cannot generate separate Voronoi\ncells. We sort by postal code and keep the first point at each location, as in\nthe original workflow. This is a reproducible tie-breaking rule, not evidence\nthat the retained code is correct. The counts below show how many records we\nremove and how many locations have conflicting codes.
\n\npostal_points <- postal_points |> arrange(POSTCODE)\n\nconflicts <- postal_points |>\n group_by(geometry) |>\n summarise(codes = n_distinct(POSTCODE), .groups = \"drop\") |>\n filter(codes > 1)\n\nduplicates <- duplicated(postal_points$geometry)\n\nknitr::kable(data.frame(\n Indicator = c(\"Duplicate locations removed\", \"Locations with conflicting codes\"),\n Value = c(sum(duplicates), nrow(conflicts))\n))\n| Indicator | \nValue | \n
|---|---|
| Duplicate locations removed | \n79 | \n
| Locations with conflicting codes | \n16 | \n
\npostal_points <- postal_points[!duplicates, ]\nLet’s pick Ljubljana and keep the points inside it. We use st_within() so that\na point exactly on a shared boundary is not assigned to both neighboring\nmunicipalities.
city <- municipalities |> filter(LAU_NAME == \"Ljubljana\")\n\ncity_points <- st_filter(postal_points, city, .predicate = st_within)\n\nbase_map <- ggplot() +\n geom_sf(data = city, fill = \"#e8e4d8\", colour = ink, linewidth = 0.4)\n\ngisco_attr <- gisco_attributions()\n\nbase_map +\n geom_sf(data = city_points, colour = \"#bd5137\", size = 2) +\n labs(\n title = \"Ljubljana: the starting point\",\n subtitle = \"A municipal boundary and points with postal codes\",\n caption = gisco_attr\n )\n![\"Outline](\"https://dieghernan.github.io/assets/img/blog/2026-11-06-postal-codes-ljubljana-1.webp\")
Each cell contains locations at least as close to its generating point as to\nany other point. Cell boundaries occur where distances to two points are equal.\nFor this first demonstration, we keep all interior points, without the margins used in\nthe national workflow.
\n\ncells <- city_points |>\n st_union() |>\n st_voronoi(envelope = st_as_sfc(st_bbox(city))) |>\n st_collection_extract(\"POLYGON\") |>\n st_sf(geometry = _)\n\nbase_map +\n geom_sf(data = cells, fill = NA, colour = \"#bd5137\", linewidth = 0.5) +\n geom_sf(data = city_points, colour = ink, size = 2) +\n labs(\n title = \"An area of proximity for every point\",\n subtitle = \"Cells still extend beyond the municipal boundary\",\n caption = \"Own elaboration using data from Eurostat / GISCO, 2024\"\n )\n![\"Unclipped](\"https://dieghernan.github.io/assets/img/blog/2026-11-06-postal-codes-voronoi-1.webp\")
st_union() gathers the points so we build one diagram. One detail to keep in\nmind: envelope supplies a working extent, but does not clip the cells to\nthe municipality. We need an intersection for that.
It would be convenient if cells came out in the same order as the input points,\nbut we should not rely on that. Instead, we recover each cell’s code with a\nspatial relationship before clipping. Each cell must contain exactly one\ngenerating point.
\n\npoint_matches <- st_intersects(cells, city_points)\n\ncells$POSTCODE <- city_points$POSTCODE[unlist(point_matches)]\n\nclipped_geometry <- st_intersection(st_geometry(cells), st_geometry(city))\n\ncity_cells <- st_sf(\n POSTCODE = cells$POSTCODE[attr(clipped_geometry, \"idx\")[, 1]],\n geometry = clipped_geometry\n)\n\ncity_areas <- city_cells |>\n group_by(POSTCODE) |>\n summarise(.groups = \"drop\") |>\n st_make_valid()\n\ncity_colours <- setNames(\n hcl.colors(nrow(city_areas), palette = \"Dark 3\"),\n sort(city_areas$POSTCODE)\n)\ncity_labels <- st_sf(\n POSTCODE = city_areas$POSTCODE,\n geometry = st_point_on_surface(st_geometry(city_areas))\n)\n\nggplot(city_areas) +\n geom_sf(aes(fill = POSTCODE), colour = background, linewidth = 0.6) +\n geom_sf(\n data = city_points, shape = 21, fill = ink,\n colour = background, size = 2.4\n ) +\n geom_sf_text(\n data = city_labels,\n aes(label = POSTCODE), colour = ink, fontface = \"bold\", size = 3.5\n ) +\n scale_fill_manual(values = city_colours, guide = \"none\") +\n coord_sf(datum = NA) +\n labs(\n title = \"From points to estimated areas\",\n subtitle = \"Cells clipped and merged by postal code\",\n caption = \"Teaching example · Not official postal boundaries\"\n )\n![\"Six](\"https://dieghernan.github.io/assets/img/blog/2026-11-06-postal-codes-clip-cells-1.webp\")
We intersect the geometry columns, then use the intersection’s idx matrix to\nrecover each cell’s postal code. This keeps the attribute assignment explicit.\nLabel positions are also calculated from geometries alone.
Grouping by postal code with summarise() merges the geometries. With many\naddresses sharing a code, their cells would dissolve into one geometry, possibly\nwith several separate parts.
Ljubljana is done. Now let’s repeat the operation for each component of each\nmunicipality. Municipalities can have separate pieces: normalizing to\nMULTIPOLYGON and then casting to POLYGON lets us handle them independently,\nwithout automatically extending a code to a piece with no points.
The municipality ID and name apply to every component, so we mark those\nattributes as spatially constant before splitting the geometries.
\n\ncomponents <- municipalities |>\n st_set_agr(\"constant\") |>\n st_cast(\"MULTIPOLYGON\") |>\n st_cast(\"POLYGON\") |>\n mutate(component_id = row_number())\nIn the Spanish project, we first select addresses within an inward margin of\n200 m. If none are found, we try 50 m. This reduces the influence of\npoints close to a boundary, where small mismatches between layers may affect\ntheir assignment.
\n\nThere is no universal rule behind these numbers. Goerlich describes a 20 m\nmargin. The 200 m and 50 m choices come from my implementation. We keep them\nhere to explain that workflow, although sparse postal points make it easier to\nexclude useful information. Comparing other margins would be a useful next step.
\n\nselect_points <- function(component, postal_points) {\n for (margin in c(200, 50)) {\n interior <- st_buffer(st_geometry(component), -margin)\n\n if (all(st_is_empty(interior))) next\n\n selected_points <- st_filter(postal_points, interior,\n .predicate = st_within\n )\n\n if (nrow(selected_points) > 0) {\n return(selected_points)\n }\n }\n\n postal_points[0, ]\n}\nThe margin only selects points: the resulting areas cover the original\ncomponent, not the smaller buffered geometry. If both attempts fail, we leave\nthe component unassigned. We do not borrow the nearest point from outside the\nmunicipality.
\n\nThere are three cases to handle. With no points, we keep the component and\nassign NA. If all selected points share a code, we assign it to the whole\ncomponent. We only need Voronoi when several codes are present: no need to split\nan area that already has a single assignment.
build_areas <- function(component, postal_points) {\n selected_points <- select_points(component, postal_points)\n\n codes <- unique(selected_points$POSTCODE)\n\n if (length(codes) <= 1L) {\n component$POSTCODE <- if (length(codes)) codes else NA_character_\n return(component)\n }\n\n cells <- selected_points |>\n st_union() |>\n st_voronoi(envelope = st_as_sfc(st_bbox(component))) |>\n st_collection_extract(\"POLYGON\") |>\n st_sf(geometry = _)\n\n point_matches <- st_intersects(cells, selected_points)\n\n cells$POSTCODE <- selected_points$POSTCODE[unlist(point_matches)]\n\n clipped_geometry <- st_intersection(\n st_geometry(cells),\n st_geometry(component)\n )\n\n result <- st_sf(\n POSTCODE = cells$POSTCODE[attr(clipped_geometry, \"idx\")[, 1]],\n geometry = clipped_geometry\n ) |>\n group_by(POSTCODE) |>\n summarise(.groups = \"drop\") |>\n st_make_valid()\n\n result$GISCO_ID <- component$GISCO_ID\n\n result$LAU_NAME <- component$LAU_NAME\n\n result$component_id <- component$component_id\n\n result\n}\n\nresult <- lapply(seq_len(nrow(components)), function(i) {\n build_areas(components[i, ], postal_points)\n}) |>\n bind_rows()\nCan we fill any of the gaps? A component without points may belong to a\nmunicipality whose other components have information. We recover its code only\nif the municipality has one distinct recovered code. This is an imputation\nfrom the available data, not proof that the municipality really has just one\ncode.
\n\nunique_codes <- result |>\n st_drop_geometry() |>\n filter(!is.na(POSTCODE)) |>\n distinct(GISCO_ID, POSTCODE) |>\n add_count(GISCO_ID) |>\n filter(n == 1)\n\nunassigned_before <- sum(is.na(result$POSTCODE))\n\nindex <- match(result$GISCO_ID, unique_codes$GISCO_ID)\n\nrecoverable <- is.na(result$POSTCODE) & !is.na(index)\n\nresult$POSTCODE[recoverable] <- unique_codes$POSTCODE[index[recoverable]]\nBefore drawing the final map, let’s tidy up the geometries and keep only\nsurfaces. Repairs can produce collections containing residual lines or points,\nwhich do not belong in an area layer. Dissolving by postal code also removes\nmunicipal boundaries between areas sharing that code.
\n\nkeep_surfaces <- function(x) {\n geometry <- st_make_valid(st_geometry(x))\n\n geometry <- lapply(geometry, function(part) {\n if (!inherits(part, c(\"POLYGON\", \"MULTIPOLYGON\", \"GEOMETRYCOLLECTION\"))) {\n return(st_multipolygon())\n }\n\n surfaces <- suppressWarnings(st_collection_extract(st_sfc(part), \"POLYGON\"))\n\n if (length(surfaces) == 0L || all(st_is_empty(surfaces))) {\n return(st_multipolygon())\n }\n\n st_cast(st_union(surfaces), \"MULTIPOLYGON\", warn = FALSE)[[1]]\n })\n\n st_geometry(x) <- st_sfc(geometry, crs = st_crs(x))\n\n x[!st_is_empty(x), ]\n}\n\nunassigned <- result |>\n filter(is.na(POSTCODE)) |>\n keep_surfaces()\n\npostal_areas <- result |>\n filter(!is.na(POSTCODE)) |>\n group_by(POSTCODE) |>\n summarise(.groups = \"drop\") |>\n keep_surfaces() |>\n st_cast(\"MULTIPOLYGON\")\nFor the national overview, let’s color the areas by the first digit of their\ncode. This keeps the map readable, without claiming that we have validated a\nclassification of postal regions. Gray is reserved for unassigned components,\nwith their own legend entry.
\n\npostal_colours <- c(\n \"1\" = \"#007F7F\", \"2\" = \"#E87500\", \"3\" = \"#3B6FB6\", \"4\" = \"#A64E9A\",\n \"5\" = \"#649A32\", \"6\" = \"#D9AF00\", \"8\" = \"#B94350\", \"9\" = \"#6255A4\",\n \"Unassigned\" = \"#727A80\"\n)\n\npostal_groups <- sort(unique(substr(postal_areas$POSTCODE, 1, 1)))\n\nggplot() +\n geom_sf(data = municipalities, fill = \"#d5d2ca\", colour = NA) +\n geom_sf(\n data = postal_areas,\n aes(fill = substr(POSTCODE, 1, 1)), colour = background, linewidth = 0.15\n ) +\n geom_sf(\n data = unassigned, aes(fill = \"Unassigned\"),\n colour = background, linewidth = 0.15\n ) +\n scale_fill_manual(\n values = postal_colours, name = \"Postal code group\",\n breaks = c(postal_groups, \"Unassigned\"),\n labels = c(paste0(postal_groups, \"xxx\"), \"Unassigned\")\n ) +\n coord_sf(datum = NA) +\n labs(\n title = \"Slovenia, point by point\",\n subtitle = \"Proximity areas clipped to municipal boundaries\",\n caption = paste(\"Eurostat / GISCO, 2024 · Own elaboration\",\n \"Dark grey: unassigned areas · Estimated boundaries, not official\",\n sep = \"\\n\"\n )\n )\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/2026-11-06-postal-codes-slovenia-postal-codes-1.webp\")
The map is ready, but let’s check the geometry before going further. Are the\npolygons valid? Do assigned and unassigned areas cover the territory? Are there\nany appreciable overlaps? We allow one square meter for numerical differences in\nthe geometry operations.
\n\nterritory <- st_union(st_geometry(municipalities))\n\ncoverage <- st_union(c(st_geometry(postal_areas), st_geometry(unassigned)))\n\ndifference_m2 <- as.numeric(sum(st_area(st_sym_difference(territory, coverage))))\n\noverlap_m2 <- as.numeric(\n sum(st_area(postal_areas)) + sum(st_area(unassigned)) - sum(st_area(coverage))\n)\n\nknitr::kable(data.frame(\n Indicator = c(\n \"Codes with an estimated area\", \"Components assigned by municipal recovery\",\n \"Unassigned records\", \"Unassigned area (km²)\",\n \"Coverage difference (m²)\", \"Overlap (m²)\"\n ),\n Value = round(c(\n nrow(postal_areas), sum(recoverable), nrow(unassigned),\n as.numeric(sum(st_area(unassigned))) / 1e6, difference_m2,\n overlap_m2\n ), 4)\n))\n| Indicator | \nValue | \n
|---|---|
| Codes with an estimated area | \n468.0000 | \n
| Components assigned by municipal recovery | \n4.0000 | \n
| Unassigned records | \n6.0000 | \n
| Unassigned area (km²) | \n150.2033 | \n
| Coverage difference (m²) | \n0.0000 | \n
| Overlap (m²) | \n-0.0002 | \n
These checks verify the geometry, not postal accuracy. We could cover an\nentire country with valid polygons and still have a poor approximation of its\ndelivery areas.
\n\nWe now have the full sequence: points, proximity areas, clipping and merging by\npostal code. The same steps work with much more detailed addresses, such as the\nCartoCiudad data in my Spanish postal codes\nproject.
\n\nThe input data matters as much as the algorithm. With one representative point\nper code, Voronoi mainly maps distances between representatives. With address\npoints, it can better approximate where each code’s addresses are concentrated.\nIt still knows nothing about delivery routes, physical barriers or official\nboundaries.
\n\nWe have not compared these results with an independent postal source for\nSlovenia. Before using them for analysis, we would need to review coverage,\ncoordinates, the relationship with municipalities and sensitivity to the\nmargins. For now, we have a working example that shows how the polygons are\nbuilt, one step at a time.
\n\nThe title is a nod to Muse’s album Black Holes and Revelations.
\n\n\n\n![\"DOI\"](\"https://zenodo.org/badge/DOI/10.5281/zenodo.23698418.svg\"){kind=icon}
Códigos postales de España provides estimated postal code areas for Spain,\nbuilt from open address data from CartoCiudad\nand administrative boundaries. Explore the results on interactive maps and\ndownload the data for use in R, Python or QGIS.
\n\nPostal code polygons are useful for linking addresses and statistics to areas\non a map. According to Goerlich (2022),\nthe Correos polygons available through CartoCiudad stopped being offered for\ndownload in early 2017. This project explores a reproducible alternative based\non open address data.
\n\nAn early reference is José Ignacio Sánchez’s\n2020 article in NoSoloSIG,\nwhich describes how to estimate postal areas from CartoCiudad addresses using\nGIS tools. This project applies the approach developed in\nFrancisco José Goerlich’s 2022 work,\nwith its own choices for selecting addresses and handling areas without an\nassignment.
\n\nThe project website includes\ninteractive maps and two GeoPackage downloads: a full version for spatial\nanalysis and a simplified version for visualization. Both include postal code\nareas and administrative areas pending assignment.
\n\nThe data is shared under a\nCreative Commons Attribution 4.0 International license.
\n\nSearch for a postal code or address, select a two-digit prefix and compare the\nestimated areas with CartoCiudad. The viewer uses the simplified data and does\nnot display areas pending assignment. Its controls are in Spanish.
\n\n\n Open the map in a full window\n Viewer guide\n
\n\n\n\nFollowing Goerlich’s approach, the workflow treats each separate component of\nan administrative area independently. When the selected addresses share a\nsingle postal code, it assigns that code to the whole component. When several\ncodes are present, it builds Voronoi polygons around the address locations,\nclips them to the administrative boundary and merges areas with the same code.\nThe final polygons are dissolved by postal code across provinces.
\n\nThis implementation selects addresses using an inward buffer of 200 m, with a\nsecond attempt at 50 m if none are found, rather than the 20 m described by\nGoerlich. Components without selected addresses remain unassigned unless the\nmunicipality has a single postal code recovered from its other components.\nThe administrative boundaries come from\nLAU2boundaries4Spain, by Francisco José\nGoerlich and Pedro Pérez Vázquez.
\n\nThese are estimated areas, not official postal boundaries. Coverage depends on\nthe source addresses and some areas remain unassigned. The\nrepository documents the sources,\nmethodology, limitations and steps to reproduce the data.
\n\n![\"DOI\"](\"https://zenodo.org/badge/DOI/10.5281/zenodo.23932940.svg\"){kind=icon}
GIFs brings together structured data on large forest fires in Spain and\nR code for an infographic inspired by\nDominic Royé’s firefly cartography.\nHere, GIF means gran incendio forestal: a fire with at least 500 hectares\nof forest area burned.
\n\nThe project combines exports from MITECO’s General Forest Fire Statistics\n(EGIF) with its annual reports and provisional updates. It preserves source\ninformation and reconciliation notes so that users can trace how records\nwere selected, grouped and located.
\n\n![\"Large](\"https://dieghernan.github.io/gifs/gif_spain.png\")
The collection currently provides two complementary views:
\n\negif_part_id and includes source fields, burned areas, cause, provenance,\nnotes and coordinates where they can be interpreted.fire_id; a fire may bring together\nseveral EGIF reports.These are different units of observation. Do not add the two tables’ row\ncounts or burned areas together. The 500-hectare threshold is applied after\nexplicitly documented groupings of reports belonging to the same fire.
\n\nEGIF takes priority when a documented match exists. Records without a match\nretain their original MITECO annual report or provisional update. Reports\nawaiting reconciliation keep an empty fire_id and are not automatically\nadded as new fires, which helps avoid double counting.
The fire-level records span February 27, 2010 to September 26, 2026. These\nare the first and last dates in the file, not evidence of complete annual\ncoverage. The project is not a real-time monitoring service.
\n\nThe documented reconciliation still has nine earlier fire records and eight\nselected EGIF reports awaiting a match. Two additional records retain their\nprovisional source because their province has no reports in the 2023 EGIF\nexport. That export contains no records for seven provinces, so an absence\nfrom these files should not be interpreted as an absence of fires.
\n\nThe methodology\nexplains source priority, explicit groupings and unresolved cases. The\ndata guide\ndocuments the source exports and processing. The original ZIP files are\npreserved with SHA-256 checksums.
\n\nGeographic coordinates use EPSG:4326, keeping the Canary Islands in their\nactual location. EGIF coordinates are transformed only when their coordinate\nsystem can be interpreted. Missing coordinates or an unknown datum leave the\ngeographic coordinates empty rather than producing an invented point.
\n\nThe fire-level view uses interpretable EGIF coordinates where available and\nan identified municipal reference location otherwise. location_method\ndistinguishes these sources. For fires with several reports, the view records\nwhich report supplies its reference point. Declared municipality codes and\nmunicipalities obtained through a spatial join are retained separately.
The points are reference locations, not fire perimeters. Municipal reference\nlocations come from IGN through SIANE and mapSpain. The infographic reads\nthe reconciled fire view and uses circle sizes to show forest area burned.
\n\nBoth products are available in CSV, JSON and GeoJSON from the\nproject website. Read identifiers and\nmunicipality codes as text to preserve their representation. JSON supplies\nexplicit types and null values; GeoJSON retains records without usable\ncoordinates with geometry: null.
Machine-readable field descriptions are provided separately in the\nEGIF report Croissant metadata\nand the fire-level Croissant metadata.
\n\nFor reproducible analyses, cite the DOI of the version used. The collection’s\nversion 2.0.0 DOI identifies the\narchived release; the general DOI\ngroups the project’s releases.
\n\nData reuse follows the\nMITECO legal notice,\nincluding attribution and preservation of the original conditions and metadata.\nThe municipal cartography credits CartoBase ANE 2006–2024, CC BY 4.0, IGN.\nThe repository’s MIT license applies to code and documentation. The project\nis independent and does not imply MITECO participation or endorsement.
\n\nWhat would happen if we peeled the Earth like an orange? The\ninterrupted Goode homolosine projection\ngives us something close to that! This equal-area projection preserves relative\nareas while splitting the world map into lobes. Add a few shades of orange and\nour world is ready to peel.
\n\nLet’s make it with sf, giscoR and ggplot2. First, we get the\ncoastlines and draw the outline, following the cuts between the lobes.
\n\nlibrary(sf)\nlibrary(ggplot2)\nlibrary(giscoR)\nlibrary(showtext)\n\nworld <- gisco_get_coastal_lines(resolution = 10)\ngoode_crs <- \"+proj=igh\"\nlat <- c(90:-90, rep(c(-90:0, 0:-90), 3), -90:90, 90:0, 0:90, 90)\nlon <- c(\n rep(180, 181),\n rep(c(80.01, 79.99, -19.99, -20.01, -99.99, -100.01), each = 91),\n rep(-180, 181),\n rep(c(-40.01, -39.99), each = 91),\n 180\n)\noutline <- st_sfc(st_polygon(list(cbind(lon, lat))), crs = 4326) |>\n st_transform(goode_crs)\nrectangle <- st_as_sfc(st_bbox(outline) * 1.1)\nmask <- st_difference(rectangle, outline)\nNext, we draw the meridians and parallels within each lobe so that they do not\nconnect across the cuts.
\n\nlobes <- list(\n c(-180, -40, 0, 90), c(-40, 180, 0, 90),\n c(-180, -100, -90, 0), c(-100, -20, -90, 0),\n c(-20, 80, -90, 0), c(80, 180, -90, 0)\n)\nlines <- lapply(lobes, function(b) {\n west <- b[1] + 0.01\n east <- b[2] - 0.01\n south <- max(b[3], -89.99)\n north <- min(b[4], 89.99)\n meridians <- seq(-180, 180, 30)\n meridians <- meridians[meridians > west & meridians < east]\n parallels <- seq(-60, 60, 30)\n parallels <- parallels[parallels >= south & parallels <= north]\n c(\n lapply(meridians, function(x) {\n st_linestring(cbind(x, seq(south, north, length.out = 181)))\n }),\n lapply(parallels, function(y) {\n st_linestring(cbind(seq(west, east, length.out = 361), y))\n })\n )\n})\ngrat <- st_sfc(do.call(c, lines), crs = 4326) |>\n st_transform(goode_crs)\nFinally, we add the orange palette. The mask hides anything outside the outline\nand keeps the edges of our peel tidy.
\n\nfont_add_google(\"Coiny\", family = \"coiny\")\n\nshowtext_auto()\n\nggplot() +\n geom_sf(data = outline, fill = \"#FFF0D9\", colour = NA) +\n geom_sf(data = world, fill = \"#F9B566\", colour = \"#B34D08\", linewidth = 0.25) +\n geom_sf(data = grat, fill = NA, colour = \"#E8A45B\", linewidth = 0.25) +\n geom_sf(data = mask, fill = \"#fcf1e7\", colour = NA) +\n geom_sf(data = outline, fill = NA, colour = \"#E87516\", linewidth = 0.4) +\n coord_sf(\n crs = goode_crs,\n xlim = st_bbox(outline)[c(\"xmin\", \"xmax\")],\n ylim = st_bbox(outline)[c(\"ymin\", \"ymax\")],\n expand = FALSE,\n datum = NA\n ) +\n theme_void() +\n theme(\n text = element_text(family = \"coiny\"),\n plot.background = element_rect(fill = \"#fcf1e7\", colour = NA),\n plot.title = element_text(\n color = \"#E87516\", face = \"bold\", size = rel(3),\n margin = margin(b = 10)\n ),\n plot.margin = margin(10, 10, 10, 10),\n plot.caption = element_text(\n color = \"#E87516\", size = rel(1.5),\n margin = margin(t = 10)\n )\n ) +\n labs(\n title = \"Let's peel the world\",\n caption = \"Interrupted Goode homolosine projection\"\n )\n![\"World](\"https://dieghernan.github.io/assets/img/blog/202610_goode-map-1.webp\")
Conversations about a blog post often happen somewhere else. Someone shares a\nlink, replies on their own site or reacts to a post on social media. I wanted\nto bring some of that activity back here.
\n\nThis implementation was directly inspired by Matt Hobbs’s article,\nImplementing Webmentions on this blog,\npublished on Nooshu.
\n\nI liked its simple presentation: links to mentions and replies,\nfollowed by small groups of avatars for likes and reposts. So I added a\nsimilar section to this blog, using the typography, colors and buttons from\nChulapa.
\n\nA Webmention is a notification that one\npage links to another. If you write\nabout one of my posts on your own site, you can send its URL so the link can\nappear below the original article.
\n\nThis blog already advertised a Webmention.io\nendpoint. The missing piece\nwas displaying the mentions it had collected. A small JavaScript file now\nrequests the public mentions for each post’s canonical URL and builds the\nsection automatically when the page opens.
\n\nMentions and replies appear as a numbered list of links and authors. Likes\nand reposts have their own counts and rows of overlapping avatars. The\ncontent stays on its original site. Each link takes you to the conversation.\nThe existing GitHub comments are still available, too.
\n\nThe implementation uses a Jekyll include, a stylesheet and plain JavaScript.\nThere is no extra Jekyll plugin or change to the deployment workflow.\nWebmention.io handles receiving and verifying links, while the browser\nloads the results through its public API.
\n\nI tried it with the geobounds post,\nwhich already had mentions, and with a recent post that had none. Both cases\nmatter: an empty section should still explain how to join in.
\n\nSharing a link on a social network only brings reactions here if a bridge sends\nthem as Webmentions.
\n\nWritten something that links to this post? Open Shared your thoughts on this\npost? Drop your link here! below and submit your page’s URL. The form works\nwithout JavaScript, although displaying existing mentions requires it.
\n\nThanks to Matt Hobbs for the inspiration and for sharing his\nimplementation.\nIt is a nice way to let a static blog take part in a wider conversation.
\n\nAI assistance: I wrote this post with help from\nCodex, including drafting and editing the text. Codex also\nhelped implement and test the Webmentions section. The header image was\nalso generated with AI.
\nThis website uses my Jekyll theme,\nChulapa. Some time ago, I\nstarted wondering whether I could add a chatbot to its documentation. The docs\nalready explain the settings, layouts and snippets, but you sometimes need to\nknow what a feature is called before finding it. Could I make that a little\neasier?
\n\nThe idea was simple: ask a question, get a useful example and follow a link to\nthe original docs. With Codex,\nOpenAI’s coding agent, I had an initial version working on the page in\nless than an hour: I could open the widget, send a question and read its\nanswer. That was the prototype, though. Checking its answers and making it\nbehave properly on a phone took quite a few more rounds.
\n\nI started with references rather than an empty editor. The freeCodeCamp\ntutorial on an embeddable\nchatbot\nprovided a practical starting point for a browser widget backed by\nCloudflare Workers. I also liked the visual approach in Malte Grosser’s chatbot\npost.
\n\nI built the implementation with Codex. I described what I wanted, supplied\nthose references and asked it to inspect the existing theme and documentation.\nThere were three pieces to work on: the widget visitors use in the browser,\nthe Worker that processes requests on Cloudflare and a context file containing\na summary of the documentation supplied to the model. We worked through them\ntogether. I tested the page, asked the chatbot questions and brought back\nscreenshots when something looked wrong. Codex helped turn that feedback\ninto code changes.
\n\nWorking this way let me spend more time trying the assistant as a visitor\nwould: does this answer help\nme configure my site? Can I read it with the keyboard open? What happens after a\nlong conversation?
\n\nAt first, I considered adding the chatbot as a theme feature. That quickly felt\nlike too much to ask of someone who just wants a Jekyll site. An AI account, a\nseparate backend and a maintained knowledge summary would become part of their\nsetup.
\n\nSo I kept it as an extension of the theme’s documentation site. The\nimplementation and evaluation\nfiles live\nunder docs/ai-chatbot/ in the theme repository. Someone using the theme does\nnot need to set up a Worker or maintain an AI context. This also gives me room\nto experiment without making every experiment part of the template.
Jekyll builds the static documentation pages. I chose a separate service\nto process the chatbot’s questions. A script loads the chat\nwidget, and a Cloudflare Worker serves the widget and handles questions. The\nWorker sends the question, instructions and a reviewed documentation summary to\nWorkers AI, Cloudflare’s service for running AI models, then returns the\nanswer to the browser.
\n\nThe model currently configured is Gemma, using the identifier\n@cf/google/gemma-4-26b-a4b-it. The Worker accesses it through an AI binding:\na connection configured in Cloudflare that lets the Worker call Workers AI.\nThat connection stays on the server side, so visitors do not receive an API key.\nCodex helped me build and test the implementation. Gemma is the model\nthat answers visitors’ questions.
There is no automatic document retrieval in this implementation. The context is\na Markdown file maintained alongside the code. Adding a documentation URL or the\nRSS feed URL gives the model a reference to share. The Worker still relies on\nthe maintained context file for page content and new posts.
\n\nThat was an intentional starting point. I can inspect exactly which facts the\nassistant receives, and updating it does not require a vector database or a\ndocument indexing pipeline. The tradeoff is that I have to keep that summary\ncurrent.
\n\nMaking the answers readable was another part of the interface work. They\narrive as Markdown, which Marked converts to HTML for lists, code blocks\nand links. DOMPurify then removes potentially dangerous HTML before the\nanswer is displayed. Visitors can copy code and follow permitted documentation\nlinks. Mentions of the theme use its chulapa class, while code and\nconfiguration identifiers retain their original formatting.
One of my first questions was: “Can I add video here?” The answer did not really\nhelp. I knew the docs explained how to do it, so I asked Codex to check what the\nassistant was receiving. The summary needed the video snippet and its options,\nnot just a general mention that videos were supported.
\n\nAnother exchange made the problem particularly obvious. The theme has built-in\nskins that change the site’s visual appearance. I asked how to change a skin,\nand the assistant explained chulapa-skin.skin. Then I asked which skins\nwere available. It replied that there were more than 40, but gave no names. That\nwas related to the question, yet it did not help me choose anything.
I added actual skin names and a link to the visual catalog to the context,\nalong with an instruction to give examples when someone asks what is available.\nIn the follow-up tests, the assistant returned skin names and a link to the\ncatalog instead of just repeating the number of choices. That was a useful\nimprovement I could check directly, even though other answers still needed work.\nFor\nconfiguration questions, a small complete example is often more useful than\nanother paragraph. For example, this goes in the site’s _config.yml to\nselect the darkly skin:
chulapa-skin:\n skin: darkly\nI expanded the summary selectively: installation, configuration, layouts,\nvideos, galleries, navigation, search, comments, SEO and the FAQ. Later passes\nadded Sass variables and Markdown guidance. I tried to include the details that\nlet someone act: exact option names, defaults, a short example and the right\nsource page.
\n\nCopying all the docs into the prompt would have been easier to automate. It\nwould also make each request larger and leave plenty of irrelevant information\ncompeting with the answer. The goal was informative help with a manageable\ncontext, rather than the longest possible context.
\n\nI asked Codex to work through the documentation in batches and send basic and\nadvanced questions to the live assistant. Installation and skin changes were\nonly the beginning. We also checked project-site URLs, favicons, local videos,\ngalleries, highlighting and combinations of settings. I reviewed the results and\nused the weak answers to decide where the context needed more detail.
\n\nI also asked Codex to look for real user questions in the\nIssues and\nDiscussions of the\nChulapa repository. These helped us test the\nassistant with the wording people actually use when they get stuck, rather\nthan only questions based on documentation headings. We used those questions\nto prepare evaluation cases and checked the answers against the docs. Feature\nrequests needed particular care: someone asking for an option does not mean\nthe theme already supports it.
\n\nWe added an evaluation script that sends questions to the live assistant in\nbatches and saves the full responses. That gives me a record to review for\nthe explanation, code and source links. A successful HTTP response only means that the request\nworked. It says nothing about whether the YAML is correct, the answer covers\nevery part of the question or the link points to the right page.
\n\nSome failures were subtle: a plausible option in the wrong place, an incomplete\nexample or a source link with an invented anchor. Follow-up tests helped target\nthose weaknesses. I also included unsupported features and unrelated questions\nto check whether the assistant would acknowledge missing information.
\n\nThis process is sometimes called “training the chatbot,” but I did not train or\nfine-tune the model. I improved the supplied context and instructions, then\ntested the resulting answers. Those changes can help, but they do not guarantee\nthat every future response will be correct.
\n\nThe widget keeps recent messages in the tab’s session storage, making it easier\nto return to an answer while browsing. Each request to the model is independent,\nhowever: earlier messages are not sent with the next question. This started as\na limitation of the prototype, rather than a deliberate choice to rule out\nconversational memory, and remains a limitation of the version described here.\nKeeping the history visible does not change what the backend sends to the model.
\n\nThat distinction needed to be visible. A familiar chat interface naturally\ninvites questions such as “And what about that one?” Here, it is better to ask a\ncomplete question. I added that guidance near the input and a clear-chat control\nfor the local history.
\n\nThe interface took several rounds of testing on a real phone. Opening the\nkeyboard could zoom the page or leave the panel clipped. Rotating the phone made\nthe available space even smaller. A desktop browser resized to a narrow width\nwas useful, but it did not reproduce all of those behaviors.
\n\nThe input now uses a mobile-friendly text size, and the panel follows the\nspace actually visible on screen when the keyboard opens. That available area\nis called the visual viewport. Using it helps the panel fit above the keyboard.\nOpening the chat on mobile does not automatically focus the input and summon\nthe keyboard.
\n\nLong conversations revealed another bug: a second scrollbar appeared on the\nouter panel, followed by a large empty area below the form. Constraining the\nmessage log and clipping its paint overflow kept scrolling inside the history,\nwith the header and question form visible.
\n\nThe button that opens the chatbot also had to coexist with the theme’s floating\nmenu button and its separate table-of-contents control. After trying different\npositions, I settled on stacking the chatbot button above the menu button on\nsmaller screens, matching its size and right margin, with a gap between them.\nSmall alignment differences were much more\nnoticeable than I expected.
\n\nI wanted the launcher to fit the site visually and still be easy to recognize.\nWe tried a robot icon first, then settled on a small sparkle SVG for opening\nthe assistant and a paper-plane icon for sending a question. The SVG uses\ncurrentColor, so its color follows the button’s CSS instead of being fixed\ninside the image. That makes it easier to keep the icon consistent with the\nrest of the control.
I wanted to keep the experiment within the Free account’s allowance, including\nthe requests we sent while testing. The Worker has input checks, a bounded\nresponse length and a rate-limit binding\nconfigured for five requests per IP per minute. Live testing eventually produced\na rejection, but it also showed that the cutoff was not exactly the sixth\nrequest. Cloudflare describes this limiter as approximate and local to each\nlocation, meaning a Cloudflare data center, in its Rate Limiting API\ndocumentation.\nIt is useful protection, not an exact global usage counter.
\n\nThe per-IP limit controls how often a visitor can send questions. The account’s\nquota limits total AI usage. I kept the account on the Free plan without\nconfiguring a paid alternative to continue answering when its allowance runs\nout. The current allowances are listed in\nCloudflare’s Workers AI pricing.
\n\nTo maintain this implementation, I run these commands from the\nChulapa repository:
\n\ncd docs/ai-chatbot\nnpm ci\nnpm run build\nnpm test\nnpx wrangler deploy\nThese commands build, test and deploy the existing Worker. A new chatbot needs\nadditional setup. A GitHub Pages deployment publishes the documentation,\nwhile wrangler deploy updates the assistant.\nChanges to the context reach the live model only after rebuilding and deploying\nthe Worker.
I also added an AGENTS.md file with repository instructions for Codex and\nother coding agents: when documentation changes, review the assistant’s context\nand relevant evaluation cases. That makes this check part of the work on the\ndocs, instead of something I have to remember afterward.
I want someone to ask a practical question, receive an informative answer and\nleave with a working example or a useful documentation link. There are still\nlimitations: independent questions require enough detail, combined questions can\nlose a part of the answer, and source links need continued checking.
\n\nYou can try it on the\nChulapa documentation site. Open the sparkle button and\nask a complete question about your setup. I would love to hear which answers\nhelped and which ones sent you back to the docs!
\n\nThe most useful part of the process was trying the assistant with questions I\nalready knew how to answer. It made the gaps easy to spot: an answer could sound\nreasonable and still leave me without the setting or example I needed. That is\nwhat I want to keep checking as the documentation grows.
\n\nAI assistance: I wrote this post with help from\nCodex, including drafting and editing the text. I reviewed it\nagainst the implementation and my experience building the chatbot. The header\nillustration was also generated with AI.
\nIf you’ve ever worked with spatial data in R, this may ring a bell…
\n\nWhile searching for new data sources, I found the excellent\ngeoBoundaries database. However, accessing the\ndata can be tedious since it’s provided as zipped shapefiles, and as any GIS\nprofessional knows, shapefiles should die!
\n\nPreviously, the rgeoboundaries package was on CRAN and allowed access to\nthe geoBoundaries API, but it was archived. So I decided to create my own\nversion, and geobounds was born.
\n\nIt connects directly to the excellent\ngeoBoundaries database and returns clean,\nready-to-use sf objects with a single function call. No manual downloads and\nno shapefile handling.
\n\nThis is how it works.
\n\ngeobounds was recently accepted on\nCRAN, so just install it with:
\n\ninstall.packages(\"geobounds\")\nLoad the package and other complementary packages:
\n\nlibrary(geobounds)\nlibrary(sf)\nlibrary(ggplot2)\nlibrary(dplyr)\nAdministrative level 0 (ADM0) corresponds to countries:
\n\n# Panama\n\ngb_get_adm0(country = \"Panama\") |>\n ggplot() +\n geom_sf(fill = \"#072357\") +\n labs(caption = \"Source: www.geoboundaries.org\")\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/202602-adm0-1.webp\")
You can also retrieve multiple administrative levels at once. For example:
\n\n# Simplified files\ngb_get(country = \"Panama\", adm_lvl = \"all\", simplified = TRUE) |>\n ggplot() +\n geom_sf(aes(fill = shapeType), color = \"grey50\", linewidth = 0.1) +\n facet_wrap(vars(shapeType)) +\n scale_fill_viridis_d() +\n labs(\n title = \"Administrative levels of Panama\",\n fill = \"level\",\n caption = \"Source: www.geoboundaries.org\"\n )\n![\"Four](\"https://dieghernan.github.io/assets/img/blog/202602-all-levs-1.webp\")
When you download individual country files, each country reflects its own view\nof borders. This results in:
\n\nFor clean global visualizations, geoBoundaries provides a Composite Global\nAdministrative Zones (CGAZ) dataset that can be accessed with gb_get_world().
Here’s an example with country-level files:
\n\n# Using individual (gb_get_adm) shapefiles\ngb_get_adm0(country = c(\"India\", \"Pakistan\")) |>\n # Disputed area: Kashmir\n ggplot() +\n geom_sf(aes(fill = shapeName), alpha = 0.5) +\n scale_fill_manual(values = c(\"#FF671F\", \"#00401A\")) +\n labs(\n fill = \"Country\",\n title = \"Map of India & Pakistan\",\n subtitle = \"Note the overlap in the Kashmir region\",\n caption = \"Source: www.geoboundaries.org\"\n )\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/202602-overlaps-1.webp\")
And here’s the same comparison using CGAZ with gb_get_world():
gb_get_world(c(\"India\", \"Pakistan\")) |>\n ggplot() +\n geom_sf(aes(fill = shapeName), alpha = 0.5) +\n scale_fill_manual(values = c(\"#FF671F\", \"#00401A\")) +\n labs(\n fill = \"Country\",\n title = \"Map of India & Pakistan\",\n subtitle = \"CGAZ does not overlap\",\n caption = \"Source: www.geoboundaries.org\"\n )\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/202602-cgaz-1.webp\")
The geoBoundaries database undergoes rigorous quality assurance, including\nmanual review and hand-digitization of physical maps. This ensures the highest\nlevel of spatial accuracy for scientific and academic research.
\n\nThis precision comes at a cost: some files can be large and take longer to\ndownload. For visualization and general mapping, we recommend using simplified\ndatasets by setting simplified = TRUE.
# Different resolutions\nnorway <- gb_get_adm0(\"NOR\") |>\n mutate(res = \"Full resolution\")\nprint(object.size(norway), units = \"Mb\")\n#> 26.5 Mb\n\nnorway_simp <- gb_get_adm0(country = \"NOR\", simplified = TRUE) |>\n mutate(res = \"Simplified\")\nprint(object.size(norway_simp), units = \"Mb\")\n#> 1.5 Mb\n\nnorway_all <- bind_rows(norway, norway_simp)\n\n# Plot with ggplot2\nggplot(norway_all) +\n geom_sf(fill = \"#BA0C2F\", color = \"#00205B\") +\n facet_wrap(vars(res)) +\n theme_minimal() +\n labs(caption = \"Source: www.geoboundaries.org\")\n![\"Two](\"https://dieghernan.github.io/assets/img/blog/202602-simpl-1.webp\")
Downloaded files are cached locally. That means:
\n\nYou can set the cache directory with:
\n\ngb_set_cache_dir(\"a/path/to/a/folder\")\nUse geobounds when:
\n\ngeobounds is not alone in this space. Depending on your needs, you might\nalso want to look at:
\n\nA very popular package to access Natural Earth datasets directly from R. It’s\nlightweight and great for quick global maps, especially at small scales.
\n\nIf you need physical layers (rivers, coastlines, elevation) alongside political\nboundaries, this is often a good choice.
\n\nIf your focus is Europe, giscoR provides direct access to Eurostat GISCO\ndata. It’s particularly useful for NUTS regions and European statistical\nboundaries.
\n\nWhen administrative boundaries are not enough and you need OpenStreetMap\nfeatures (roads, POIs, land use, etc.), osmdata gives you powerful querying\ncapabilities.
\n\nI built geobounds to provide direct access to geoBoundaries products. I hope\nthis package will help you in your GIS journey.
\n\nHappy mapping!
\n", "date_published": "2026-02-12T00:00:00+01:00", "image": "https://dieghernan.github.io/assets/img/blog/202602-overlaps-1.webp", "summary": "Retrieve administrative boundaries as ready-to-use sf objects in R with geobounds.", "tags": ["r_bloggers","rstats","rspatial","maps","ggplot2","sf","geobounds","r_package","dataset"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/202510_mapping-antarctica/", "url": "https://dieghernan.github.io/202510_mapping-antarctica/", "title": "Mapping Antarctica", "content_html": "Creating maps with R is usually straightforward, but representations that\ncross the International Date\nLine or that use polar\nprojections can be tricky.
\n\nDifferent spatial-data providers use different conventions: some break\ngeometries at certain longitudes (for example, cutting the Chukchi Peninsula),\nwhile others omit portions of the data. These inconsistencies can produce\nawkward artifacts near the poles.
\n\nIn this post I fix the GISCO (European\nCommission) shapefile for Antarctica\nand produce clean orthographic maps. I walk through the manual corrections and\nthen create a few example maps.
\n\n# Libraries\nlibrary(tidyverse)\nlibrary(sf)\nlibrary(giscoR)\nlibrary(ggrepel)\nlibrary(rmapshaper)\nFirst, we obtain the GISCO Antarctica polygon and transform it to an\northographic projection centered on the South Pole.
\n\nantarct <- gisco_get_countries(year = 2024, resolution = 1, country = \"ATA\") %>%\n select(NAME = NAME_ENGL) |>\n # Orthographic projection centered on the South Pole\n st_transform(crs = \"+proj=ortho +lat_0=-90 +lon_0=0\")\n\nggplot(antarct) +\n geom_sf(fill = \"lightblue\")\n![\"South](\"https://dieghernan.github.io/assets/img/blog/202510_init-1.webp\")
The shapefile contains a visible “lollipop” cut that looks unnatural in an\northographic projection. I correct it manually with these steps:
\n\nWe convert polygons to point coordinates and inspect them to find the offending\nsequence:
\n\n# Identify the largest polygon\nant_explode <- antarct |>\n st_cast(\"POLYGON\")\n\nnrow(ant_explode)\n#> [1] 778\n\n# Largest polygon\n\nant_max <- ant_explode[which.max(st_area(ant_explode)), ]\n\ncoords <- st_coordinates(ant_max) |>\n as_tibble() |>\n # Add an ID for the points\n mutate(np = row_number())\n\n\nggplot(coords, aes(X, Y)) +\n geom_point(size = 0.05, color = \"darkblue\") +\n geom_text(aes(label = np), check_overlap = TRUE) +\n coord_equal()\n![\"Coordinate](\"https://dieghernan.github.io/assets/img/blog/202510_init_ant-1.webp\")
From the plotted indices, we can see the problematic points fall roughly in the\nrange 8200–9200. We inspect that interval in detail to select the exact indices\nto remove.
\n\ntest <- coords |>\n filter(np %in% seq(8200, 9200))\n\ntest |>\n ggplot(aes(X, Y)) +\n geom_point(size = 0.05, color = \"darkblue\") +\n geom_text(aes(label = np), check_overlap = TRUE)\n![\"Close-up](\"https://dieghernan.github.io/assets/img/blog/202510_test_points-1.webp\")
# Final solution after some iterations...\n\ntest |>\n filter(np %in% seq(8289, 9130)) |>\n ggplot(aes(X, Y)) +\n geom_point(color = \"darkblue\") +\n labs(title = \"To remove\")\n\n\ntest |>\n filter(!np %in% seq(8289, 9130)) |>\n ggplot(aes(X, Y)) +\n geom_point(color = \"darkblue\") +\n labs(title = \"To keep\")\n![\"Coordinate](\"https://dieghernan.github.io/assets/img/blog/202510_final_sol-1.webp\")
![\"Coordinate](\"https://dieghernan.github.io/assets/img/blog/202510_final_sol-2.webp\")
\n\nAfter removing the offending points, we rebuild the polygon and reconstitute the\nfull Antarctica shape from the corrected piece plus the remaining polygons.\n\n# From coordinates to polygon\nnewpol <- coords |>\n as.data.frame() |>\n filter(!np %in% seq(8289, 9130)) |> # Removing offending points\n select(X, Y) |>\n as.matrix() |>\n list() |>\n st_polygon() |>\n st_sfc() |>\n st_set_crs(st_crs(ant_max))\n\nant_max_fixed <- st_sf(st_drop_geometry(ant_max), geometry = newpol)\n\n# Regenerate initial shape\nantarctica_fixed <- bind_rows(\n ant_max_fixed,\n ant_explode[-which.max(st_area(ant_explode)), ]\n) |>\n group_by(NAME) |>\n summarise(m = 1) |>\n select(-m) |>\n st_make_valid()\n\nantarctica_fixed\n#> Simple feature collection with 1 feature and 1 field\n#> Geometry type: MULTIPOLYGON\n#> Dimension: XY\n#> Bounding box: xmin: -2583099 ymin: -2458296 xmax: 2690846 ymax: 2233395\n#> Projected CRS: +proj=ortho +lat_0=-90 +lon_0=0\n#> # A tibble: 1 × 2\n#> NAME geometry\n#> * <chr> <MULTIPOLYGON [m]>\n#> 1 Antarctica (((-2456385 1179033, -2456141 1178965, -2456464 1178341, -2456563 117…\n\nggplot(antarctica_fixed) +\n geom_sf(fill = \"lightblue\")\n![\"South](\"https://dieghernan.github.io/assets/img/blog/202510_good_pol-1.webp\")
With the corrected shape we can produce maps. Below are a few examples based on\nproposed Antarctic flag designs.
\n\nA simple rendition of Bartram’s original concept:
\n\nbbox <- st_bbox(antarctica_fixed) # For limits on the panel\n\nantarctica_fixed |>\n ggplot() +\n geom_sf(fill = \"white\", color = NA) +\n theme(\n panel.background = element_rect(fill = \"#009fdc\"),\n panel.grid = element_blank(),\n axis.text = element_blank(),\n axis.ticks = element_blank()\n ) +\n labs(title = \"Graham Bartram's proposal\") +\n coord_sf(\n xlim = c(bbox[c(1, 3)]) * 1.8,\n ylim = c(bbox[c(2, 4)]) * 1.4\n )\n![\"Antarctic](\"https://dieghernan.github.io/assets/img/blog/202510_bartram-1.webp\")
This example uses graticules to create a concentric “bullseye” pattern around\nAntarctica. Generating such graticules and merging meridians requires a few\nextra steps to avoid small gaps near the pole.
\n\n# Need graticules\ngrats <- giscoR::gisco_get_countries() |>\n st_transform(st_crs(antarctica_fixed)) |>\n # Specify the cuts of the graticules\n st_graticule(\n lat = c(-80, -70, -60),\n lon = seq(-180, 180, 30),\n ndiscr = 10000,\n margin = 0.000001\n )\n\n\nggplot(grats) +\n geom_sf(color = \"darkblue\")\n![\"Polar](\"https://dieghernan.github.io/assets/img/blog/202510_treaty1-1.webp\")
We merge meridians so the area around the South Pole is filled. st_graticule()\ncan leave a tiny hole at the pole, and we fix this by joining complementary\nmeridians.
# Merge meridians\nmerid <- lapply(seq(-180, 0, 30), function(x) {\n df <- grats |>\n filter(type == \"E\") |>\n filter(degree %in% c(x, x + 180))\n\n df2 <- df |>\n st_geometry() |>\n st_cast(\"MULTIPOINT\") |>\n st_union() |>\n st_cast(\"LINESTRING\")\n\n sf_x <- st_sf(\n degree = x,\n type = \"E\",\n geometry = df2\n )\n}) |> bind_rows()\n\n\ngrats_end <- merid |>\n bind_rows(grats |>\n filter(type != \"E\"))\nWe then cut and color the resulting graticules so they form the emblem-like\npattern.
\n\n# Cut since some grats should be colored differently\n\nantarctica_simp <- rmapshaper::ms_simplify(antarctica_fixed, keep = 0.005)\ngrats_yes <- st_intersection(grats_end, antarctica_simp)\ngrats_no <- st_difference(grats_end, antarctica_simp)\n\nantarctica_simp |>\n ggplot() +\n geom_sf(fill = \"white\", color = NA) +\n theme(\n panel.background = element_rect(fill = \"#072b5f\"),\n panel.grid = element_blank(),\n axis.text = element_blank(),\n axis.ticks = element_blank()\n ) +\n geom_sf(data = grats_yes, color = \"#072b5f\", linewidth = 1) +\n geom_sf(data = grats_no, color = \"white\", linewidth = 1) +\n coord_sf(\n xlim = c(bbox[c(1, 3)]) * 1.8,\n ylim = c(bbox[c(2, 4)]) * 1.4\n ) +\n labs(title = \"Emblem of the Antarctic Treaty\")\n![\"Antarctic](\"https://dieghernan.github.io/assets/img/blog/202510_treaty2-1.webp\")
In 2024, Graham Bartram revealed a new version of his original flag as part of\na global campaign to raise awareness about the growing problem of microplastic\npollution. The new design keeps the familiar white outline of Antarctica but\nswaps the plain blue background for one filled with countless tiny, colorful\ndots. These dots represent the microscopic bits of plastic that have been\ndiscovered even in the planet’s most untouched places, including the Antarctic\nice and its surrounding oceans.
\n\n![\"Antarctic](\"https://upload.wikimedia.org/wikipedia/commons/thumb/4/48/Antarctica_Flag_Redesigned_by_Graham_Bartram.png/960px-Antarctica_Flag_Redesigned_by_Graham_Bartram.png\")
Because the design relies on randomness, we approximate it using the following\nprocedure:
\n\n# Maximum chunk of Antarctica, the one that we fixed\n\nant_max_fixed\n#> Simple feature collection with 1 feature and 1 field\n#> Geometry type: POLYGON\n#> Dimension: XY\n#> Bounding box: xmin: -2447764 ymin: -2125910 xmax: 2690846 ymax: 2233395\n#> Projected CRS: +proj=ortho +lat_0=-90 +lon_0=0\n#> NAME geometry\n#> 1 Antarctica POLYGON ((-2423737 1557908,...\n\nset.seed(2024)\n# Sample, Voronoi and negative buffer\nplastics <- st_sample(ant_max_fixed, 3000) |>\n st_union() |>\n st_voronoi(envelope = st_geometry(ant_max_fixed)) |>\n st_collection_extract() |>\n st_buffer(dist = -10000)\n\n\n# Keep only those properly included in the outline\n\ntoinc <- st_contains_properly(ant_max_fixed, plastics, sparse = FALSE) |>\n as.vector()\n\n# Select random chunks\nplastic_end <- plastics[toinc, ] |>\n st_as_sf() |>\n slice_sample(prop = 0.75)\n\nggplot(plastic_end) +\n geom_sf(fill = \"darkblue\")\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/202510_redesign-1.webp\")
\n\n# Random coloring\n\nplastic_end$area <- st_area(plastic_end) |> as.double()\n\nplastic_end$fill <- sample(c(\"#ff00ec\", \"#9e00ec\"), nrow(plastic_end), replace = TRUE)\nplastic_end$fill <- ifelse(plastic_end$area > quantile(plastic_end$area, probs = 0.4),\n \"white\",\n plastic_end$fill\n)\n\nbbox2 <- st_bbox(plastic_end)\nggplot() +\n geom_sf(data = plastic_end, aes(fill = fill), color = NA) +\n scale_fill_identity() +\n theme(\n panel.background = element_rect(fill = \"#009fdc\"),\n panel.grid = element_blank(),\n axis.text = element_blank(),\n axis.ticks = element_blank()\n ) +\n labs(title = \"New redesign\") +\n coord_sf(\n xlim = c(bbox2[c(1, 3)] * 1.8),\n ylim = c(bbox2[c(2, 4)]) * 1.4\n )\n![\"Antarctic](\"https://dieghernan.github.io/assets/img/blog/202510_redesign-2.webp\")
Liquid is a template language used by\nJekyll, the static site generator behind this website\nand my theme, Chulapa\n(link).
\n\nSome time ago, @cargocultprogramming\nreported a broken theme component in\ndieghernan/chulapa#29.\nThe problem appeared with Jekyll 4.1.0 and was also reported in\njekyll/jekyll#8214.
\n\nThe affected code used group_by to count repeated strings in an array:
\n{% assign alldocs = site.exercises %}\n{% assign grouptag = alldocs | map: 'tags' | join: ',' | split: ',' | group_by: tag %}\n{{ grouptag }}\n\nIn that example, tag is an undefined variable, rather than the name of a\nproperty on each item. Jekyll 4.0.1 produced separate groups for the strings,\nbut 4.1.0 placed them in a single group with an empty name. This specific\nusage changed. Grouping objects by a named property remains supported.
The workaround below counts string occurrences without custom plugins.\nIt uses Liquid templates with Jekyll-specific filters, including where_exp\nand push, so it is not portable to every Liquid environment.\nwhere_exp requires Jekyll 3.2.0 or later.\nThe live examples run with the version used to build this site.
The algorithm is implemented in Chulapa.\nThe expandable tables use this site’s documents and change as posts are\nadded. You can also see the tags on the /tags\npage.
\n\nFor a small example, an input array of ['ruby', 'jekyll', 'ruby'] gives\nthese two parallel arrays:
single_tags = ['ruby', 'jekyll']\ncount_tags = [2, 1]\nThere are two distinct tags. Each position in count_tags holds the number\nof occurrences of the tag at the same position in single_tags.
First, collect the tags from site.documents. Then keep the unique tags\nand count how often each appears in the full array:
\n{% assign alldocs = site.documents %}\n{% assign alltags = alldocs | map: 'tags' | join: ',' | split: ',' %}\n{% assign single_tags = alltags | uniq %}\n{% assign count_tags = '' | split: ',' %}\n\n{% for tag in single_tags %}\n {% assign count_this_tag = alltags | where_exp: \"item\", \"item == tag\" | size %}\n {% assign count_tags = count_tags | push: count_this_tag %}\n{% endfor %}\n\nThe join and split filters flatten the tag arrays using a comma as a\nseparator. This assumes that tag names contain no commas. The algorithm\ncounts occurrences, so a repeated tag within one document would be counted\nmore than once. Tag comparisons are case-sensitive.
To display the counts, iterate over the unique tags and use\nforloop.index0 to retrieve the corresponding count. An empty input\nproduces no table rows.
\n<table>\n <caption>Tag counts on this site</caption>\n <thead>\n <tr>\n <th scope=\"col\">Tag</th>\n <th scope=\"col\">Count</th>\n </tr>\n </thead>\n <tbody>\n {% for tag in single_tags %}\n <tr>\n <td>{{ tag | escape }}</td>\n <td>{{ count_tags[forloop.index0] }}</td>\n </tr>\n {% endfor %}\n </tbody>\n</table>\n\n| Tag | \nCount | \n
|---|---|
| r_bloggers | \n24 | \n
| rstats | \n33 | \n
| rspatial | \n29 | \n
| sf | \n17 | \n
| maps | \n31 | \n
| rnaturalearth | \n3 | \n
| music | \n13 | \n
| function | \n4 | \n
| leaflet | \n6 | \n
| jekyll | \n4 | \n
| html | \n4 | \n
| beautiful_maps | \n9 | \n
| giscoR | \n13 | \n
| raster | \n1 | \n
| flags | \n4 | \n
| mapSpain | \n4 | \n
| inset | \n3 | \n
| r_package | \n6 | \n
| classInt | \n1 | \n
| terra | \n6 | \n
| rasterpic | \n1 | \n
| ggplot2 | \n12 | \n
| tmap | \n2 | \n
| mapsf | \n1 | \n
| discontinued | \n8 | \n
| project | \n13 | \n
| python | \n2 | \n
| guest-author | \n1 | \n
| COVID19 | \n3 | \n
| ggridges | \n1 | \n
| tidyterra | \n4 | \n
| maptiles | \n1 | \n
| hillshading | \n2 | \n
| s2 | \n1 | \n
| astronomy | \n2 | \n
| celestial | \n2 | \n
| geojson | \n3 | \n
| gpkg | \n3 | \n
| resmush | \n1 | \n
| liquid | \n1 | \n
| chulapa | \n3 | \n
| geobounds | \n1 | \n
| dataset | \n6 | \n
| indieweb | \n1 | \n
| pebble | \n4 | \n
| watchface | \n4 | \n
| javascript | \n5 | \n
| C | \n4 | \n
| csv | \n3 | \n
| 1 | \n
To sort by descending frequency, find the largest count and work down to\none. For each frequency, append the matching tags and their counts to two\nnew arrays. This approach is also used in\nMinimal Mistakes.
\n\n\n{% assign sorted_tags = '' | split: ',' %}\n{% assign sorted_count_tags = '' | split: ',' %}\n\n{% if single_tags.size > 0 %}\n {% assign n_tags = single_tags | size | minus: 1 %}\n {% assign items_max = count_tags | sort | last %}\n {% for i in (1..items_max) reversed %}\n {% for j in (0..n_tags) %}\n {% if count_tags[j] == i %}\n {% assign sorted_tags = sorted_tags | push: single_tags[j] %}\n {% assign sorted_count_tags = sorted_count_tags | push: i %}\n {% endif %}\n {% endfor %}\n {% endfor %}\n{% endif %}\n\nTags with equal counts retain their order of first appearance in alltags.\nThe empty-input check avoids constructing index ranges or finding a maximum\nwhen there are no tags. Each unique tag is appended once, so a final uniq\nfilter is unnecessary.
\n<table>\n <caption>Tag counts in descending order</caption>\n <thead>\n <tr>\n <th scope=\"col\">Tag</th>\n <th scope=\"col\">Count</th>\n </tr>\n </thead>\n <tbody>\n {% for tag in sorted_tags %}\n <tr>\n <td>{{ tag | escape }}</td>\n <td>{{ sorted_count_tags[forloop.index0] }}</td>\n </tr>\n {% endfor %}\n </tbody>\n</table>\n\n| Tag | \nCount | \n
|---|---|
| rstats | \n33 | \n
| maps | \n31 | \n
| rspatial | \n29 | \n
| r_bloggers | \n24 | \n
| sf | \n17 | \n
| music | \n13 | \n
| giscoR | \n13 | \n
| project | \n13 | \n
| ggplot2 | \n12 | \n
| beautiful_maps | \n9 | \n
| discontinued | \n8 | \n
| leaflet | \n6 | \n
| r_package | \n6 | \n
| terra | \n6 | \n
| dataset | \n6 | \n
| javascript | \n5 | \n
| function | \n4 | \n
| jekyll | \n4 | \n
| html | \n4 | \n
| flags | \n4 | \n
| mapSpain | \n4 | \n
| tidyterra | \n4 | \n
| pebble | \n4 | \n
| watchface | \n4 | \n
| C | \n4 | \n
| rnaturalearth | \n3 | \n
| inset | \n3 | \n
| COVID19 | \n3 | \n
| geojson | \n3 | \n
| gpkg | \n3 | \n
| chulapa | \n3 | \n
| csv | \n3 | \n
| tmap | \n2 | \n
| python | \n2 | \n
| hillshading | \n2 | \n
| astronomy | \n2 | \n
| celestial | \n2 | \n
| raster | \n1 | \n
| classInt | \n1 | \n
| rasterpic | \n1 | \n
| mapsf | \n1 | \n
| guest-author | \n1 | \n
| ggridges | \n1 | \n
| maptiles | \n1 | \n
| s2 | \n1 | \n
| resmush | \n1 | \n
| liquid | \n1 | \n
| geobounds | \n1 | \n
| indieweb | \n1 | \n
| 1 | \n
The counting step scans all tag occurrences for each unique tag, requiring\nroughly O(U * N) comparisons, where U is the number of unique tags and\nN is the total number of occurrences. The nested sorting loops perform\nO(U * M) comparisons, where M is the largest count. Array copying by\npush adds overhead. This is practical for small blogs, but large sites\nmay benefit from computing tag counts outside the template.
Here is the combined counting and sorting code. The resulting\nsorted_tags and sorted_count_tags arrays can be displayed with the table\nabove.
\n{% assign alldocs = site.documents %}\n{% assign alltags = alldocs | map: 'tags' | join: ',' | split: ',' %}\n{% assign single_tags = alltags | uniq %}\n{% assign count_tags = '' | split: ',' %}\n\n{% for tag in single_tags %}\n {% assign count_this_tag = alltags | where_exp: \"item\", \"item == tag\" | size %}\n {% assign count_tags = count_tags | push: count_this_tag %}\n{% endfor %}\n\n{% assign sorted_tags = '' | split: ',' %}\n{% assign sorted_count_tags = '' | split: ',' %}\n\n{% if single_tags.size > 0 %}\n {% assign n_tags = single_tags | size | minus: 1 %}\n {% assign items_max = count_tags | sort | last %}\n {% for i in (1..items_max) reversed %}\n {% for j in (0..n_tags) %}\n {% if count_tags[j] == i %}\n {% assign sorted_tags = sorted_tags | push: single_tags[j] %}\n {% assign sorted_count_tags = sorted_count_tags | push: i %}\n {% endif %}\n {% endfor %}\n {% endfor %}\n{% endif %}\n\nDo you know the Bonne\nProjection? This is a very\nspecial one, as it produces this result when used to map the whole world. Happy\nValentine’s Day!
\n\nlibrary(sf)\nlibrary(dplyr)\nlibrary(giscoR)\nlibrary(ggplot2)\nlibrary(showtext)\n\n\nworld <- gisco_get_countries()\n\n# Shaped ocean\n\nh_earth <- world %>%\n # Fine grid\n st_make_grid(n = c(50, 50)) %>%\n # Bonne projection\n st_transform(\"ESRI:54024\") %>%\n # To sf object (data-frame like)\n st_sf(couple = 2, someval = 1, .)\n\n\n# And finally\n\nfont_add_google(name = \"Emilys Candy\", family = \"emilys\")\n\nshowtext_auto()\n\nggplot() +\n geom_sf(data = h_earth, fill = \"#f9b7bb\", color = \"#f9b7bb\") +\n geom_sf(data = world, fill = \"#d24658\", color = \"#d24658\") +\n theme_void() +\n labs(\n title = \"Happy Valentine's Day\",\n caption = \"Bonne Projection (ESRI:54024)\"\n ) +\n theme(\n plot.background = element_rect(\n fill = \"#faddcf\",\n color = \"transparent\"\n ),\n text = element_text(family = \"emilys\", colour = \"#d24658\"),\n plot.title = element_text(hjust = 0.5, size = rel(3)),\n plot.caption = element_text(hjust = 0.5, size = rel(2))\n )\n![\"World](\"https://dieghernan.github.io/assets/img/blog/202402_bonne_proj.webp\")
The resmush package has recently been accepted on\nCRAN! This small utility package\nallows for the optimization (i.e., compression) of local and online images\nusing reSmush.it.
\n\nYou can install resmush from\nCRAN with:
\n\ninstall.packages(\"resmush\")\nThis post was featured in episode 152 of R Weekly Highlights.
\n\n\n\nreSmush.it is a free online API that provides image optimization and has\nbeen implemented in WordPress, Drupal and Magento. Some features of reSmush.it\ninclude:
\n\nOne of the main reasons I developed resmush is because I usually\ninclude precomputed\nvignettes\nwith my packages (see tidyterra\nas an example). I found that the plots created on CRAN with the standard\nconfiguration (i.e., not precomputed vignettes but built on CRAN itself) were\nnot very satisfying. In some of the packages I developed, especially those\nrelated to mapping, they didn’t do justice to the actual results when a user\nruns them.
\n\nPrecomputing vignettes has the drawback of producing higher-quality images at\nthe expense of size. To avoid exceeding CRAN’s 5 MB maximum size\npolicy, I developed\nresmush, which enables me to reduce the size of the images without a\nsignificant loss in quality.
\n\nAnother use case for resmush is optimizing images in the context of web page\ndevelopment and SEO optimization. For example, I optimized all the images on\nthis blog using resmush_dir(), which is a shorthand for optimizing all files\nin a specific folder.
There are other alternatives that I discuss at the end of this\npost, but briefly, the reSmush.it API works quickly\nwith minimal configuration for a wide range of formats without needing an API\nkey.
\n\nLet’s present an example of how a local file can be optimized. First, we create\na large plot with ggplot2.
\n\nlibrary(tidyterra)\nlibrary(ggplot2)\nlibrary(terra)\nlibrary(maptiles)\n\ncyl <- vect(system.file(\"extdata/cyl.gpkg\", package = \"tidyterra\")) %>%\n project(\"EPSG:3857\")\ncyl_img <- get_tiles(cyl, \"Esri.WorldImagery\", zoom = 8, crop = TRUE)\ncyl_gg <- autoplot(cyl_img, maxcell = Inf) +\n geom_spatvector(data = cyl, alpha = 0.3)\n\ncyl_gg\n![\"Satellite](\"https://dieghernan.github.io/assets/img/samples/cyl.png\")
\n\nOriginal satellite image before optimization.\n
\n\n\n# And we save it for resmushing\nggsave(\"cyl.png\", width = 5, height = 0.7 * 5)\nThe file has a size of 1.7 MB. We can use resmush_file() to\nreduce it:
library(resmush)\nresmush_file(\"cyl.png\")\n#> ══ resmush summary ══════════════════════════════════════════\n#> ℹ Input: 1 file with size 1.7 Mb\n#> ✔ Success for 1 file: Size now is 762.2 Kb (was 1.7 Mb). Saved 948.9 Kb (55.46%).\n#> See result in directory '.'.\n\n# Check\npng::readPNG(\"cyl_resmush.png\") %>%\n grid::grid.raster()\n![\"Satellite](\"https://dieghernan.github.io/assets/img/samples/cyl_resmush.png\")
\n\nSatellite image after optimization with resmush_file().\n
\n\nBy default, resmush_file() and resmush_dir() do not overwrite the original\nfile, although this behavior may be modified with the overwrite = TRUE\nparameter. Now, the optimized file (\"cyl_resmush.png\") has a size of 762.2 kB.
Let’s compare the results side-by-side:
\n\n\n\n\n\n\n\nThe original image (left/top) is 1.7 MB. The optimized image (right/bottom) is\n762.2 kB, a 55.46% reduction in file size. Click either image to enlarge.\n
\nWe can verify that the image has been compressed without reducing its\ndimensions.
\n\nsize_src <- file.size(\"cyl.png\") %>%\n `class<-`(\"object_size\") %>%\n format(units = \"auto\")\nsize_dest <- file.size(\"cyl_resmush.png\") %>%\n `class<-`(\"object_size\") %>%\n format(units = \"auto\")\n\ndim_src <- dim(png::readPNG(\"cyl.png\"))[1:2] %>% paste0(collapse = \"x\")\ndim_dest <- dim(png::readPNG(\"cyl_resmush.png\"))[1:2] %>% paste0(collapse = \"x\")\n\ndata.frame(\n source = c(\"original file\", \"compressed file\"),\n size = c(size_src, size_dest),\n dimensions = c(dim_src, dim_dest)\n) %>%\n knitr::kable()\n| source | \nsize | \ndimensions | \n
|---|---|---|
| original file | \n1.7 Mb | \n1050x1500 | \n
| compressed file | \n762.2 Kb | \n1050x1500 | \n
We can also optimize online files with resmush_url() and download them to\ndisk. In this example, I demonstrate a feature of all the functions in\nresmush: they return an invisible data frame with a summary of the process.
url <- \"https://dieghernan.github.io/assets/img/samples/sample_1.3mb.jpg\"\n\n# Invisible data frame\ndm <- resmush_url(url, \"sample_optimized.jpg\", report = FALSE)\nknitr::kable(dm)\n| src_img | \ndest_img | \nsrc_size | \ndest_size | \ncompress_ratio | \nnotes | \nsrc_bytes | \ndest_bytes | \n
|---|---|---|---|---|---|---|---|
| https://dieghernan.github.io/assets/img/samples/sample_1.3mb.jpg | \nsample_optimized.jpg | \n1.3 Mb | \n985 Kb | \n26.63% | \nOK | \n1374693 | \n1008593 | \n
![\"Colorful](\"https://dieghernan.github.io/assets/img/samples/sample_1.3mb.jpg\")
\n\n\n\n![\"Colorful](\"https://dieghernan.github.io/assets/img/samples/sample_optimized.jpg\")
\n\n\n\nThe original image (left/top) is 1.3 MB. The optimized image (right/bottom) is\n985 kB, a 26.63% reduction in file size. Click either image to enlarge.\n\n
\n\nThere are other alternatives for optimizing images with R, but first…
\n\n\n Yihui Xie, one of the most prominent figures\n in the R community, was recently laid off from his position\n at Posit PBC (formerly RStudio)\n (more info here).\n
\n\n Yihui is the developer of knitr, markdown,\n blogdown and bookdown, among others, and he\n has been one of the key contributors (if not the most important) to the\n reproducible research space with R through his libraries.\n
\n\n If you have ever used and enjoyed his packages, consider sponsoring him on\n GitHub.\n
\n\nxfun::tinify() is similar to resmush_file() but uses\nTinyPNG. An API key is required.xfun::optipng() compresses local files with OptiPNG (which needs to be\ninstalled locally).xfun::optipng() with additional options. Requires additional software to\nbe installed locally.| tool | \nCRAN | \nAdditional software? | \nOnline? | \nAPI Key? | \nLimits? | \n
|---|---|---|---|---|---|
xfun::tinify() | \n Yes | \nNo | \nYes | \nYes | \n500 files/month (Free tier) | \n
xfun::optipng() | \n Yes | \nYes | \nNo | \nNo | \nNo | \n
| tinieR | \nNo | \nNo | \nYes | \nYes | \n500 files/month (Free tier) | \n
| optout | \nNo | \nYes | \nNo | \nNo | \nNo | \n
| resmush | \nYes | \nNo | \nYes | \nNo | \nMax size 5Mb | \n
| tool | \npng | \njpg | \ngif | \nbmp | \ntiff | \nwebp | \n|
|---|---|---|---|---|---|---|---|
xfun::tinify() | \n ✅ | \n✅ | \n❌ | \n❌ | \n❌ | \n✅ | \n❌ | \n
xfun::optipng() | \n ✅ | \n❌ | \n❌ | \n❌ | \n❌ | \n❌ | \n❌ | \n
| tinieR | \n✅ | \n✅ | \n❌ | \n❌ | \n❌ | \n✅ | \n❌ | \n
| optout | \n✅ | \n✅ | \n❌ | \n❌ | \n❌ | \n❌ | \n✅ | \n
| resmush | \n✅ | \n✅ | \n✅ | \n✅ | \n✅ | \n✅ | \n❌ | \n
Additionally, if you host your projects on GitHub, you can try\nImgbot, which is free for open-source projects. Imgbot\nprovides automatic optimization for files in your repositories, and the\noptimized files will be included in specific pull requests before merging into\nyour work.
\n", "date_published": "2024-02-05T00:00:00+01:00", "image": "https://dieghernan.github.io/assets/img/misc/compress-img.png", "summary": "Compress the size of your images with R, resmush and reSmush.it", "tags": ["r_bloggers","r_package","resmush","rstats"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/202312_bertin_dots/", "url": "https://dieghernan.github.io/202312_bertin_dots/", "title": "Beautiful maps with R (V): Point densities", "content_html": "Recently, the R Graph Gallery published a new post by Benjamin Nowak showing how to create a map inspired by the work of French cartographer Jacques Bertin (1918–2010), particularly his Sémiologie graphique (Bertin, 1967):
\n\n![\"Dot](\"https://dieghernan.github.io/assets/img/misc/bertin.png\")
In this post, I create a similar map for Iberia using graduated symbols to\nrepresent population density. Unlike conventional dot density maps, where dots\nrepresent a fixed number of individuals, symbol sizes here indicate density\nclasses.\nI also explore a variation using a hexagonal grid instead of a rectangular one.\nThis is the fifth issue of the series\nBeautiful Maps with R.
\n\nI will use the following libraries for loading, manipulating and plotting\nspatial data (both raster and vector):
\n\n# Base spatial packages\nlibrary(terra)\nlibrary(sf)\n# Spatial data\nlibrary(giscoR)\n# Wrangling and plotting\nlibrary(tidyverse)\nlibrary(tidyterra)\nlibrary(ggtext)\n# Additional for hex grids\n# Supporting for units and bridge raster to polygon\nlibrary(units)\nlibrary(exactextractr)\nThe first step is always to get the data we need. My final map uses a circular\nlayout with Iberia in the middle (that is our observation window), so we can get\nthe corresponding shapes and create a buffer around it.
\n\nAfter that, we extract the population spatial distribution from GHSL -\nGlobal Human Settlement Layer. We\nuse the global file with a resolution of 1 km in the Mollweide projection\n(ESRI:54009).
\n\n# Create observation window based on the Iberian Peninsula and surroundings\n# We create a buffered circle\nowin <- gisco_get_countries(\n country = c(\"ES\", \"PT\"),\n # We buffer in 3035 since I want my final map on this projection\n epsg = 3035,\n resolution = 60\n) %>%\n st_geometry() %>%\n st_union() %>%\n st_centroid(of_largest_polygon = TRUE) %>%\n st_buffer(750000) %>%\n # But for extracting raster data we need this in Mollweide so far\n st_transform(crs = \"ESRI:54009\")\n\n# Get additional shapes and cut them to the owin\nregions <- gisco_get_nuts(resolution = 3, nuts_level = 2) %>%\n st_transform(st_crs(owin)) %>%\n st_intersection(owin)\n\ncountries <- gisco_get_countries(resolution = 3) %>%\n st_transform(st_crs(owin)) %>%\n st_intersection(owin)\n\n# Base map\nbase_gg <- ggplot() +\n geom_sf(data = regions, fill = NA, color = \"black\", linewidth = 0.1) +\n geom_sf(data = countries, fill = NA, linewidth = 0.5, color = \"black\") +\n geom_sf(data = owin, fill = NA, linewidth = 0.75, color = \"black\")\n\nbase_gg\n![\"Base](\"https://dieghernan.github.io/assets/img/blog/202312_basemap-1.webp\")
That is our base map. Now we download the GHSL data programmatically and check\nthat everything is correct. At this point, it is interesting to\nuse the win argument when reading the raster with terra::rast(), as this\nallows us to load only the desired area with the subsequent improvement in\nterms of performance.
# Download data\n# We need the following file (download 305Mb)\nurl <- \"https://jeodpp.jrc.ec.europa.eu/ftp/jrc-opendata/GHSL/GHS_POP_GLOBE_R2023A/GHS_POP_E2030_GLOBE_R2023A_54009_1000/V1-0/GHS_POP_E2030_GLOBE_R2023A_54009_1000_V1_0.zip\"\n\n# This is where I store the file, you need to modify the folder\nfname <- file.path(\"~/R/mapslib/GHS\", basename(url))\nif (!file.exists(fname)) {\n download.file(url, fname)\n}\nzip_content <- unzip(fname, list = TRUE)\nzip_content\n#> Name Length Date\n#> 1 GHS_POP_E2030_GLOBE_R2023A_54009_1000_V1_0.tif 263188307 2023-04-28 21:11:00\n#> 2 GHS_POP_E2030_GLOBE_R2023A_54009_1000_V1_0.tif.ovr 88461532 2023-04-28 21:11:00\n#> 3 GHSL_Data_Package_2023.pdf 9761851 2023-10-27 14:30:00\n#> 4 GHS_POP_GLOBE_R2023A_input_metadata.xlsx 137963 2023-04-30 10:42:00\n\n# Unzip\nunzip(fname, exdir = \"~/R/mapslib/GHS\", junkpaths = TRUE, overwrite = FALSE)\n\n# Create the path to the file\nglobal_tiff <- zip_content$Name[grepl(\"tif$\", zip_content$Name)]\nglobal_tiff_path <- file.path(\"~/R/mapslib/GHS\", global_tiff)\n\n# And read cropping to our owin\npop_init <- rast(global_tiff_path, win = as_spatvector(owin))\n\n# Consistent naming of the layer\nnames(pop_init) <- \"population\"\n\nncell(pop_init)\n#> [1] 2255923\n\n# And check with tidyterra\nbase_gg +\n geom_spatraster(data = pop_init, maxcell = 50000) +\n scale_fill_viridis_c(na.value = \"transparent\", alpha = 0.3)\n![\"Population](\"https://dieghernan.github.io/assets/img/blog/202312_base_raster-1.webp\")
The GHSL information contains the estimated population in each cell. However, the\nfile has a high resolution (more than 2 million cells), so for plotting\npurposes we are going to reduce (i.e. aggregate) the number of cells so we can\nhave a better dot visualization. Once we aggregate, we compute the\narea of each new aggregated cell and compute the corresponding population\ndensity.
\n\nInstead of using the numeric range of densities, we use categories for the final\nmap, so we classify the density into different groups:
\n\n# Reduce resolution for visualization\n# Compute factor to reduce raster to (aprox) 100 rows:\nnrow(pop_init)\n#> [1] 1511\nfactor <- round(nrow(pop_init) / 100)\n\n# Each new cell contains the sum of population of the aggregated cells\npop_agg <- terra::aggregate(pop_init,\n fact = factor, fun = \"sum\",\n na.rm = TRUE\n)\n\n\n# Compute area of each new cell\npop_agg$area_km2 <- cellSize(pop_agg, unit = \"km\")\n\n# Compute densities, mask to owin, convert to points and create categories\npop_points <- pop_agg %>%\n # Compute density by cell\n mutate(dens = population / area_km2) %>%\n select(dens) %>%\n # Mask to the countries shapes\n mask(as_spatvector(countries), touches = FALSE) %>%\n # SpatVector as points\n as.points() %>%\n # Categorize\n mutate(cat = case_when(\n dens < 25 ~ \"A\",\n dens < 50 ~ \"B\",\n dens < 100 ~ \"C\",\n dens < 250 ~ \"D\",\n dens < 500 ~ \"E\",\n dens < 1500 ~ \"F\",\n TRUE ~ \"G\"\n ))\nAnd finally, the map. In this case, I save it as a high-resolution square\nmap.
\n\n# Final plot\nfinal_plot <- base_gg +\n # Layer, this object is a SpatVector instead of sf object\n geom_spatvector(\n pop_points,\n mapping = aes(size = cat),\n # Use a point with a border AND a fill\n pch = 21, color = \"white\", fill = \"black\", linewidth = 0.05\n ) +\n scale_size_manual(\n values = c(0.3, 1, 1.25, 1.5, 2, 2.5, 3.5),\n labels = c(\n \"< 25\", \"[25, 50)\", \"[50, 100)\", \"[100, 250)\",\n \"[250, 500)\", \"[500, 1500)\", \"≥ 1500\"\n ),\n guide = guide_legend(\n nrow = 1,\n title.position = \"top\",\n keywidth = 1,\n label.position = \"bottom\"\n )\n ) +\n labs(\n title = \"**Population density in Iberia**\",\n subtitle = \"in the way of Jacques Bertin\",\n size = \"<span style='color:grey'>Inhabitants per km<sup>2</sup></span>\",\n caption = \"**Data** GHSL **| Plot** @dhernangomez based on @BjnNowak\"\n ) +\n theme_void() +\n # This CRS for representation only\n coord_sf(expand = TRUE, crs = 3035) +\n theme(\n # plot.margin = margin(20,0,20,0,\"cm\"),\n plot.background = element_rect(fill = \"white\", color = NA),\n legend.position = \"bottom\",\n legend.margin = margin(r = 20, unit = \"pt\"),\n legend.title = element_markdown(),\n legend.key.width = unit(50, \"pt\"),\n plot.title = element_markdown(hjust = 0.5, size = 20),\n plot.subtitle = element_text(hjust = 0.5, color = \"grey40\"),\n plot.caption = element_markdown(\n color = \"grey20\",\n margin = margin(t = 20, b = 5, unit = \"pt\"),\n hjust = .5\n )\n )\n\n\n\nggsave(\"202312_finalmap.png\", dpi = 300, width = 8, height = 8)\n![\"Dot](\"https://dieghernan.github.io/assets/img/blog/202312_finalmap.webp\")
The previous plot is based on the centroids of each cell of the raster, which is,\nby definition, a rectangular grid. I would also like to experiment with\nhexagonal grids (i.e. a grid of hexagons) since I have the feeling that they\nlook more “natural” than the rectangular ones, which present a regularity\nhardly seen in\nthe wild.
\n\nThe issue here is that terra does not produce this type of grid. However, it\nis possible to create them with sf::st_make_grid(), so the workflow for this\nalternative is:
When working with sf::st_make_grid(square = FALSE), the parameter cellsize\nshould be the “diameter” of the hexagon instead of the area. Luckily, we can\ninfer this value since the area of a hexagon is
[A = \\frac{\\sqrt{3}}{2}d^{2}]
\n\nSo we can extract \\(d\\) from the previous expression knowing the area \\(A\\) of\nthe aggregated cells:
\n\n# Hex grid with sf ----\n\n# Avg size of the cells on the aggregated grid\ntarget_area <- cellSize(pop_agg, unit = \"km\") %>%\n pull() %>%\n mean() %>%\n as_units(\"km^2\")\n\ntarget_area\n#> 224.7461 [km^2]\n\n# Infer diam hex\ndiam_hex <- sqrt(2 * target_area / sqrt(3))\n# Create hexagonal grid\npop_agg_sf <- st_make_grid(owin, cellsize = diam_hex, square = FALSE)\n\nlength(pop_agg_sf)\n#> [1] 10340\nncell(pop_agg)\n#> [1] 10100\n\narea_km2 <- st_area(pop_agg_sf) %>%\n set_units(\"km^2\") %>%\n as.double()\n\npop_agg_sf <- st_sf(area_km2 = area_km2, geom = pop_agg_sf)\nNow, we use exact_extract() to extract the population in each hexagonal cell.
# Extract aggregated population by hex cell\npop_agg_sf$population <- exact_extract(pop_init,\n y = pop_agg_sf,\n progress = FALSE,\n fun = \"sum\"\n)\n\n\nbase_gg +\n geom_sf(\n data = pop_agg_sf %>% filter(population > 0),\n aes(fill = population), color = NA\n ) +\n scale_fill_viridis_c(na.value = \"transparent\", alpha = 0.3)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/202312_hexgrid_base-1.webp\")
Finally, we compute densities, create categories and produce the map:
\n\n# Mask and categorize\npop_sf_points <- pop_agg_sf %>%\n # Compute density by cell\n mutate(dens = population / area_km2) %>%\n select(dens) %>%\n # To points and filter to country shape\n st_centroid(of_largest_polygon = TRUE) %>%\n st_filter(countries) %>%\n # Categorize\n mutate(cat = case_when(\n dens < 25 ~ \"A\",\n dens < 50 ~ \"B\",\n dens < 100 ~ \"C\",\n dens < 250 ~ \"D\",\n dens < 500 ~ \"E\",\n dens < 1500 ~ \"F\",\n TRUE ~ \"G\"\n ))\n\n# Final plot\nfinal_plot_hex <- base_gg +\n # Layer, this object is a sf object\n geom_sf(\n pop_sf_points,\n mapping = aes(size = cat),\n # Use a point with a border AND a fill\n pch = 21, color = \"white\", fill = \"black\", linewidth = 0.05\n ) +\n scale_size_manual(\n values = c(0.3, 1, 1.25, 1.5, 2, 2.5, 3.5),\n labels = c(\n \"< 25\", \"[25, 50)\", \"[50, 100)\", \"[100, 250)\",\n \"[250, 500)\", \"[500, 1500)\", \"≥ 1500\"\n ),\n guide = guide_legend(\n nrow = 1,\n title.position = \"top\",\n keywidth = 1,\n label.position = \"bottom\"\n )\n ) +\n labs(\n title = \"**Population density in Iberia**\",\n subtitle = \"in the way of Jacques Bertin\",\n size = \"<span style='color:grey'>Inhabitants per km<sup>2</sup></span>\",\n caption = \"**Data** GHSL **| Plot** @dhernangomez based on @BjnNowak\"\n ) +\n theme_void() +\n # This CRS for representation only\n coord_sf(expand = TRUE, crs = 3035) +\n theme(\n # plot.margin = margin(20,0,20,0,\"cm\"),\n plot.background = element_rect(fill = \"white\", color = NA),\n legend.position = \"bottom\",\n legend.margin = margin(r = 20, unit = \"pt\"),\n legend.title = element_markdown(),\n legend.key.width = unit(50, \"pt\"),\n plot.title = element_markdown(hjust = 0.5, size = 20),\n plot.subtitle = element_text(hjust = 0.5, color = \"grey40\"),\n plot.caption = element_markdown(\n color = \"grey20\",\n margin = margin(t = 20, b = 5, unit = \"pt\"),\n hjust = .5\n )\n )\n\nggsave(\"202312_finalmap_hex.png\", dpi = 300, width = 8, height = 8)\n![\"Dot](\"https://dieghernan.github.io/assets/img/blog/202312_finalmap_hex.webp\")
And that’s it! Which one do you like the most? Let me know in the comments.
\n\nA couple of weeks ago I was doing my daily check on\nStack Overflow when I found a\nquestion by Benjamin Smith that blew my\nmind: Creating Star Map Visualizations Based on Location and\nDate\n!!
\n\nOh my! Can we do this with R? The answer is: Of course! In fact, Kim\nFitter already worked on this two years earlier,\nsee his Celestial\nMaps. So I decided\nto put some work into this.
\n\nSince then, I have also learned that Benjamin and I have been working in parallel\non the same topic. He is preparing an R package named\nstarBliss and hopefully this\npost will be of some help.
\n\nI have very little knowledge of this topic, so if you find errors or\nhave any suggestions, please let me know in the comments section below.
\n\nThe initial data source for all these projects (Kim’s, Benjamin’s and mine) is the\nsame, and it is provided by the D3 plugin\nd3-celestial by Olaf\nFrohn. As Kim Fitter pointed out in\nhis post, these\ndata files present the problem (experienced by almost any sf\nuser) of lines crossing\nthe international date line (longitude 180°). I also found that some files are\nnot valid as per sf::st_make_valid().
Solution? I processed and fixed almost every file, including the files\ncorresponding to the Milky Way and the lines for Chinese constellations, manually,\nto provide a set of files. That is the origin of my project Celestial\nData, which provides all these\nfiles in several spatial formats. Please check out the\nrepo to learn more about it.
\n\nThe first step is to load libraries that will help us with this cosmic\ntask:
\n\n# Spatial manipulation\nlibrary(sf)\nlibrary(s2)\nlibrary(nominatimlite)\n\n## Wrangling data and dates\nlibrary(dplyr)\nlibrary(lubridate)\nlibrary(lutz)\n\n## Visualization\nlibrary(ggplot2)\nlibrary(ggfx)\nlibrary(ggshadow)\nNow we prepare some helper functions:
\n\nload_celestial() just downloads the corresponding .geojson from the\nCelestial Data\nrepo1 to a\nspecific directory cachedir and loads it with sf::st_read().
pretty_lonlat() is a labeler that returns a decimal longitude or latitude\ncoordinate in the format degrees/minutes/seconds (e.g., a latitude of\n34.72782 would be converted into 34° 43’ 40.15” N).
load_celestial and\npretty_lonlat()load_celestial <- function(filename,\n url = \"https://cdn.jsdelivr.net/gh/dieghernan/celestial_data@main/data/\",\n cachedir = tempdir()) {\n if (!dir.exists(cachedir)) {\n stop(\n \"Please create \",\n path.expand(cachedir),\n \" directory\",\n \"first\"\n )\n }\n\n url <- file.path(url, filename)\n local_path <- file.path(cachedir, filename)\n\n\n if (!file.exists(local_path)) {\n download.file(url, local_path, mode = \"wb\", quiet = TRUE)\n }\n\n celestial <- sf::st_read(local_path, quiet = TRUE)\n\n return(celestial)\n}\n\npretty_lonlat <- function(x, type, accuracy = 2) {\n positive <- x >= 0\n\n # Decompose\n x <- abs(x)\n D <- as.integer(x)\n m <- (x - D) * 60\n M <- as.integer(m)\n S <- round((m - M) * 60, accuracy)\n\n # Get label\n if (type == \"lon\") {\n lab <- ifelse(positive > 0, \"E\", \"W\")\n } else {\n lab <- ifelse(positive > 0, \"N\", \"S\")\n }\n\n\n # Compose\n label <- paste0(D, \"\\u00b0 \", M, \"' \", S, '\\\" ', lab)\n return(label)\n}\nAdditionally, you may notice that on this d3-celestial\ndemo there is some\ndegree of rotation depending on the location and the time. I found how this is\ndone on the d3-celestial plugin and I found the function\ngetMST(dt, lng),\nwhich I ported to R (get_mst()). The function uses Meeus’s (1998) formula\nfor Greenwich mean sidereal time, adds the observer’s east-positive longitude\nand wraps the result to the interval [0°, 360°). This gives local mean sidereal\ntime in degrees. For more detail, see this\npost by\nJames Still.
The inputs are a POSIXct date-time and the observer’s longitude in degrees.\nThe example uses the returned angle to rotate the star map’s projection.
get_mst()# Derive rotation degrees of the projection given a date and a longitude\nget_mst <- function(dt, lng) {\n desired_date_utc <- lubridate::with_tz(dt, \"UTC\")\n\n\n yr <- lubridate::year(desired_date_utc)\n mo <- lubridate::month(desired_date_utc)\n dy <- lubridate::day(desired_date_utc)\n h <- lubridate::hour(desired_date_utc)\n m <- lubridate::minute(desired_date_utc)\n s <- lubridate::second(desired_date_utc)\n\n if ((mo == 1) || (mo == 2)) {\n yr <- yr - 1\n mo <- mo + 12\n }\n\n # Adjust times before Gregorian Calendar\n # See https://squarewidget.com/julian-day/\n if (lubridate::as_date(dt) > as.Date(\"1582-10-14\")) {\n a <- floor(yr / 100)\n b <- 2 - a + floor(a / 4)\n } else {\n b <- 0\n }\n c <- floor(365.25 * yr)\n d <- floor(30.6001 * (mo + 1))\n\n # days since J2000.0\n jd <- b + c + d - 730550.5 + dy + (h + m / 60 + s / 3600) / 24\n jt <- jd / 36525\n\n # Rotation\n mst <- 280.46061837 + 360.98564736629 * jd +\n 0.000387933 * jt^2 - jt^3 / 38710000.0 + lng\n\n # Modulo 360 degrees\n mst <- mst %% 360\n\n return(mst)\n}\nThe final result would have a spherical outline. That means that we would need\nto perform a spherical cut. Did you know that in r-spatial the Earth is no\nlonger flat? Thanks to s2 we can\novercome this issue. Additionally, we would get rid of artifacts derived from\nthe changes on the\nprojection.\nThis also includes some refinements to avoid empty/non-valid geometries as well\nas GEOMETRYCOLLECTION handling. The function sf_spherical_cut() would do\nthat for us.
sf_spherical_cut()# Cut a sf object with a buffer using spherical s2 geoms\n# Optionally, project and flip\n\nsf_spherical_cut <- function(x, the_buff, the_crs = sf::st_crs(x), flip = NULL) {\n # Get geometry type\n geomtype <- unique(gsub(\"MULTI\", \"\", sf::st_geometry_type(x)))[1]\n\n # Keep the data frame, s2 drops it\n the_df <- sf::st_drop_geometry(x)\n the_geom <- sf::st_geometry(x)\n # Convert to s2 if needed\n if (!inherits(the_buff, \"s2_geography\")) {\n the_buff <- sf::st_as_s2(the_buff)\n }\n\n the_cut <- the_geom %>%\n # Cut with s2\n sf::st_as_s2() %>%\n s2::s2_intersection(the_buff) %>%\n # Back to sf and add the df\n sf::st_as_sfc() %>%\n sf::st_sf(the_df, geometry = .) %>%\n dplyr::filter(!sf::st_is_empty(.)) %>%\n sf::st_transform(crs = the_crs)\n\n # If it is not POINT filter by valid and non-empty\n # This is for performance\n if (!geomtype == \"POINT\") {\n # If any is GEOMETRYCOLLECTION extract the right value\n if (any(sf::st_geometry_type(the_cut) == \"GEOMETRYCOLLECTION\")) {\n the_cut <- the_cut %>%\n sf::st_collection_extract(type = geomtype, warn = FALSE)\n }\n\n the_cut <- the_cut %>%\n dplyr::filter(!is.na(sf::st_is_valid(.)))\n }\n\n if (!is.null(flip)) {\n the_cut <- the_cut %>%\n dplyr::mutate(geometry = geometry * flip) %>%\n sf::st_set_crs(the_crs)\n }\n\n return(the_cut)\n}\nNow we are ready to start creating our visualization. We need only two inputs:
\n\nA desired location, which we will geocode with nominatimlite.
\nA specific moment in time.
\n# Inputs\ndesired_place <- \"Madrid, Spain\"\n\n# We are not using yet the timezone\ndesired_date <- make_datetime(\n year = 2015,\n month = 9,\n day = 22,\n hour = 3,\n min = 45\n)\n\n# Geocode place with nominatimlite\ndesired_place_geo <- geo_lite(desired_place, full_results = TRUE)\n\ndesired_place_geo %>%\n select(address, lat, lon)\n#> # A tibble: 1 × 3\n#> address lat lon\n#> <chr> <dbl> <dbl>\n#> 1 Madrid, Área metropolitana de Madrid y Corredor del Henares, Comunidad de Madrid, España 40.4 -3.70\n\n# And get the coordinates\ndesired_loc <- desired_place_geo %>%\n select(lat, lon) %>%\n unlist()\n\ndesired_loc\n#> lat lon\n#> 40.416705 -3.703582\nWith respect to our object desired_date, it is quite relevant for accurate\nplotting to specify the correct time zone. Since we already know the latitude and\nlongitude of our desired location, we can easily get that with the lutz\npackage:
desired_date\n#> [1] \"2015-09-22 03:45:00 UTC\"\n\n# Get tz\nget_tz <- tz_lookup_coords(desired_loc[1], desired_loc[2], warn = FALSE)\n\nget_tz\n#> [1] \"Europe/Madrid\"\n\n# Force it to be local time\ndesired_date_tz <- force_tz(desired_date, get_tz)\n\ndesired_date_tz\n#> [1] \"2015-09-22 03:45:00 CEST\"\nSome online shops that create this kind of map (I won’t post links) include\nthis script:
\n\n...\n\n'selectedHour': '22',\n'selectedMinute': '00',\n\n...\nThis means that those shops are really creating the map at\nYYYY-MM-DD 22:00:00 UTC. If you want to replicate that exactly (even though\nthe resulting night sky is not accurate—for example, in New Zealand the local\ntime at that moment would be 10:00, so no stars would be visible), you would\nneed to adjust desired_date_tz as follows:
as_datetime(paste(as.Date(desired_date_tz), \"22:00:00\"), tz = \"UTC\")\n#> [1] \"2015-09-22 22:00:00 UTC\"\n\n# That would really correspond to 10:00\nas_datetime(paste(as.Date(desired_date_tz), \"22:00:00\"), tz = \"UTC\") %>%\n with_tz(\"Pacific/Auckland\")\n#> [1] \"2015-09-23 10:00:00 NZST\"\nNow we can start creating our buffers and projections, which will help us to\ncrop the celestial data objects.
\n\nI also noticed that the location\ndemo of\nd3-celestial.js uses Airy\nprojection,\nso we are going to replicate that as well:
\n\n# Get the rotation and prepare buffer and projection\n\n# Get right degrees\nlon_prj <- get_mst(desired_date_tz, desired_loc[2])\nlat_prj <- desired_loc[1]\n\nc(lon_prj, lat_prj)\n#> lon lat\n#> 23.15892 40.41670\n\n# Create proj4string w/ Airy projection\n\ntarget_crs <- paste0(\"+proj=airy +x_0=0 +y_0=0 +lon_0=\", lon_prj, \" +lat_0=\", lat_prj)\n\n\ntarget_crs\n#> [1] \"+proj=airy +x_0=0 +y_0=0 +lon_0=23.1589164999314 +lat_0=40.4167047\"\n\n# Flip celestial objects to give the impression of viewing the sky from Earth,\n# rather than viewing the Earth from the sky.\n# https://stackoverflow.com/a/75064359/7877917\n# Flip matrix for affine transformation\n\nflip_matrix <- matrix(c(-1, 0, 0, 1), 2, 2)\n\n\n# And create an s2 buffer of the visible hemisphere at the given location\nhemisphere_s2 <- s2_buffer_cells(\n as_s2_geography(\n paste0(\"POINT(\", lon_prj, \" \", lat_prj, \")\")\n ),\n 9800000,\n max_cells = 5000\n)\n\n# This one is for plotting\nhemisphere_sf <- hemisphere_s2 %>%\n st_as_sf() %>%\n st_transform(crs = target_crs) %>%\n st_make_valid()\nNow, we can load the data of our choice. In this case, I have chosen to\nrepresent the Milky Way, constellation lines and stars.
\n\nWe also add some additional variables that would help us to improve the\nvisualization.
\n\nmw <- load_celestial(\"mw.min.geojson\")\n\n# Add colors to MW to use on fill\ncols <- colorRampPalette(c(\"white\", \"yellow\"))(5)\nmw$fill <- factor(cols, levels = cols)\n\nggplot(mw) +\n geom_sf(aes(fill = fill)) +\n scale_fill_identity()\n![\"Full-sky](\"https://dieghernan.github.io/assets/img/blog/20230125_mw-1.webp\")
\n# And process it\n\n# Cut to buffer\nmw_end <- sf_spherical_cut(mw,\n the_buff = hemisphere_s2,\n # Change the crs\n the_crs = target_crs,\n flip = flip_matrix\n)\n\n\nggplot(mw_end) +\n geom_sf(aes(fill = fill)) +\n scale_fill_identity()\n![\"Milky](\"https://dieghernan.github.io/assets/img/blog/20230125_mw-2.webp\")
Now it is the turn of the constellations:
\n\nconst <- load_celestial(\"constellations.lines.min.geojson\")\n\nggplot(const) +\n geom_sf() +\n coord_sf(expand = FALSE)\n![\"Full-sky](\"https://dieghernan.github.io/assets/img/blog/20230125_const-1.webp\")
\n# Cut to buffer\n\nconst_end <- sf_spherical_cut(const,\n the_buff = hemisphere_s2,\n # Change the crs\n the_crs = target_crs,\n flip = flip_matrix\n)\n\n\nggplot(const_end) +\n geom_sf() +\n coord_sf(expand = FALSE)\n![\"Constellation](\"https://dieghernan.github.io/assets/img/blog/20230125_const-2.webp\")
And finally the stars:
\n\nstars <- load_celestial(\"stars.6.min.geojson\")\n\nggplot(stars) +\n # We use relative brightness (br) as aes\n geom_sf(aes(size = br, alpha = br), shape = 16) +\n scale_size_continuous(range = c(0.5, 6)) +\n scale_alpha_continuous(range = c(0.1, 0.8)) +\n coord_sf(expand = FALSE)\n![\"Full-sky](\"https://dieghernan.github.io/assets/img/blog/20230125_stars-1.webp\")
\n# Cut to buffer\n\nstars_end <- sf_spherical_cut(stars,\n the_buff = hemisphere_s2,\n # Change the crs\n the_crs = target_crs,\n flip = flip_matrix\n)\n\nggplot(stars_end) +\n # We use relative brightness (br) as aes\n geom_sf(aes(size = br, alpha = br), shape = 16) +\n scale_size_continuous(range = c(0.5, 6)) +\n scale_alpha_continuous(range = c(0.1, 0.8))\n![\"Star](\"https://dieghernan.github.io/assets/img/blog/20230125_stars-2.webp\")
We are also going to include graticules, so the Earth’s poles can be quickly\nspotted. In this case we don’t apply any affine transformation, so the flip\nparameter of sf_spherical_cut() needs to be set as NULL.
grat <- st_graticule(\n ndiscr = 5000,\n lat = seq(-90, 90, 10),\n lon = seq(-180, 180, 30)\n)\n\nggplot(grat) +\n geom_sf() +\n coord_sf(expand = FALSE)\n![\"Rectangular](\"https://dieghernan.github.io/assets/img/blog/20230125_grat-1.webp\")
\n# Cut to buffer; we don't flip this one (it is not an object of the space)\ngrat_end <- sf_spherical_cut(\n x = grat,\n the_buff = hemisphere_s2,\n # Change the crs\n the_crs = target_crs\n)\n\n\nggplot(grat_end) +\n geom_sf() +\n coord_sf(expand = FALSE)\n![\"Coordinate](\"https://dieghernan.github.io/assets/img/blog/20230125_grat-2.webp\")
We are almost set! For preparing the final map, first we are going to create the\ncorresponding labels, which will be included as caption on the ggplot2 map:
lat_lab <- pretty_lonlat(desired_loc[1], type = \"lat\")\nlon_lab <- pretty_lonlat(desired_loc[2], type = \"lon\")\n\npretty_labs <- paste(lat_lab, \"/\", lon_lab)\n\ncat(pretty_labs)\n#> 40° 25' 0.14\" N / 3° 42' 12.9\" W\n\n# Create final caption to put on bottom\n\npretty_time <- paste(\n # Pretty Day\n scales::label_date(\n format = \"%d %b %Y\",\n locale = \"en\"\n )(desired_date_tz),\n # Pretty Hour\n format(desired_date_tz, format = \"%H:%M\", usetz = TRUE)\n)\n\ncat(pretty_time)\n#> 22 Sep 2015 03:45 CEST\n\n# Our final caption\ncaption <- toupper(paste0(\n \"Star Map\\n\",\n desired_place, \"\\n\",\n pretty_time, \"\\n\",\n pretty_labs\n))\n\n\ncat(caption)\n#> STAR MAP\n#> MADRID, SPAIN\n#> 22 SEP 2015 03:45 CEST\n#> 40° 25' 0.14\" N / 3° 42' 12.9\" W\nWe can enhance the visualization by applying some interesting effects:
\n\nWe want the Milky Way to appear a bit blurry instead of as a Well-Known\ngeometry. With this effect we can mimic how we really see it from the Earth.\nSo we can use ggfx::with_blur() to get this effect.
We can also add a glowing effect to our stars and constellations (have a\nlook at Dominic Royé’s post Firefly\nCartography to\nknow more about this). The only drawback is that I was not able to use\nggshadow with LINESTRING (Dominic shows how to do it with POINT), so\ninstead I converted my lines (the constellations) to coordinates and applied\nggshadow::geom_glowpath().
So we are ready now to create the final visualization:
\n\n# Prepare MULTILINESTRING\n\nconst_end_lines <- const_end %>%\n st_cast(\"MULTILINESTRING\") %>%\n st_coordinates() %>%\n as.data.frame()\n\n\nggplot() +\n # Graticules\n geom_sf(data = grat_end, color = \"grey60\", linewidth = 0.25, alpha = 0.3) +\n # A blurry Milky Way\n with_blur(\n geom_sf(\n data = mw_end, aes(fill = fill), alpha = 0.1, color = NA,\n show.legend = FALSE\n ),\n sigma = 8\n ) +\n scale_fill_identity() +\n # Glowing stars\n geom_glowpoint(\n data = stars_end, aes(\n alpha = br, size =\n br, geometry = geometry\n ),\n color = \"white\", show.legend = FALSE, stat = \"sf_coordinates\"\n ) +\n scale_size_continuous(range = c(0.05, 0.75)) +\n scale_alpha_continuous(range = c(0.1, 0.5)) +\n # Glowing constellations\n geom_glowpath(\n data = const_end_lines, aes(X, Y, group = interaction(L1, L2)),\n color = \"white\", size = 0.5, alpha = 0.8, shadowsize = 0.4, shadowalpha = 0.01,\n shadowcolor = \"white\", linejoin = \"round\", lineend = \"round\"\n ) +\n # Border of the sphere\n geom_sf(data = hemisphere_sf, fill = NA, color = \"white\", linewidth = 1.25) +\n # Caption\n labs(caption = caption) +\n # And end with theming\n theme_void() +\n theme(\n text = element_text(colour = \"white\"),\n panel.border = element_blank(),\n plot.background = element_rect(fill = \"#191d29\", color = \"#191d29\"),\n plot.margin = margin(20, 20, 20, 20),\n plot.caption = element_text(\n hjust = 0.5, face = \"bold\",\n size = rel(1),\n lineheight = rel(1.2),\n margin = margin(t = 40, b = 20)\n )\n )\n![\"Circular](\"https://dieghernan.github.io/assets/img/blog/20230125_celestial_map-1.webp\")
Voilà! I checked the results several times against those provided by\nd3-celestial.js on the location\ndemo and the underlying\ncalculations in JavaScript, and everything seems to be up and running.
\n\n\n\nCelestial Data also provides\ndata for traditional Chinese constellations, so we can create a similar map with\nthis entirely different set of geometries:
\n\nconst_cn <- load_celestial(\"constellations.lines.cn.min.geojson\")\n\n# Cut and prepare for geom_glowpath() on a single step\nconst_cn_end_lines <- sf_spherical_cut(const_cn,\n the_buff = hemisphere_s2,\n # Change the crs\n the_crs = target_crs,\n flip = flip_matrix\n) %>%\n # To paths\n st_cast(\"MULTILINESTRING\") %>%\n st_coordinates() %>%\n as.data.frame()\n\n\nggplot() +\n # Graticules\n geom_sf(data = grat_end, color = \"grey60\", linewidth = 0.25, alpha = 0.3) +\n # A blurry Milky Way\n with_blur(\n geom_sf(\n data = mw_end, aes(fill = fill), alpha = 0.1, color = NA,\n show.legend = FALSE\n ),\n sigma = 8\n ) +\n scale_fill_identity() +\n # Glowing stars\n geom_glowpoint(\n data = stars_end, aes(\n alpha = br, size =\n br, geometry = geometry\n ),\n color = \"white\", show.legend = FALSE, stat = \"sf_coordinates\"\n ) +\n scale_size_continuous(range = c(0.05, 0.75)) +\n scale_alpha_continuous(range = c(0.1, 0.5)) +\n # Glowing constellations\n geom_glowpath(\n data = const_cn_end_lines, aes(X, Y, group = interaction(L1, L2)),\n color = \"white\", size = 0.5, alpha = 0.8, shadowsize = 0.4, shadowalpha = 0.01,\n shadowcolor = \"white\", linejoin = \"round\", lineend = \"round\"\n ) +\n # Border of the sphere\n geom_sf(data = hemisphere_sf, fill = NA, color = \"white\", linewidth = 1.25) +\n # Caption\n labs(caption = caption) +\n # And end with theming\n theme_void() +\n theme(\n text = element_text(colour = \"white\"),\n panel.border = element_blank(),\n plot.background = element_rect(fill = \"#191d29\", color = \"#191d29\"),\n plot.margin = margin(20, 20, 20, 20),\n plot.caption = element_text(\n hjust = 0.5, face = \"bold\",\n size = rel(1),\n lineheight = rel(1.2),\n margin = margin(t = 40, b = 20)\n )\n )\n![\"Circular](\"https://dieghernan.github.io/assets/img/blog/20230125_celestial_map_cn-1.webp\")
In fact, the download is performed via\njsDelivr, which distributes files hosted on\nGitHub via CDN. This is supposed to\nimprove performance, but in any case the underlying data source is the GitHub\nrepo. ↑
\n![\"DOI\"](\"https://zenodo.org/badge/DOI/10.5281/zenodo.7561601.svg\"){kind=icon}
This project provides several datasets of celestial objects as of the J2000\nepoch in GeoJSON and GeoPackage formats.
\n\nThe original files were provided by the\nd3-celestial plugin\n(Frohn 2015) under\nBSD 3-Clause. The datasets\nproduced by this project consist of the same data provided by the\nd3-celestial plugin processed with\nthe R package sf (Pebesma 2018) to ensure its\nvalidity:
\n\nThe spatial data objects are bounded by \\([-180, -90, 180, 90]\\).
\nThe coordinates represent J2000 celestial directions in degrees.\nEPSG:4326 is assigned for compatibility with GIS\nsoftware. The angles are right ascension and declination.
\nAll geometries are valid as per\nST_IsValid (GEOS 3.9.3).
\nThese URLs serve the same minified GeoJSON file from the main branch.
\n\n<!-- From GitHub -->\nhttps://raw.githubusercontent.com/dieghernan/celestial_data/main/data/mw.min.geojson\n\n<!-- From the website -->\nhttps://dieghernan.github.io/celestial_data/data/mw.min.geojson\n\n<!-- From jsDelivr -->\nhttps://cdn.jsdelivr.net/gh/dieghernan/celestial_data@main/data/mw.min.geojson\nData are provided in GeoJSON (*.geojson) and GeoPackage (*.gpkg) formats.\nAdditionally, for GeoJSON files a minified version (*.min.geojson) is\nalso provided.
The data source can be found in the corresponding\nGitHub repo.
\n\nasterisms.geojsonasterisms.gpkgasterisms.min.geojsonconstellations.borders.cn.geojsonconstellations.borders.cn.gpkgconstellations.borders.cn.min.geojsonconstellations.borders.geojsonconstellations.borders.gpkgconstellations.borders.min.geojsonconstellations.borders.min.min.geojsonconstellations.bounds.cn.geojsonconstellations.bounds.cn.gpkgconstellations.bounds.cn.min.geojsonconstellations.bounds.geojsonconstellations.bounds.gpkgconstellations.bounds.min.geojsonconstellations.cn.csvconstellations.cn.geojsonconstellations.cn.gpkgconstellations.cn.min.geojsonconstellations.csvconstellations.geojsonconstellations.gpkgconstellations.lines.cn.geojsonconstellations.lines.cn.gpkgconstellations.lines.cn.min.geojsonconstellations.lines.geojsonconstellations.lines.gpkgconstellations.lines.min.geojsonconstellations.min.geojsondsonames.cn.csvdsonames.csvdsos.14.geojsondsos.14.gpkgdsos.14.min.geojsondsos.20.geojsondsos.20.gpkgdsos.20.min.geojsondsos.6.geojsondsos.6.gpkgdsos.6.min.geojsondsos.bright.geojsondsos.bright.gpkgdsos.bright.min.geojsonlg.geojsonlg.gpkglg.min.geojsonmessier.geojsonmessier.gpkgmessier.min.geojsonmw.geojsonmw.gpkgmw.min.geojsonstarnames.cn.csvstarnames.csvstars.14.geojsonstars.14.gpkgstars.14.min.geojsonstars.6.geojsonstars.6.gpkgstars.6.min.geojsonstars.8.geojsonstars.8.gpkgstars.8.min.geojsonSee additional details in the\ndata description.
\n\nPlease cite these datasets as:
\n\nFrohn, O., & Hernangómez, D. (2023). Celestial Data [Data set].\nhttps://doi.org/10.5281/zenodo.7561601
\n\nA BibTeX entry:
\n\n\n@misc{frohnhernangomez:2023,\n title = {Celestial Data},\n author = {Olaf Frohn and Diego Hernangómez},\n year = 2023,\n doi = {10.5281/zenodo.7561601},\n url = {https://dieghernan.github.io/celestial_data/},\n}\n\nUpdated on October 25, 2026: The elevation and precipitation maps now use\nggblend to multiply their colors with the hillshade, following\nBarney Harris’s blending adventure.\nThe map and marginal profiles now share the same precipitation palette and limits.\nDominic Royé also demonstrates how to use ggblend in\nHillshade effects.
\n\nThis is the second post of the series “Hillshade, colors and\nmarginal plots with tidyterra”. In this post, I explore an approach for\nannotating marginal plots on a ggplot2 map of a SpatRaster, including\ninformation about the values by longitude and latitude. See the first post of the\nseries here.
\n\nIf you love watching classic movies, especially from Hollywood’s Golden Age,\nyou may recognize the following lyrics:
\n\n\n\n\n\n\nThe rain in Spain stays mainly in the plain!
\n\nBy George, she’s got it! By George, she’s got it!
\n\nNow, once again where does it rain? On the plain! On the plain!
\n\nAnd where’s that soggy plain? In Spain! In Spain!
\n\nThe rain in Spain stays mainly in the plain!
\n\nThe rain in Spain stays mainly in the plain!
\n
This emphatic statement is made in My Fair Lady\n(1964) by Audrey Hepburn,\nRex Harrison and Stanley Holloway. But as a Spaniard, I can tell you it is\ncompletely false.
\n\nThe rain in Spain stays mainly in the north, most notably in Galicia. And I can\nprove it!
\n\nIn this post, I overlay a SpatRaster showing mean precipitation data\nwith an extra set of plots on the margin to identify where the rain in Spain\nstays (mainly).
\n\nIn this post, we will use the following libraries:
\n\n## Libraries\n\n# Data manipulation\nlibrary(terra)\nlibrary(tidyterra)\nlibrary(dplyr)\n\n# Get the data\nlibrary(geodata)\nlibrary(mapSpain)\n\n# Plotting\nlibrary(ggplot2)\nlibrary(scales)\nlibrary(cowplot)\nlibrary(colorspace)\nlibrary(ggblend)\n\n# Define a common theme for the maps.\nbackground <- \"#f8f8ff\"\nink <- \"grey10\"\n\ntheme_set(\n theme(\n plot.background = element_rect(fill = background, colour = NA),\n panel.background = element_rect(fill = background, colour = NA),\n plot.title = element_text(face = \"bold\", colour = ink),\n plot.subtitle = element_text(colour = ink, margin = margin(t = 5, b = 5)),\n plot.caption = element_text(colour = \"grey40\", hjust = 0),\n plot.margin = margin(10, 10, 10, 10),\n legend.background = element_blank()\n )\n)\nThe plain (or as we call it, La Meseta Central) covers a large area of\ninland Spain, with an mean altitude of 650 meters above sea level.
\n\nI didn’t find any accurate spatial data file with the bounds of the plain, so\nfor this case I would approximate it using a mixture of political borders\n(historically the Meseta is associated with Castile and Madrid) and elevation\ndata to get a rough shape.
\n\n# Using mapSpain\nthe_plain <- esp_get_prov(\n c(\n \"Madrid\", \"Castilla-La Mancha\",\n \"Extremadura\", \"Castilla y Leon\",\n \"Teruel\"\n ),\n epsg = 4326, resolution = 1\n) |>\n mutate(the_plain = TRUE) |>\n group_by(the_plain) |>\n # Combine\n summarise() |>\n # To terra, until this step was sf\n vect()\n\n# Get altitude\n\n# I use here a local directory to cache downloaded files on my PC.\n# Modify this to your likes, e.g. using\n# mydir <- tempdir()\n\nmydir <- \"~/R/mapslib/misc\"\n\nr_init <- elevation_30s(\"ESP\", path = mydir)\n\n# For better handling we set here the names\nnames(r_init) <- \"alt\"\n\n# We don't want values lower than 0 on the raster\nr <- r_init |>\n mutate(alt = pmax(0, alt))\n\n# Now intersect the raster and the vector and filter by range\n\nexploded <- r |>\n crop(the_plain, mask = TRUE) |>\n # Let's define here a range of elevations\n filter(alt > 600 & alt < 1100) |>\n drop_na() |>\n as.polygons(dissolve = TRUE, na.rm = TRUE) |>\n # Aggregate first\n aggregate() |>\n # Explode vectors\n disagg() |>\n # And fill holes\n fillHoles()\n\n# Select biggest polygons (area bigger than 50 kms 2)\nr_plain <- exploded\n# Add an attribute before filtering polygons without an attribute table\nr_plain$area <- expanse(r_plain)\nr_plain <- r_plain |>\n filter(area > 50000**2) |>\n # And convert to lines\n as.lines()\n\nggplot(r_plain) +\n geom_spatvector(color = \"red\")\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20221212_plan_alt-1.webp\")
We can create a new plot similar to the one produced in the previous\npost to identify the\nplain. First, I create a base layer with a representation of the\nhillshade, which we will reuse later:
\n\n# Creating hillshade\n\nslope <- terrain(r, \"slope\", unit = \"radians\")\naspect <- terrain(r, \"aspect\", unit = \"radians\")\n\n# Multi-shadow\nhill <- shade(slope, aspect, 45, direction = c(225, 270, 315, 360)) |> mean()\n\n# Stretching\nq <- as.numeric(quantile(values(hill), c(0.05, 0.95), na.rm = TRUE))\n\nhill <- clamp((hill - q[1]) / diff(q), 0, 1)\n\n# normalize names\nnames(hill) <- \"shades\"\n\n# Hillshading palette\npal_greys <- hcl.colors(1000, \"Grays\")\n\n# Index of color by cell\nindex <- hill |>\n mutate(index_col = rescale(shades, to = c(1, length(pal_greys)))) |>\n mutate(index_col = round(index_col)) |>\n pull(index_col)\n\n# Get cols\nvector_cols <- pal_greys[index]\n\n# Need to avoid resampling\n# and don't use aes\n\n# Base hill plot\nhill_plot <- ggplot() +\n geom_spatraster(\n data = hill, fill = vector_cols, maxcell = Inf,\n alpha = 1\n )\n\nhill_plot\n![\"Grayscale](\"https://dieghernan.github.io/assets/img/blog/20221212_hill-1.webp\")
As in the updated first post, we resolve the thematic raster’s colors before\ncombining it with the hillshade. This helper keeps the original scale underneath\nthe blend to generate the legend. The opaque thematic layer inside the blend\ncovers it, and the hillshade adds texture. The legend\nshows the palette before shading. We use ragg to render these compositing\ngroups.
\n\n# Blend a thematic raster with the fixed hillshade colors\nblend_hillshade <- function(data, fill_scale) {\n stopifnot(compareGeom(data, hill))\n thematic_plot <- ggplot() +\n geom_spatraster(data = data, maxcell = Inf) +\n fill_scale\n thematic_fill <- ggplot_build(thematic_plot)$data[[1]]$fill\n stopifnot(\n length(thematic_fill) == ncell(data),\n length(vector_cols) == ncell(hill)\n )\n\n # The layer underneath supplies the scale and legend\n thematic_plot +\n (list(\n geom_spatraster(data = data, fill = thematic_fill, maxcell = Inf),\n geom_spatraster(\n data = hill, fill = vector_cols, maxcell = Inf\n )\n ) |>\n ggblend::blend(\"multiply\"))\n}\nAnd finally we blend the altitude with the hillshade. The plain should be quite\nvisible even without plotting the outline.
\n\n# Overlaying and theming\n\n# Aware of limits of the raster\n\nalt_limits <- minmax(r) |> as.vector()\n# Round to lower and higher 500 integer with a min of 0\nalt_limits <- pmax(\n c(floor(alt_limits[1] / 500), ceiling(alt_limits[2] / 500)) * 500,\n 0\n)\n\nalt_limits\n#> [1] 0 3500\n\nbase_text_size <- 9\n\nalt_palette <- subset(hypsometric_tints_db, pal == \"wiki-schwarzwald-cont\")\nalt_scale <- scale_fill_hypso_tint_c(\n palette = \"wiki-schwarzwald-cont\",\n limits = alt_limits,\n values = rescale(alt_palette$limit, to = alt_limits),\n na.value = NA,\n breaks = seq(0, 3500, 250),\n labels = label_comma()\n)\n\nplot_esp <- blend_hillshade(r, alt_scale) +\n guides(fill = guide_legend(\n title = \" m.\",\n title.position = \"top\",\n keywidth = .5,\n reverse = TRUE,\n override.aes = list(alpha = 1)\n )) +\n labs(\n title = \"Elevation of Spain\",\n subtitle = \"The plain in green\"\n ) +\n theme(\n text = element_text(family = \"serif\"),\n plot.title = element_text(\n face = \"bold\", size = base_text_size * 1.5,\n hjust = 0.5\n ),\n plot.subtitle = element_text(\n size = base_text_size * 0.9,\n hjust = 0.5\n ),\n plot.caption = element_text(\n margin = margin(t = base_text_size * 3),\n face = \"italic\"\n ),\n axis.line = element_blank(),\n axis.ticks = element_blank(),\n axis.text = element_blank(),\n panel.grid = element_blank(),\n legend.key = element_rect(\"grey50\"),\n legend.text = element_text(hjust = 0),\n legend.position = \"left\"\n )\n\nplot_esp\n![\"Relief](\"https://dieghernan.github.io/assets/img/blog/20221212_hill_overlay-1.webp\")
Let’s check now whether the rain falls mainly in the plain or not. We use here\ngeodata::worldclim_country() to get the mean monthly precipitation by from\nWorldClim:
# Precipitation of Spain\n\n# Get precip data\nprecip <- geodata::worldclim_country(\"ESP\", \"prec\", mydir)\n\nprecip\n#> class : SpatRaster\n#> size : 1980, 2760, 12 (nrow, ncol, nlyr)\n#> resolution : 0.008333333, 0.008333333 (x, y)\n#> extent : -18.5, 4.5, 27.5, 44 (xmin, xmax, ymin, ymax)\n#> coord. ref. : lon/lat WGS 84 (EPSG:4326)\n#> source : ESP_wc2.1_30s_prec.tif\n#> names : ESP_w~rec_1, ESP_w~rec_2, ESP_w~rec_3, ESP_w~rec_4, ESP_w~rec_5, ESP_w~rec_6, ...\n#> min values : 0, 1, 1, 0, 0, 0, ...\n#> max values : 296, 255, 199, 166, 181, 140, ...\nWe have now a SpatRaster with 12 layers representing the value of each month. So\nwe now just add the values by cell to get the annual mean. Note that we also\nneed to normalize the SpatRaster to the projection, extent and resolution of our\nhill object:
# Sum all layers\nprecip_avg <- sum(precip)\n\nprecip_avg\n#> class : SpatRaster\n#> size : 1980, 2760, 1 (nrow, ncol, nlyr)\n#> resolution : 0.008333333, 0.008333333 (x, y)\n#> extent : -18.5, 4.5, 27.5, 44 (xmin, xmax, ymin, ymax)\n#> coord. ref. : lon/lat WGS 84 (EPSG:4326)\n#> source(s) : memory\n#> name : sum\n#> min value : 8\n#> max value : 2055\n\ncompare_spatrasters(precip_avg, hill)\n\n# Align raster using hill\n\nprecip_avg_mask <- precip_avg |>\n project(hill) |>\n crop(hill) |>\n mask(hill)\n\n# Normalize\nnames(precip_avg_mask) <- \"prec\"\n\ncompare_spatrasters(precip_avg_mask, hill)\n\nautoplot(precip_avg_mask)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20221212_prepare_precip-1.webp\")
We can now start representing our precipitation map. I chose here to create a\ncustom palette with colorspace to better highlight the differences:
\n\nmypal <- sequential_hcl(\n n = 16,\n h = c(320, 80),\n c = c(60, 65, 20),\n l = c(30, 95), power = c(0.7, 1.3),\n rev = TRUE\n)\n\nshow_col(mypal)\n![\"Grid](\"https://dieghernan.github.io/assets/img/blog/20221212_mypal-1.webp\")
And now we can create the final map showing if the rain in Spain stays mainly\nin the plain:
\n\n# Precipitation limits, rounded to 100\nprec_limits <- floor(as.vector(minmax(precip_avg_mask)) / 100) * 100 + c(0, 100)\n\n# Reuse this scale for the map and both marginal profiles\nprecip_scale <- scale_fill_gradientn(\n colours = mypal,\n limits = prec_limits,\n na.value = NA,\n labels = label_comma(),\n breaks = seq(0, prec_limits[2], 250)\n)\n\nmeteo_plot <- blend_hillshade(precip_avg_mask, precip_scale) +\n geom_spatvector(\n data = r_plain, color = alpha(\"black\", 0.7),\n linewidth = .1\n ) +\n guides(fill = guide_legend(\n direction = \"horizontal\",\n keyheight = .5,\n keywidth = unit(0.4, \"in\"),\n theme = theme(\n legend.title.position = \"right\",\n legend.text.position = \"bottom\"\n ),\n nrow = 1,\n title = \" mm.\",\n override.aes = list(alpha = 1)\n )) +\n labs(\n title = \"Mean annual precipitation of Spain\",\n subtitle = \"The rain in Spain does not stay mainly in the plain\"\n ) +\n theme(\n text = element_text(family = \"serif\"),\n plot.title = element_text(\n face = \"bold\", size = base_text_size * 1.5,\n hjust = 0.5\n ),\n plot.subtitle = element_text(\n size = base_text_size,\n hjust = 0.5\n ),\n axis.text = element_text(size = base_text_size * 0.7, face = \"italic\"),\n legend.key = element_rect(\"grey50\"),\n legend.position = \"bottom\",\n legend.title = element_text(size = base_text_size * .7),\n legend.text = element_text(size = base_text_size * .7),\n legend.key.spacing.x = unit(0, \"pt\")\n )\n\nmeteo_plot\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20221212_precip_end-1.webp\")
We can now see that the rain in Spain falls mainly on the Atlantic coast\n(northern Spain) and specifically in Galicia. That’s why in Spanish the lyrics\nThe rain in Spain stays mainly in the plain were translated into:
\n\n\n\n\nLa lluvia en Sevilla es una pura maravilla.
\n
That can be translated as “The rain in Seville is a true marvel”. And it is,\nindeed. Seville (located in the south on the Guadalquivir\nValley) has circa 50 rainy days per year,\nfeaturing very hot and dry summers.
\n\n\n\nWe can now start profiling our final plot. The idea is to create two bar charts,\nrepresenting the value to be plotted (in this case, mean annual\nprecipitation) by longitude and latitude.
\n\nThe map and both profiles use precip_scale, with the same opaque colors and\nexplicit limits. Hillshade changes the map’s brightness, while the profiles\nshow the unshaded palette. The means are calculated from the precipitation\nvalues, before any color mapping or blending.
But first we add some additional margins and axis titles to the main plot, so we\ncan insert those marginal plots easily on our main plot:
\n\n# Now we can add titles on the secondary axis\n\nplot_main <- meteo_plot +\n xlab(\"\") +\n ylab(\"\") +\n # titles on secondary axis, for later\n scale_x_continuous(sec.axis = dup_axis(\n name = \"avg. precipitation by longitude\"\n )) +\n scale_y_continuous(sec.axis = dup_axis(\n name = \"avg. precipitation by latitude\"\n )) +\n theme(\n axis.title.x = element_text(\n margin = margin(t = base_text_size),\n size = base_text_size * 1.2, face = \"italic\"\n ),\n axis.title.y = element_text(\n angle = 270,\n margin = margin(\n l = base_text_size,\n t = base_text_size\n ),\n size = base_text_size * 1.2, face = \"italic\"\n )\n )\n\nplot_main\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20221212_precip_for_margin-1.webp\")
In the following code, I am drafting what the marginal plots would look\nlike, so we can have a preview of the final result:
\n\n# Profiling marginal plots\n\n# Getting averages by x,y\nmarg_x <- precip_avg_mask |>\n as_tibble(xy = TRUE) |>\n drop_na() |>\n group_by(x) |>\n summarise(avg = mean(prec))\n\nmarg_y <- precip_avg_mask |>\n as_tibble(xy = TRUE) |>\n drop_na() |>\n group_by(y) |>\n summarise(avg = mean(prec))\n\n# Cowplot would delete axis, we create an axis at 1000 and 2000\nbr_4marginal <- c(1000, 2000)\n\nlabs <- data.frame(labs = paste(\n prettyNum(br_4marginal, big.mark = \" \"),\n \"mm.\"\n))\n\nlabs$for_x <- max(marg_x$x) - diff(range(marg_x$x)) * 0.05\nlabs$for_y <- min(marg_y$y) + diff(range(marg_y$y)) * 0.05\nlabs$y <- br_4marginal\n\n# Profiling\nggplot() +\n geom_col(\n data = marg_x,\n aes(x, avg, fill = avg),\n color = NA,\n show.legend = FALSE\n ) +\n geom_text(\n data = labs, aes(x = for_x, y = y, label = labs),\n nudge_y = 100,\n size = 3\n ) +\n precip_scale +\n scale_y_continuous(\n breaks = br_4marginal,\n limits = c(0, max(br_4marginal) * 1.5)\n ) +\n theme_void() +\n theme(panel.grid.major.y = element_line(\n colour = \"grey50\",\n linetype = \"dashed\"\n ))\n![\"Bar](\"https://dieghernan.github.io/assets/img/blog/20221212_profile_marg-1.webp\")
\nggplot() +\n geom_col(\n data = marg_y,\n aes(y, avg, fill = avg),\n color = NA,\n show.legend = FALSE\n ) +\n geom_text(\n data = labs, aes(x = for_y, y = y, label = labs),\n nudge_y = 100,\n angle = 270,\n size = 3\n ) +\n precip_scale +\n scale_y_continuous(\n breaks = br_4marginal,\n limits = c(0, max(br_4marginal) * 1.2)\n ) +\n coord_flip() +\n theme_void() +\n theme(panel.grid.major.x = element_line(\n colour = \"grey50\",\n linetype = \"dashed\"\n ))\n![\"Horizontal](\"https://dieghernan.github.io/assets/img/blog/20221212_profile_marg-2.webp\")
Finally, we use cowplot::axis_canvas() to create the marginal plots as\nwe want:
# Last step: We combine plots\n\n# Marginal plots\nplot_x <- axis_canvas(plot_main, axis = \"x\") +\n geom_col(\n data = marg_x,\n aes(x, avg, fill = avg),\n color = NA,\n show.legend = FALSE\n ) +\n geom_text(\n data = labs, aes(x = for_x, y = y, label = labs),\n # Adjust the position of the labels\n nudge_y = 300,\n family = \"serif\",\n fontface = \"italic\",\n size = base_text_size * 0.2\n ) +\n precip_scale +\n scale_y_continuous(\n breaks = br_4marginal,\n limits = c(0, max(br_4marginal) * 1.5)\n ) +\n theme_void() +\n theme(panel.grid.major.y = element_line(\n colour = \"grey50\",\n linetype = \"dashed\",\n linewidth = 0.1\n ))\n\nplot_x\n![\"Bar](\"https://dieghernan.github.io/assets/img/blog/20221212_prepare_axis-1.webp\")
\nplot_y <- axis_canvas(plot_main, axis = \"y\", coord_flip = TRUE) +\n geom_col(\n data = marg_y,\n aes(y, avg, fill = avg),\n color = NA,\n show.legend = FALSE\n ) +\n geom_text(\n data = labs, aes(x = for_y, y = y, label = labs),\n # Adjust the position of the labels\n nudge_y = 300,\n angle = 270,\n family = \"serif\",\n fontface = \"italic\",\n size = base_text_size * 0.2\n ) +\n precip_scale +\n scale_y_continuous(\n breaks = br_4marginal,\n limits = c(0, max(br_4marginal) * 1.5)\n ) +\n coord_flip() +\n theme_void() +\n theme(panel.grid.major.x = element_line(\n colour = \"grey50\",\n linetype = \"dashed\",\n linewidth = 0.1\n ))\nplot_y\n![\"Horizontal](\"https://dieghernan.github.io/assets/img/blog/20221212_prepare_axis-2.webp\")
And insert everything in the main plot. See the final result:
\n\n# Combine all plots into one\nsizes_axis <- grid::unit(.3, \"null\")\n\nplot_final <- insert_xaxis_grob(plot_main, plot_x,\n position = \"top\",\n height = sizes_axis\n)\nplot_final <- insert_yaxis_grob(plot_final, plot_y,\n position = \"right\",\n width = sizes_axis * 1.25\n)\n\ngg_final <- ggdraw(plot_final)\ngg_final\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20221212_finalplot-1.webp\")
And with a bit of effort we got it.
\n\nMuch of the code we have created relates to the theming and labels of the\nplot. Here you can find a simplified version:
\n\n# Libraries\n# Data manipulation\nlibrary(terra)\nlibrary(tidyterra)\nlibrary(dplyr)\n\n# Get the data\nlibrary(geodata)\n\n# Plotting\nlibrary(ggplot2)\nlibrary(scales)\nlibrary(cowplot)\nlibrary(colorspace)\n\n# Get the data\nmydir <- \"~/R/mapslib/misc\"\n\nr <- elevation_30s(\"ESP\", path = mydir) |>\n rename(alt = 1) |>\n mutate(alt = pmax(0, alt))\n\n# Creating hillshade\n\nslope <- terrain(r, \"slope\", unit = \"radians\")\naspect <- terrain(r, \"aspect\", unit = \"radians\")\nhill <- shade(slope, aspect, 30, 45)\n\n# normalize names\nnames(hill) <- \"shades\"\n\n# Hillshading palette\npal_greys <- hcl.colors(1000, \"Grays\")\n\n# Index of color by cell\nindex <- hill |>\n mutate(index_col = rescale(shades, to = c(1, length(pal_greys)))) |>\n mutate(index_col = round(index_col)) |>\n pull(index_col)\n\n# Get cols\nvector_cols <- pal_greys[index]\n\n# Base hill plot\nhill_plot <- ggplot() +\n geom_spatraster(\n data = hill, fill = vector_cols, maxcell = Inf,\n alpha = 1\n ) +\n theme_minimal()\n\n# Blend a thematic raster with the fixed hillshade colors\nblend_hillshade <- function(data, fill_scale) {\n stopifnot(compareGeom(data, hill))\n thematic_plot <- ggplot() +\n geom_spatraster(data = data, maxcell = Inf) +\n fill_scale\n thematic_fill <- ggplot_build(thematic_plot)$data[[1]]$fill\n stopifnot(\n length(thematic_fill) == ncell(data),\n length(vector_cols) == ncell(hill)\n )\n\n # The layer underneath supplies the scale and legend\n thematic_plot +\n (list(\n geom_spatraster(data = data, fill = thematic_fill, maxcell = Inf),\n geom_spatraster(\n data = hill, fill = vector_cols, maxcell = Inf\n )\n ) |>\n ggblend::blend(\"multiply\"))\n}\n\n# Overlay\nprecip <- geodata::worldclim_country(\"ESP\", \"prec\", mydir)\nprecip_end <- sum(precip) |>\n project(hill) |>\n crop(hill) |>\n mask(hill) |>\n rename(prec = 1)\n\np_range <- as.vector(minmax(precip_end))\n\nmypal <- sequential_hcl(\n n = 16,\n h = c(320, 80),\n c = c(60, 65, 20),\n l = c(30, 95), power = c(0.7, 1.3),\n rev = TRUE\n)\n\nprecip_scale <- scale_fill_gradientn(\n colours = mypal, na.value = NA,\n limits = p_range\n)\nbase_plot <- blend_hillshade(precip_end, precip_scale) +\n theme_minimal() +\n theme(plot.background = element_rect(fill = \"#F0FFFF\"))\n\n# Marginal plots\n# Data\nmarg_x <- precip_end |>\n as_tibble(xy = TRUE) |>\n drop_na() |>\n group_by(x) |>\n summarise(avg = mean(prec))\n\nmarg_y <- precip_end |>\n as_tibble(xy = TRUE) |>\n drop_na() |>\n group_by(y) |>\n summarise(avg = mean(prec))\n\n# Adding marginal plots\n\nplot_x <- axis_canvas(base_plot, axis = \"x\") +\n geom_col(\n data = marg_x,\n aes(x, avg, fill = avg),\n color = NA,\n show.legend = FALSE\n ) +\n precip_scale +\n theme_void()\n\nplot_y <- axis_canvas(base_plot, axis = \"y\", coord_flip = TRUE) +\n geom_col(\n data = marg_y,\n aes(y, avg, fill = avg),\n color = NA,\n show.legend = FALSE\n ) +\n precip_scale +\n theme_void() +\n coord_flip()\n\n# All pieces together\nsizes_axis <- grid::unit(.3, \"null\")\n\nplot_final_simp <- insert_xaxis_grob(base_plot, plot_x,\n position = \"top\",\n height = sizes_axis\n)\nplot_final_simp <- insert_yaxis_grob(plot_final_simp, plot_y,\n position = \"right\",\n width = sizes_axis * 1.25\n)\n\ngg_final_simp <- ggdraw(plot_final_simp)\ngg_final_simp\n![\"Simplified](\"https://dieghernan.github.io/assets/img/blog/20221212_simplified-1.webp\")
Updated on October 25, 2026: This post now uses ggblend to combine\nhillshade and elevation colors with a multiply blend, following Barney Harris’s\nblending\nadventure. The\nfinal map replaces the original overlay with reduced opacity. Dominic Royé also\ndemonstrates how to use ggblend in Hillshade\neffects.
\n\nThis is the first post of a series of two, showing how to overlay a SpatRaster\non top of a hillshade background. The next post shows how to add marginal plots\nincluding information about the values of the raster by longitude and latitude.\nSee the second post\nhere.
\n\nUsing shadow effects on relief maps is a very common technique that helps\nproduce informative yet beautiful maps. If you are interested in this topic and\nyou work with R, you have probably seen this map:
\n\n![\"Map](\"https://timogrossenbacher.ch/content/images/size/w2000/2023/07/bm-thematic-bivariate-map-with-legend-1-2.png\")
The production of this map by Timo\nGrossenbacher\nhas been a reference for years. However, recent developments in the R\npackage ecosystem (terra, sf and support of both classes on ggplot2,\ndevelopment of ggnewscale, etc.) can make it even easier to produce these\ntypes of maps.
\n\nIn fact, Dominic Royé recently wrote a very detailed\npost on creating shadow\neffects on map reliefs. In this first post of the series, I replicate that\ntechnique with a slight variation (e.g. not making use of ggnewscale) and\ndiscuss the potential choice of a color palette for this kind of map.
\n\nI will use the following libraries:
\n\n## Libraries\n\nlibrary(terra)\nlibrary(tidyterra)\nlibrary(ggplot2)\nlibrary(dplyr)\nlibrary(scales)\n\n# Get the data\nlibrary(geodata)\n\n# Define a common theme for the maps.\nbackground <- \"#faf8f2\"\nink <- \"#203b47\"\n\ntheme_set(\n theme_void() +\n theme(\n plot.background = element_rect(fill = background, colour = NA),\n panel.background = element_rect(fill = background, colour = NA),\n plot.title = element_text(face = \"bold\", colour = ink),\n plot.subtitle = element_text(colour = ink),\n plot.caption = element_text(colour = \"grey40\", hjust = 0),\n plot.margin = margin(10, 10, 10, 10)\n )\n)\nThe first step is to get the altitude data. I use the geodata package for\nsimplicity, but you can also use elevatr, which is much more comprehensive.\nHowever, elevatr produces the result as a RasterLayer, so you would need\nto convert the object to SpatRaster with terra::rast().
# Cache map data\nmydir <- \"~/R/mapslib/misc\"\n\nr_init <- elevation_30s(\"ROU\", path = mydir)\n\nr_init\n#> class : SpatRaster\n#> size : 588, 1176, 1 (nrow, ncol, nlyr)\n#> resolution : 0.008333333, 0.008333333 (x, y)\n#> extent : 20.1, 29.9, 43.5, 48.4 (xmin, xmax, ymin, ymax)\n#> coord. ref. : lon/lat WGS 84 (EPSG:4326)\n#> source : ROU_elv_msk.tif\n#> name : ROU_elv_msk\n#> min value : -4\n#> max value : 2481\n\n# For better handling we set here the names\nnames(r_init) <- \"alt\"\n\n# We don't want values lower than 0\nr <- r_init |>\n mutate(alt = pmax(0, alt))\n\nr\n#> class : SpatRaster\n#> size : 588, 1176, 1 (nrow, ncol, nlyr)\n#> resolution : 0.008333333, 0.008333333 (x, y)\n#> extent : 20.1, 29.9, 43.5, 48.4 (xmin, xmax, ymin, ymax)\n#> coord. ref. : lon/lat WGS 84 (EPSG:4326)\n#> source(s) : memory\n#> name : alt\n#> min value : 0\n#> max value : 2481\nWe can now have a quick look at the plot with tidyterra::autoplot():
# Quick look\nautoplot(r) +\n scale_fill_terrain_c(na.value = NA) +\n facet_wrap(vars(lyr)) +\n theme_minimal()\n![\"Elevation](\"https://dieghernan.github.io/assets/img/blog/20221017-1-autoplot-1.webp\")
The next step is to calculate the hillshade. Royé has a very detailed discussion\nhere,\nso I would not go into details. Basically what we want to create is a layer that\napproximates the potential “texture” of the surface based on the elevation and\nthe sun’s position. This is straightforward with the terra::terrain() and\nterra::shade() functions.
The resulting hillshade may have a relatively narrow range of intensity values,\nproducing a rather flat appearance when combined with elevation colors. To\nenhance terrain details, we apply a percentile-based contrast stretch,\nmapping the 5th and 95th percentiles to 0 and 1, respectively, and clipping\nvalues outside this range. This expands the tonal range and makes subtle terrain\nfeatures more visible without changing the underlying elevation data. Note that\nthis is purely a visual adjustment that produces a more “dramatic” map: it\ndoes not add terrain information or modify the hillshading algorithm.
\n\n## Create hillshade effect\n\nslope <- terrain(r, \"slope\", unit = \"radians\")\naspect <- terrain(r, \"aspect\", unit = \"radians\")\n\n# Multi-shadow\nhill <- shade(slope, aspect, 45, direction = c(225, 270, 315, 360)) |> mean()\n\n# Stretching\nq <- as.numeric(quantile(values(hill), c(0.05, 0.95), na.rm = TRUE))\n\nhill <- clamp((hill - q[1]) / diff(q), 0, 1)\n\n# Normalize names\nnames(hill) <- \"shades\"\n\n# Hillshading, but we need a palette\npal_greys <- hcl.colors(1000, \"Grays\")\n\nggplot() +\n geom_spatraster(data = hill) +\n scale_fill_gradientn(colors = pal_greys, na.value = NA)\n#> <SpatRaster> resampled to 501501 cells.\n![\"Grayscale](\"https://dieghernan.github.io/assets/img/blog/20221017-2-hillroye-1.webp\")
We can also do the following hack to avoid the use of a scale_fill_* (via\nggplot2 or via ggnewscale::new_scale_fill()):
pal_greys).c(1, 1000)).pal_greys should be mapped to each cell.fill on the geom_ instead of using the scale.An additional note is that geom_spatraster() has a parameter maxcell that\nwould perform a spatial resampling if the raster has more cells than maxcell.\nThis is for optimization (note that terra::plot() has the same setup and that\nusers often forget about it), but we can force all cells to be plotted by using\nmaxcell = Inf. In this approach using fill, the value of maxcell needs to\nbe effectively set to Inf to ensure that the number of color values and the\nnumber of cells are the same.
# Use a vector of colors\n\nindex <- hill |>\n mutate(index_col = rescale(shades, to = c(1, length(pal_greys)))) |>\n mutate(index_col = round(index_col)) |>\n pull(index_col)\n\n# Get cols\nvector_cols <- pal_greys[index]\n\n# Need to avoid resampling\n# and don't use aes\n\nhill_plot <- ggplot() +\n geom_spatraster(\n data = hill, fill = vector_cols, maxcell = Inf,\n alpha = 1\n )\n\nhill_plot\n![\"Alternative](\"https://dieghernan.github.io/assets/img/blog/20221017-3-hillalt-1.webp\")
The selection of colors for elevation maps is a key aspect when designing this\nkind of visualization since colors can be confused with environmental phenomena\n(Patterson and Jenny, 2011). For example, by convention green colors are\nassociated with low elevations, while orange, browns and whites are associated\nwith high elevations on some of the most common elevation palettes (aka\nhypsometric tints). See for example the Wikipedia Topographic maps\nconventions.
\n\nThis is not ideal, since greens can be confused with forests, for example, so an\nelevation map of desert areas would not be appropriate with a green-brown-white\ncolor scheme.
\n\nThere is an additional point to take into account when designing color palettes\nfor maps. A regular gradient would just interpolate colors assuming that the\ndistance among colors is the same:
\n\n# Regular gradient\ngrad <- hypso.colors(10, \"dem_poster\")\n\nautoplot(r) +\n facet_wrap(vars(lyr)) +\n scale_fill_gradientn(colours = grad, na.value = NA)\n![\"Elevation](\"https://dieghernan.github.io/assets/img/blog/20221017-regular-gradient-1.webp\")
For that reason, tidyterra provides additional gradients whose colors are\nplaced unevenly with the goal of providing a better understanding of the maps:
\n\n# Hypso gradient\ngrad_hypso <- hypso.colors2(10, \"dem_poster\")\n\nautoplot(r) +\n facet_wrap(vars(lyr)) +\n scale_fill_gradientn(colours = grad_hypso, na.value = NA)\n![\"Elevation](\"https://dieghernan.github.io/assets/img/blog/20221017-hypso-gradient-1.webp\")
Can you notice the difference? In the first map greens are the dominant color.\nHowever greens are representing a wide range of elevations (0-750 meters) that\ncorrespond with most of the territory. In terms of perception, we won’t be\nclearly spotting elevation differences in the center of the country, while with\nthe uneven gradient greens only correspond to the range (0 - 250 meters) and the\noverall perception of elevation improves. Note that the only difference between\nplots is exclusively the color palette.
\n\nFor producing our map we are going to assess visually the result of a selection\nof palettes provided by tidyterra. We use here the version\ntidyterra::scale_fill_hypso_tint_c() instead of\ntidyterra::scale_fill_hypso_c() for taking advantage of the uneven color\ngradients.
A downside of using these scales is that we also need to adjust the limits\nargument of the functions to make ggplot2 aware of the limits of the value\nof the raster. This is easily achieved with terra::minmax() but I added an\nextra touch rounding up and down the range of values to the nearest 500.
# Try some options, but we need to be aware of the values of our raster\n\nr_limits <- minmax(r) |> as.vector()\n\n# Rounded to lower and upper 500\nr_limits <- c(floor(r_limits[1] / 500), ceiling(r_limits[2] / 500)) * 500\n\n# And making min value to 0.\nr_limits <- pmax(r_limits, 0)\n\n# Compare\nminmax(r) |> as.vector()\n#> [1] 0 2481\nr_limits\n#> [1] 0 2500\n\n# Now let's have some fun with scales from tidyterra\n\nelevt_test <- ggplot() +\n geom_spatraster(data = r)\n\n# Create a helper function\n\nplot_pal_test <- function(pal) {\n palette_stops <- hypsometric_tints_db[hypsometric_tints_db$pal == pal, ]\n elevt_test +\n scale_fill_hypso_tint_c(\n limits = r_limits,\n values = rescale(palette_stops$limit, to = r_limits),\n palette = pal\n ) +\n ggtitle(pal) +\n theme_minimal()\n}\n\nplot_pal_test(\"etopo1_hypso\")\nplot_pal_test(\"dem_poster\")\nplot_pal_test(\"spain\")\nplot_pal_test(\"pakistan\")\nplot_pal_test(\"utah_1\")\nplot_pal_test(\"wiki-2.0_hypso\")\n![\"Relief](\"https://dieghernan.github.io/assets/img/blog/20221017-4-explorepals-1.webp\")
![\"Relief](\"https://dieghernan.github.io/assets/img/blog/20221017-4-explorepals-2.webp\")
![\"Relief](\"https://dieghernan.github.io/assets/img/blog/20221017-4-explorepals-3.webp\")
![\"Relief](\"https://dieghernan.github.io/assets/img/blog/20221017-4-explorepals-4.webp\")
![\"Relief](\"https://dieghernan.github.io/assets/img/blog/20221017-4-explorepals-5.webp\")
![\"Relief](\"https://dieghernan.github.io/assets/img/blog/20221017-4-explorepals-6.webp\")
I finally selected for my plot the \"dem_poster\" palette, but this is\ncompletely a personal choice. You should select the palette you feel more\ncomfortable with. See the full range of color palettes provided by tidyterra\nhere.
We can combine the elevation colors and hillshade with a multiply blend. This\npreserves more of the elevation palette’s saturation than the original overlay,\nwhich used alpha = 0.4. The hillshade darkens the colors to reveal the\nterrain. Its opacity controls the strength of the shading.
Both rasters would normally need their own fill scale. We already converted\nthe hillshade to fixed colors above. Here we also extract the elevation colors\nwith ggplot_build() before passing both layers to ggblend. Using\nmaxcell = Inf keeps the color vectors matched to the raster cells.
# Fit the full palette to the local elevation range\npalette_stops <- subset(hypsometric_tints_db, pal == \"dem_poster\")\npalette_values <- rescale(palette_stops$limit, to = r_limits)\n\nelevation_plot <- ggplot() +\n geom_spatraster(data = r, maxcell = Inf) +\n scale_fill_hypso_tint_c(\n limits = r_limits,\n values = palette_values,\n palette = \"dem_poster\",\n na.value = NA,\n guide = guide_colourbar(barheight = unit(4, \"in\")),\n labels = label_comma(),\n # For the legend I use custom breaks\n breaks = c(\n seq(0, 500, 100),\n seq(750, 1500, 250),\n 2000\n )\n )\n\nelevation_fill <- ggplot_build(elevation_plot)$data[[1]]$fill\nstopifnot(\n compareGeom(r, hill),\n length(elevation_fill) == ncell(r),\n length(vector_cols) == ncell(hill)\n)\n\n# Keep the scale-trained layer underneath to generate the elevation legend\nbase_plot <- elevation_plot +\n (list(\n geom_spatraster(data = r, fill = elevation_fill, maxcell = Inf),\n geom_spatraster(\n data = hill, fill = vector_cols, alpha = 0.85, maxcell = Inf\n )\n ) |>\n ggblend::blend(\"multiply\"))\n\nbase_plot\n![\"Relief](\"https://dieghernan.github.io/assets/img/blog/20221017-5-blend-1.webp\")
The opaque elevation layer inside the blend covers the scale-trained layer\nunderneath, which supplies the legend. The legend shows the elevation palette\nbefore shading. We render with ragg, which supports the compositing groups\nused by ggblend.
\n\nFor the final map, we use Noto Serif when its font files are available locally\nand fall back to the system serif font otherwise:
\n\nfont_dir <- path.expand(\"~/R/googlefonts\")\nfont_files <- file.path(\n font_dir,\n paste0(\"NotoSerif-\", c(\"Regular\", \"Bold\", \"Italic\", \"BoldItalic\"), \".ttf\")\n)\nfont_family <- \"serif\"\nif (all(file.exists(font_files))) {\n systemfonts::register_font(\n \"notoserif\",\n plain = font_files[1],\n bold = font_files[2],\n italic = font_files[3],\n bolditalic = font_files[4]\n )\n font_family <- \"notoserif\"\n}\nAnd now we theme it:
\n\n# Theming\n\n# Adjust text size\nbase_text_size <- 16\n\nbase_plot +\n # Change guide\n guides(fill = guide_legend(\n title = \" m.\",\n direction = \"horizontal\",\n nrow = 1,\n keywidth = unit(0.45, \"in\"),\n keyheight = 0.5,\n theme = theme(\n legend.text.position = \"bottom\",\n legend.title.position = \"right\"\n ),\n override.aes = list(alpha = 1)\n )) +\n labs(\n title = \"Elevation of Romania\",\n subtitle = \"Hillshade and hypsometric tint | Multiply blend\",\n caption = paste0(\n \"@dhernangomez using tidyterra, ggplot2, geodata R packages.\",\n \" Data: Shuttle Radar Topography Mission (SRTM)\"\n )\n ) +\n theme_minimal(base_family = font_family) +\n theme(\n plot.background = element_rect(\"grey97\", colour = NA),\n plot.margin = margin(20, 20, 20, 20),\n plot.caption = element_text(size = base_text_size * 0.5),\n plot.title = element_text(face = \"bold\", size = base_text_size * 1.4),\n plot.subtitle = element_text(\n margin = margin(b = 10),\n size = base_text_size\n ),\n axis.text = element_text(size = base_text_size * 0.7),\n legend.position = \"bottom\",\n legend.title = element_text(size = 8),\n legend.text = element_text(size = 8),\n legend.key = element_rect(\"grey50\"),\n legend.key.spacing.x = unit(0, \"pt\")\n )\n![\"Relief](\"https://dieghernan.github.io/assets/img/blog/20221017-6-finalplot-1.webp\")
If you have been playing around with R for a while, you are probably\nfamiliar with the volcano dataset:
data(\"volcano\")\nimage(volcano, col = terrain.colors(256, rev = TRUE))\n![\"Elevation](\"https://dieghernan.github.io/assets/img/blog/20220525_volcano-1.webp\")
This represents the topographic information about one of the volcanoes of Auckland\n(New Zealand), specifically Maungawhau / Mount\nEden. But do you know\nthat this map is flipped?
\n\nIn this post I introduce the tidyterra\npackage, recently added to\nCRAN, and I show you how to\ngeotag the volcano dataset. We will also produce ggplot2 maps using the\nfunctions of tidyterra.
# Libraries\nlibrary(terra)\nlibrary(ggplot2)\nlibrary(tidyterra)\nlibrary(maptiles)\nlibrary(sf)\nvolcano is flipped?Let’s check it out. Thanks to the package maptiles we can have a glimpse of\nthe location of Maungawhau using map tiles, as in Google Maps. We will use\ntidyterra for displaying the map tile:
\n\n# location of Maungawhau\n\nbox <- c(\n 174.7611552780,\n -36.8799200525,\n 174.7682380109,\n -36.8719519780\n)\nclass(box) <- \"bbox\"\nbox <- st_as_sfc(box)\nst_crs(box) <- 4326\n\nbox <- box %>%\n # To crs for NZGD49\n st_transform(27200)\n\ntile <- get_tiles(box, crop = TRUE, zoom = 16)\n\n\nggtile <- ggplot() +\n geom_spatraster_rgb(data = tile)\n\nggtile\n![\"Street](\"https://dieghernan.github.io/assets/img/blog/20220525_tile-1.webp\")
Here we have a crisp RGB tile of Maungawhau. Now, the next\nquestion is how to match the volcano dataset (a matrix) with this tile (a\ngeotagged map tile)? Let’s check it out.
Thanks to the terra package we can start converting volcano into a\nSpatRaster:
volcano_rast <- rast(volcano)\n\nterra::plot(volcano_rast)\n![\"Elevation](\"https://dieghernan.github.io/assets/img/blog/20220525_volcano_raster-1.webp\")
\n# Wait, it is flipped!\nvolcano_rast_ok <- rast(volcano[\n seq(nrow(volcano), 1, -1),\n seq(ncol(volcano), 1, -1)\n])\n\n# Much better!\nterra::plot(volcano_rast_ok)\n![\"Elevation](\"https://dieghernan.github.io/assets/img/blog/20220525_volcano_raster-2.webp\")
\nvolcano_rast_ok\n#> class : SpatRaster\n#> size : 87, 61, 1 (nrow, ncol, nlyr)\n#> resolution : 1, 1 (x, y)\n#> extent : 0, 61, 0, 87 (xmin, xmax, ymin, ymax)\n#> coord. ref. :\n#> source(s) : memory\n#> name : lyr.1\n#> min value : 94\n#> max value : 195\nNice! Now we have a raster of volcano, but still without geotagged\ninformation. Thanks to this article by Tomislav Hengl\n(\\@tom_hengl) we can check the basic geographic\nparameters of volcano (see Volcano\nMaungawhau), which are:
And we can translate that easily to an empty SpatRaster:
\n\n# Extra length for proper handling extent\nxrange <- range(seq(from = 2667400, length.out = 62, by = 10))\nyrange <- range(seq(from = 6478700, length.out = 88, by = 10))\n\ntemplate <- rast(\n crs = \"EPSG:27200\",\n xmin = xrange[1],\n xmax = xrange[2],\n ymin = yrange[1],\n ymax = yrange[2],\n resolution = 10\n)\ntemplate\n#> class : SpatRaster\n#> size : 87, 61, 1 (nrow, ncol, nlyr)\n#> resolution : 10, 10 (x, y)\n#> extent : 2667400, 2668010, 6478700, 6479570 (xmin, xmax, ymin, ymax)\n#> coord. ref. : NZGD49 / New Zealand Map Grid (EPSG:27200)\nSo now we only need to transfer the values from volcano_rast_ok to our\ntemplate:
# Use tidyterra to pull the values of one raster\n# and create a new layer\n\nvolcano2 <- template %>%\n mutate(elevation = pull(volcano_rast_ok, lyr.1)) %>%\n select(elevation)\n\nvolcano2\n#> class : SpatRaster\n#> size : 87, 61, 1 (nrow, ncol, nlyr)\n#> resolution : 10, 10 (x, y)\n#> extent : 2667400, 2668010, 6478700, 6479570 (xmin, xmax, ymin, ymax)\n#> coord. ref. : NZGD49 / New Zealand Map Grid (EPSG:27200)\n#> source(s) : memory\n#> name : elevation\n#> min value : 94\n#> max value : 195\n\nterra::plot(volcano2)\n![\"Georeferenced](\"https://dieghernan.github.io/assets/img/blog/20220525_create_volcano2-1.webp\")
\n# And plot it\nggtile +\n geom_spatraster(data = volcano2) +\n scale_fill_terrain_c(alpha = 0.75)\n![\"Street](\"https://dieghernan.github.io/assets/img/blog/20220525_create_volcano2-2.webp\")
The volcano dataset may not be completely up to date. As a complement,\ntidyterra includes a .tif file with the same dimensions as our volcano2\nraster, but with the topographic values extracted from Auckland LiDAR 1m DEM\n(2013) and\nresampled to a resolution of 5x5 meters, for package size optimization. See here\nhow to load it and check the plotting possibilities of tidyterra:
# Load out Easter Egg\n\nvolcano2_easter <- rast(system.file(\"extdata/volcano2.tif\",\n package = \"tidyterra\"\n))\n\nvolcano2_easter\n#> class : SpatRaster\n#> size : 174, 122, 1 (nrow, ncol, nlyr)\n#> resolution : 5, 5 (x, y)\n#> extent : 1756969, 1757579, 5917003, 5917873 (xmin, xmax, ymin, ymax)\n#> coord. ref. : NZGD2000 / New Zealand Transverse Mercator 2000 (EPSG:2193)\n#> source : volcano2.tif\n#> name : elevation\n#> min value : 76.262222\n#> max value : 195.554199\nterra::plot(volcano2_easter)\n![\"Elevation](\"https://dieghernan.github.io/assets/img/blog/20220525_easteregg-1.webp\")
\n\n# Only altitudes of more than 130m\n\nvolcano_filter <- volcano2_easter %>%\n filter(elevation > 130)\n\n\nggtile +\n geom_spatraster(data = volcano_filter) +\n scale_fill_viridis_c(na.value = NA, alpha = 0.7) +\n labs(fill = \"Elevation (m)\")\n![\"Street](\"https://dieghernan.github.io/assets/img/blog/20220525_easteregg-2.webp\")
\n\n# Contour lines\n\nggtile +\n geom_spatraster_contour(data = volcano2_easter, binwidth = 10)\n![\"Street](\"https://dieghernan.github.io/assets/img/blog/20220525_easteregg-3.webp\")
\n\n# Contour lines + contour polygons\n\nggtile +\n geom_spatraster_contour_filled(\n data = volcano2_easter,\n breaks = seq(70, 210, 20),\n alpha = 0.7\n ) +\n geom_spatraster_contour(\n data = volcano2_easter, binwidth = 2.5,\n alpha = 0.7, size = .2, color = \"grey10\"\n ) +\n coord_sf(expand = FALSE)\n![\"Street](\"https://dieghernan.github.io/assets/img/blog/20220525_easteregg-4.webp\")
In 1970, Harold D. Craft Jr. published his Ph.D. thesis “Radio observations of\nthe pulse profiles and dispersion measures of twelve pulsars”. The thesis (337\npages) includes on pages 214 to 216 the following depictions of successive\npulses of some pulsars:
\n\n![\"Three](\"https://dieghernan.github.io/assets/img/misc/pulsar_trio.webp\")
From “Radio Observations of the Pulse Profiles and Dispersion Measures of Twelve\nPulsars” by Harold D. Craft, Jr. (September 1970). Original source:\nhttps://blogs.scientificamerican.com/sa-visual/pop-culture-pulsar-origin-story-of-joy-division-s-unknown-pleasures-album-cover-video/
\n\nNine years later, a young graphic designer named Peter Saville had a new\nproject. He had to design the cover of the debut album of a young British rock\nband, named Joy Division. At some point in the process, Bernard Sumner (lead\nguitarist of Joy Division)1 found the following image in The Cambridge\nEncyclopaedia of Astronomy (1977 edition):
\n\n![\"Page](\"https://dieghernan.github.io/assets/img/misc/cp1919-joy-division.jpg\")
Saville presented a black-and-white version, producing a cover that reached\niconic status in the ’80s. This cover has been reproduced in the form of\ntattoos, clothing, merchandise, video games and even 3-D sculptures:
\n\n![\"Unknown](\"https://dieghernan.github.io/assets/img/misc/unknown_pleasures-cover.jpg\")
If you are interested in learning more about this fascinating history of science\nand design, you can read Pop Culture Pulsar: Origin Story of Joy\nDivision’s Unknown Pleasures Album\nCover\nby Jen\nChristiansen.
\n\nSince then, these kinds of plots have become very popular, known as ridge\nplots or joyplots, in honor of Joy Division. In this post, I produce\n“joyplots” with R for specific regions of the world using elevation data for\ncreating the ridges.
\n\nThis topic has already been covered by other authors, such as Daniel\nRedondo (Spanish) and\nTravis M.\nWhite.\nHowever, they both use QGIS, while in this post I work completely in\nR.
\n\nSome initial considerations we may need to bear in mind:
\n\nIn this post I will use geom_ridgeline() instead of\ngeom_density_ridges(). This gives us more control over the\nfinal plot, but there is a caveat: both the coordinates and the\nelevation should be in the same unit (See\nwhy).\nTherefore, we should project both the raster and the base sf object to a\nsuitable CRS defined in meters (in this case).
Joyplots are much cooler when only a few lines are displayed. This is\ndirectly related to the number of rows in our raster. A very detailed\nraster (e.g. lots of rows) would produce a much more detailed plot but it may not\nsuit our needs.
\nNow, let’s start with the required libraries:
\n\n\n# Libraries\n\n# Spatial\nlibrary(sf)\nlibrary(terra)\nlibrary(giscoR) # Shapes\nlibrary(elevatr)\n\n# Data viz and wrangling\nlibrary(ggplot2)\nlibrary(dplyr)\nlibrary(ggridges)\nThe first step consists of selecting our region of interest (sf object) and\nextracting the elevation data. We can achieve that with giscoR and\nelevatr.\nIn this post, I create a joyplot of\nAndalusia. Note that, given we are\ncreating just a visualization, the resolution of the sf object is not very\nrelevant.
\n# Select a Spanish Region: Andalucia\nregion <- gisco_get_nuts(nuts_id = \"ES61\") %>%\n # And project data\n st_transform(25830)\nNow we need to extract the elevation using elevatr. We can also adjust the\nzoom level as needed. You can find guidance on zoom levels in the\nOpenStreetMap wiki.
\n\n\ndem <- get_elev_raster(region, z = 7, clip = \"bbox\", expand = 10000) %>%\n # And convert to terra\n rast() %>%\n # Mask to the shape\n mask(vect(region))\n\n# Rename layer for further manipulation\nnames(dem) <- \"elev\"\n\nnrow(dem)\n#> [1] 698\n\nterra::plot(dem)\n![\"Elevation](\"https://dieghernan.github.io/assets/img/blog/20220501_andalucia_dem-1.webp\" "\\"plot")
We already have our elevation raster. Now the next step is to adjust the number\nof rows of our raster to a lower number. We can then aggregate the raster (i.e.\nreduce the number of cells or increase their size) using a scaling\nfactor that would reduce the number of rows to our desired target (in this case\n90 rows):
\n\n# Approx\nfactor <- round(nrow(dem) / 90)\n\ndem_agg <- aggregate(dem, factor)\n\nnrow(dem_agg)\n#> [1] 88\n\nterra::plot(dem_agg)\n![\"Elevation](\"https://dieghernan.github.io/assets/img/blog/20220501_andalucia_dem_agg-1.webp\" "\\"plot")
We can check how the number of rows has decreased. Also, the plot shows that we\nnow have fewer cells.
\n\nNow, we may need to perform additional manipulations on the values of the\nraster:
\n\nWe need to ensure that all valid values are greater than or equal to zero.
\nWe will replace the NA values produced when masking the raster with zeros. We\nwill use this later to decide whether to remove some parts of the\nplot.
After that, we create a data frame with the information needed for\ncreating the joyplot.
\n\n\ndem_agg[dem_agg < 0] <- 0\ndem_agg[is.na(dem_agg)] <- 0\n\ndem_df <- as.data.frame(dem_agg, xy = TRUE, na.rm = FALSE)\n\nas_tibble(dem_df)\n#> # A tibble: 12,848 x 3\n#> x y elev\n#> <dbl> <dbl> <dbl>\n#> 1 77184. 4306315. 0\n#> 2 81049. 4306315. 0\n#> 3 84914. 4306315. 0\n#> 4 88779. 4306315. 0\n#> 5 92644. 4306315. 0\n#> 6 96510. 4306315. 0\n#> 7 100375. 4306315. 0\n#> 8 104240. 4306315. 0\n#> 9 108105. 4306315. 0\n#> 10 111970. 4306315. 0\n#> # ... with 12,838 more rows\nNow is a good moment to adjust the units of the coordinates and the elevation if\nneeded. In this case both are in meters, but I will show you how to perform\nthose adjustments with the units package:
\n\n\nlibrary(units)\n\n# Units of DEM projection\nunits_crs <- st_crs(dem_agg)$units\n\nunits_crs\n#> [1] \"m\"\n\n# Example, convert to miles\n# Adjust as needed\n\ndem_miles <- dem_df %>%\n mutate(\n x = set_units(x, \"m\"),\n x_mile = set_units(x, \"mi\"),\n y = set_units(y, \"m\"),\n y_mile = set_units(y, \"mi\"),\n elev = set_units(elev, \"m\"),\n elev_mile = set_units(elev, \"mi\")\n )\n\nas_tibble(dem_miles)\n#> # A tibble: 12,848 x 6\n#> x y elev x_mile y_mile elev_mile\n#> [m] [m] [m] [mi] [mi] [mi]\n#> 1 77184. 4306315. 0 48.0 2676. 0\n#> 2 81049. 4306315. 0 50.4 2676. 0\n#> 3 84914. 4306315. 0 52.8 2676. 0\n#> 4 88779. 4306315. 0 55.2 2676. 0\n#> 5 92644. 4306315. 0 57.6 2676. 0\n#> 6 96510. 4306315. 0 60.0 2676. 0\n#> 7 100375. 4306315. 0 62.4 2676. 0\n#> 8 104240. 4306315. 0 64.8 2676. 0\n#> 9 108105. 4306315. 0 67.2 2676. 0\n#> 10 111970. 4306315. 0 69.6 2676. 0\n#> # ... with 12,838 more rows\nFinally, we can create our joyplot. Note that we can “train” the scales of our\nggplot to a spatial object automatically if we pass our region object into\nthe plot. The relative height of the ridges is controlled via the scale\nparameter:
\nggplot() +\n # Just for the scales, pass with NA arguments so it is not shown\n geom_sf(data = region, color = NA, fill = NA) +\n geom_ridgeline(\n data = dem_df, aes(\n x = x, y = y,\n group = y,\n height = elev\n ),\n scale = 25\n ) +\n theme_ridges()\n![\"Ridgeline](\"https://dieghernan.github.io/assets/img/blog/20220501_andalucia_ridges-1.webp\" "\\"plot")
The last step is to provide a black theme, resembling the cover of the album:
\n\n\nggplot() +\n geom_sf(data = region, color = NA, fill = NA) +\n geom_ridgeline(\n data = dem_df, aes(\n x = x, y = y,\n group = y,\n height = elev\n ),\n scale = 25,\n fill = \"black\",\n color = \"white\",\n size = .25\n ) +\n theme_void() +\n theme(plot.background = element_rect(fill = \"black\"))\n![\"Ridgeline](\"https://dieghernan.github.io/assets/img/blog/20220501_andalucia_joyplot-1.webp\" "\\"plot")
We can produce some variations of the same map using several parameters and\nother artifacts.
\n\ngeom_density_ridges()We can use geom_density_ridges() with stat=\"identity\" instead of\ngeom_ridgeline() for creating a similar map:
\nggplot() +\n geom_sf(data = region, color = NA, fill = NA) +\n geom_density_ridges(\n data = dem_df, aes(\n x = x, y = y,\n group = y,\n height = elev\n ),\n stat = \"identity\",\n scale = 25,\n fill = \"black\",\n color = \"white\",\n size = .25\n ) +\n theme_void() +\n theme(plot.background = element_rect(fill = \"black\"))\n![\"Ridgeline](\"https://dieghernan.github.io/assets/img/blog/20220501_andalucia_ridges_dens-1.webp\" "\\"plot")
If we use geom_ridgeline() it is quite easy to remove some parts of the lines,\nas the parameter min_height allows us to control the minimum height to be\nplotted. I found this much more difficult when using geom_density_ridges(),\nwhere the equivalent parameter rel_min_height is relative to the overall\nmaximum height.
This is the main reason why we replaced the NA values with zeros, so those\nparts of the string can be easily removed.
ggplot() +\n geom_sf(data = region, color = NA, fill = NA) +\n geom_ridgeline(\n data = dem_df, aes(\n x = x, y = y,\n group = y,\n height = elev\n ),\n scale = 25,\n fill = \"black\",\n color = \"white\",\n size = .25,\n min_height = 0.1\n ) +\n theme_void() +\n theme(plot.background = element_rect(fill = \"black\"))\n![\"Ridgeline](\"https://dieghernan.github.io/assets/img/blog/20220501_andalucia_landonly-1.webp\" "\\"plot")
We can apply different colors to the plot. Note that ggridges only accepts\ndifferent aes by row, not by column:
\n# Classify on three different bands\n\ndem_df <- dem_df %>%\n mutate(class = cut_number(y, n = 3))\n\nggplot() +\n geom_sf(data = region, color = NA, fill = NA) +\n geom_ridgeline(\n data = dem_df, aes(\n x = x, y = y,\n group = y,\n height = elev,\n color = class\n ),\n scale = 25,\n fill = \"black\",\n size = .5,\n show.legend = FALSE\n ) +\n theme_void() +\n theme(plot.background = element_rect(fill = \"black\")) +\n scale_color_manual(values = alpha(\n c(\n \"#007A33\",\n \"white\",\n \"#007A33\"\n ),\n .95\n ))\n![\"Ridgeline](\"https://dieghernan.github.io/assets/img/blog/20220501_andalucia_colors-1.webp\" "\\"plot")
For example, using an sf object:
\nhighres <- gisco_get_nuts(\n nuts_id = \"ES61\",\n resolution = 1\n) %>%\n # And project data\n st_transform(25830) %>%\n st_buffer(-5000)\n\nggplot() +\n geom_sf(data = highres, color = NA, fill = \"#007A33\", alpha = 0.95) +\n geom_ridgeline(\n data = dem_df, aes(\n x = x, y = y,\n group = y,\n height = elev\n ),\n scale = 25,\n fill = \"black\",\n color = \"white\",\n size = .25,\n min_height = 0.1\n ) +\n theme_void() +\n theme(plot.background = element_rect(fill = \"black\"))\n![\"Ridgeline](\"https://dieghernan.github.io/assets/img/blog/20220501_andalucia_combine-1.webp\" "\\"plot")
Or adding a frame to the plot:
\n\n\nframe <- as.polygons(dem_agg, extent = TRUE) %>%\n st_as_sf()\n\nggplot() +\n geom_sf(data = frame, color = \"lightblue\", fill = NA, size = 2) +\n geom_ridgeline(\n data = dem_df, aes(\n x = x, y = y,\n group = y,\n height = elev\n ),\n scale = 25,\n fill = \"black\",\n color = \"white\",\n size = .25\n ) +\n theme_void() +\n theme(plot.background = element_rect(fill = \"black\"))\n![\"Ridgeline](\"https://dieghernan.github.io/assets/img/blog/20220501_andalucia_frame-1.webp\" "\\"plot")
Other versions of the story credit drummer Stephen Morris for finding it. ↑
\nProject discontinued. This post reflects the situation in March 2022 and\nis preserved as a historical account, not current travel information.
\n\n![\"Animated](\"https://dieghernan.github.io/corona-atlas.de/assets/img/corona_atlas_timelapse.gif\")
In April 2021, my brother Diego and I saw\nthe need for a friendly and automated interface to the meticulous and ever-changing restrictions that the German authorities imposed on travel abroad amid the COVID crisis.
\n\nDespite the drastic variations in this regard that most foreign countries have experienced during the last year, the mild character of the currently predominant Omicron variant has finally led Germany to lift all\nCOVID-related obstacles to international travel. The long-awaited contemplation of an all-green world map has filled us with joy, but, to be honest, it has also rendered our website quite boring, no matter how many languages we have translated it into (6 as of now 🇩🇪 🇬🇧 🇪🇸 🇫🇷 🇵🇱 🇹🇷).
\n\nTo compensate for this, we have put all the pieces together to produce a chronology of the COVID crisis through the lenses of the Robert Koch Institut (RKI), the German entity that was responsible for COVID risk assessment of international areas. Most of the effort was already made, since we have been scraping RKI’s information (via scrapy) for almost one year. To complete the puzzle, we only needed to apply our method to the old risk assessment reports that had been issued before we started the project. That is, we have just combined our already developed scraping muscle with the\nArchive.org Wayback Machine as provided by\nEvan Sangaline, and we have of course worked around the inconsistencies of\nGerman bureaucracy.
\n\nAfter all, we hope that corona-atlas remains boring and that our world map remains green. Now it is finally time for quite some Wanderlust!
\n\nThis post is dedicated to Dominic Royé, AKA \\@dr_xeo
\n\nA common challenge when creating maps is how to include an inset map in your\nvisualization. An inset map is nothing more than a smaller map usually included\nin a corner that may provide additional context to the overall map. It is also\nuseful for representing spatial units that may form part of a country but whose\ngeographical location would result in an imperfect visualization, or for\nincluding small units that would otherwise not be shown on the map.
\n\nI have already covered this\nusing the base plot() function,\nbut this time I show how to produce these insets using the ggplot2 and\ntmap packages. In short: use the cowplot package.
In this example, I create a map of Spain using mapSpain and an inset for the\nCanary Islands.
\n\nThe “true” map of Spain is:
\n\nlibrary(mapSpain)\nlibrary(sf)\nlibrary(ggplot2)\nlibrary(dplyr)\n\nregions <- esp_get_ccaa(moveCAN = FALSE)\n\nggplot(regions) +\n geom_sf()\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20220303_truemap-1.webp\")
I use a different CRS for each part of Spain. In the case of mainland Spain, I\nuse ETRS89 / UTM 30N (EPSG:25830) and for the Canary\nIslands I use REGCAN95 / UTM 28N (EPSG:4083).
\n\nmain <- regions %>%\n filter(ccaa.shortname.es != \"Canarias\") %>%\n st_transform(25830)\n\nggplot(main) +\n geom_sf()\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20220303_mainsub-1.webp\")
\n\nisland <- regions %>%\n filter(ccaa.shortname.es == \"Canarias\") %>%\n st_transform(4083)\n\nggplot(island) +\n geom_sf()\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20220303_mainsub-2.webp\")
So that was easy! Just a couple of maps using ggplot2. Let’s start mixing and\nmatching!
\n\nWe have already created two quick maps with ggplot2. Now, to produce our map\nwith insets we will:
\n\nProduce two plots: the main plot and the subplot, providing a minimal style.\nWe will store them as ggplot objects.
Combine both objects with cowplot.
\n# Main plot\nmain_gg <- ggplot(main) +\n geom_sf() +\n theme_void() +\n theme(\n plot.background = element_rect(fill = \"grey85\", colour = NA),\n # Add a bit of margin on the bottom left\n # We will place the inset there\n plot.margin = margin(l = 80, b = 80)\n )\n\n# Sub plot\nsub_gg <- ggplot(island) +\n geom_sf() +\n theme_void() +\n # Add a border to the inset\n theme(\n panel.border = element_rect(fill = NA, colour = \"black\"),\n plot.background = element_rect(fill = \"grey95\")\n )\nWe have our objects in place, and now is when the magic happens! With cowplot,\nwe can combine both maps into a single one. You may need to play a bit with the\nparameters x, y, hjust and vjust of the subplot to improve the\nplacement:
library(cowplot)\n\nggdraw() +\n draw_plot(main_gg) +\n draw_plot(sub_gg,\n height = 0.2,\n x = -0.25,\n y = 0.08\n )\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20220303_insetggplot-1.webp\")
Note also that this approach is valid not only for maps, but for all types of\nplots produced by ggplot2, since this package is not specific to map\nobjects:
\n\n# Combining non-spatial plots\nlibrary(palmerpenguins)\n\nmass_flipper <- ggplot(\n data = penguins,\n aes(\n x = flipper_length_mm,\n y = body_mass_g\n )\n) +\n geom_point(\n aes(\n color = species,\n shape = species\n ),\n size = 3,\n alpha = 0.8\n ) +\n theme_minimal() +\n scale_color_manual(values = c(\"darkorange\", \"purple\", \"cyan4\"))\n\nflipper_hist <- ggplot(data = penguins, aes(x = flipper_length_mm)) +\n geom_histogram(aes(fill = species),\n alpha = 0.5,\n position = \"identity\",\n show.legend = FALSE\n ) +\n scale_fill_manual(values = c(\"darkorange\", \"purple\", \"cyan4\")) +\n theme_void() +\n theme(plot.background = element_rect(fill = \"white\"))\n\n\n# Nonsense plot!\nggdraw() +\n draw_plot(mass_flipper) +\n draw_plot(flipper_hist,\n scale = 0.25,\n y = 0.3,\n x = -0.2\n )\n![\"Scatter](\"https://dieghernan.github.io/assets/img/blog/20220303_insetggplot_nonsense-1.webp\")
We can follow a similar approach with tmap. In version 3.x.x (there is a\nnew revamped version under development),\nwe can use tmap_grob() to\nconvert the tmap objects to the objects that cowplot can handle.
library(tmap)\n\nmain_tmap <- tm_shape(main) +\n tm_polygons() +\n tm_layout(\n inner.margins = c(.3, .3, 0, 0),\n frame = FALSE\n )\n\n\nmain_tmap <- tmap_grob(main_tmap)\n\nsub_tmap <- tm_shape(island) +\n tm_polygons()\n\nsub_tmap <- tmap_grob(sub_tmap)\nOnce we have these new “grobs”, we can use the same approach as the one we\napplied to ggplot2 objects.
\n\nggdraw() +\n draw_plot(main_tmap) +\n draw_plot(sub_tmap,\n height = 0.3,\n x = -0.2\n )\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20220303_insettmap-1.webp\")
Timothée Giraud (AKA\n\\@rgeomatic), the developer of mapsf, also\nshared how to create inset maps using that package:
\n\nlibrary(mapsf)\n\nmf_map(main)\nmf_inset_on(island, pos = \"bottomright\", cex = .3)\nmf_map(island)\nbox(lwd = .5)\nmf_inset_off()\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20220303_insetmapsf-1.webp\")
On 27 Jan. 2022 my package rasterpic was accepted on\nCRAN (Hooray!). This package\ngeotags images, using a spatial object (from sf or terra) as a\ngeographic reference.
\n\nI tweeted about that, and it seems to have received good feedback from the\n#rspatial community:
\n\n\n\n#rspatial Do we need a package for using our own pictures as base maps? I don’t know, but anyway we have it! {rasterpic} 📦 is now on CRAN, and we can convert our pngs to spatial rasters like this https://t.co/fpoollARoN pic.twitter.com/l9o7rQwdgX
— dieghernan ن (@dhernangomez) January 27, 2022
I also received an interesting reply to this from Hefin Ioan Rhys\n@HRJ21:
\n\n\n\n\nOoh I think a map with countries filled with their own flag would be poppin'.
— Hefin Ioan Rhys (@HRJ21) January 28, 2022
That reminds me of a previous\npost that I wrote\nwhen I added some new functions to the cartography package, now replaced by\nthe mapsf package.
\n\nWith rasterpic, we now have an alternative tool for creating maps using\nimages, and this quick post shows you how to do it.
\n\nI will replicate the Africa map presented in my previous plot, but this time I\nwill use newer packages, such as\ngiscoR, and the development\nversion of ggspatial\n(not released yet), which adds support for SpatRaster objects in ggplot2.\nThe flags will be extracted from the GitHub repository\nhttps://github.com/hampusborgos/country-flags.
\n# Development version of ggspatial\n# devtools::install_github(\"paleolimbot/ggspatial\")\nlibrary(ggspatial)\nlibrary(ggplot2)\nlibrary(giscoR)\nlibrary(dplyr)\nlibrary(rasterpic)\n\n# For country names\nlibrary(countrycode)\n\nworld <- gisco_get_countries(epsg = 3857)\nafrica <- gisco_get_countries(region = \"Africa\", epsg = 3857)\n\n# Base map of Africa\nplot <- ggplot(world) +\n geom_sf(fill = \"grey90\") +\n theme_minimal() +\n theme(panel.background = element_rect(fill = \"lightblue\"))\n\nplot +\n # Zoom on Africa\n coord_sf(\n xlim = c(-2000000, 6000000),\n ylim = c(-4000000, 5000000)\n )\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20220128_africa-1.webp\" "\\"plot")
Now, let’s add the flags with a loop:
\n\n\n# We paste the ISO2 code to each African country\nafrica$iso2 <- countrycode(africa$ISO3_CODE, \"iso3c\", \"iso2c\")\n\n# Get flags from repo - low quality to speed up the code\nflagrepo <- \"https://raw.githubusercontent.com/hjnilsson/country-flags/master/png250px/\"\n\n# Loop and add\nfor (iso in africa$iso2) {\n # Download pic and plot\n imgurl <- paste0(flagrepo, tolower(iso), \".png\")\n tmpfile <- tempfile(fileext = \".png\")\n download.file(imgurl, tmpfile, quiet = TRUE, mode = \"wb\")\n\n # Raster\n x <- africa %>% filter(iso2 == iso)\n x_rast <- rasterpic_img(x, tmpfile, crop = TRUE, mask = TRUE)\n plot <- plot + layer_spatial(x_rast)\n}\n\nplot +\n geom_sf(data = africa, fill = NA) +\n # Zoom on Africa\n coord_sf(\n xlim = c(-2000000, 6000000),\n ylim = c(-4000000, 5000000)\n )\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20220128_flag-1.webp\" "\\"plot")
Project discontinued. This page documents a historical project; the\ndescriptions below refer to its period of operation.
\n\n![\"Corona](\"https://dieghernan.github.io/corona-atlas.de/assets/img/corona-atlas-icon.png\"){kind=icon}
Visit https://dieghernan.github.io/corona-atlas.de/
\n\nInteractive map of the international COVID-19 risk areas as designated by the German authorities.
\n\nDuring the project, data was updated periodically from the website of the Robert Koch Institute.
\n\nData scraping is performed in Python with\nscrapy.\nThe scraper also uses\npandas and\npycountry.
\n\nFor the prototype version, map visualization was created with R and\ngenerated via rmarkdown using\nleaflet,\ngiscoR and some packages included in\nthe tidyverse.\nFor the deployment, map logic has moved to JavaScript to support multiple languages.
\n\n\n", "date_published": "2021-04-30T00:00:00+02:00", "date_modified": "2026-10-07T00:00:00+02:00", "image": "https://dieghernan.github.io/corona-atlas.de/assets/img/og_corona_atlas.png", "summary": "Historical interactive map of international COVID-19 risk areas, based on assessments by the German authorities during the project’s operation.", "tags": ["discontinued","project","rstats","maps","leaflet","python","COVID19","rspatial","giscoR","javascript"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/projects/spain-munic-bot/", "url": "https://dieghernan.github.io/projects/spain-munic-bot/", "title": "spain-munic-bot", "content_html": "Project discontinued. This page documents a historical project; the\ndescriptions below refer to its period of operation.
\n\nI was a bot 🤖 that tweeted a random map of a Spanish municipality with its name, province and autonomous community (and an inset map of Spain showing the region and the community). I ran 🏃♀️ every 20 minutes.
\n\nCore packages used in the project are:
\n\nOther packages used are sf, dplyr and other common supporting packages.
\n", "date_published": "2021-01-29T00:00:00+01:00", "date_modified": "2026-10-07T00:00:00+02:00", "image": "https://dieghernan.github.io/spain-munic-bot/assets/img/sample.png", "summary": "Archived maps of buildings and urban growth in Spanish municipalities, generated with R. Automated posting is disabled.", "tags": ["discontinued","project","rstats","maps","twitter","rspatial","mapSpain","tmap"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/projects/leaflet-providersESP/", "url": "https://dieghernan.github.io/projects/leaflet-providersESP/", "title": "Leaflet-providersESP", "content_html": "Leaflet-providersESP is a plugin for Leaflet that\ncontains configurations for various tile layers provided by public agencies in\nSpain.
\n\n![\"DOI\"](\"https://zenodo.org/badge/DOI/10.5281/zenodo.4318010.svg\"){kind=icon}
Full docs and examples are available at\nhttps://dieghernan.github.io/leaflet-providersESP/.
\n\nThis code generates a Leaflet map with a layer provided by\nLeaflet-providersESP.
\n\n<!DOCTYPE html>\n<html lang=\"en\">\n <head>\n <meta charset=\"utf-8\" />\n <title>Minimal page | leaflet-providersESP</title>\n <meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\" />\n <!-- Load Leaflet -->\n <link\n rel=\"stylesheet\"\n href=\"https://unpkg.com/leaflet@1.7.1/dist/leaflet.css\"\n />\n <script src=\"https://unpkg.com/leaflet@1.7.1/dist/leaflet.js\"></script>\n <!-- Install leaflet-providersESP -->\n <script src=\"https://cdn.jsdelivr.net/gh/dieghernan/leaflet-providersESP/dist/leaflet-providersESP.min.js\"></script>\n <!-- Display map full page -->\n <style>\n html {\n height: 100%;\n }\n body {\n height: 100%;\n margin: 0;\n padding: 0;\n }\n #mapid {\n height: 100%;\n width: 100%;\n }\n </style>\n </head>\n <body>\n <!-- Create map -->\n <div id=\"mapid\"></div>\n <!-- Puerta del Sol - IDErioja server -->\n <script>\n var mymap = L.map(\"mapid\").setView([40.4166, -3.70384], 18);\n L.tileLayer.providerESP(\"IDErioja\").addTo(mymap);\n </script>\n </body>\n</html>\n\n Open the map in a full window\n Documentation\n
\n\n\n", "date_published": "2020-10-26T00:00:00+01:00", "image": "https://dieghernan.github.io/assets/img/misc/leaflet-providersesp.png", "summary": "Leaflet plugin for adding WMS/WMTS provided by public agencies in Spain.", "tags": ["project","maps","leaflet"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/202004_headtails/", "url": "https://dieghernan.github.io/202004_headtails/", "title": "Head/tail breaks in the classInt package", "content_html": "\n\n\nThere are far more ordinary people (say, 80 percent) than extraordinary people (say, 20 percent), and this is often characterized by the 80/20 principle, based on the observation made by the Italian economist Vilfredo Pareto in 1906 that 80% of land in Italy was owned by 20% of the population. A histogram of the data values for these phenomena would reveal a right-skewed or heavy-tailed distribution. How to map the data with the heavy-tailed distribution?
\n \n
This vignette discusses the implementation of the “Head/tail breaks” style\n(Jiang (2013)) in the classIntervals() function from the classInt package.\nA step-by-step example is presented to clarify the method. A case study using\nspData::afcon is also included, making use of additional packages such as\nsf.
Historical example: The mapping examples use cartography, which is now\nin maintenance mode. Its maintainers recommend mapsf\nfor new work. The original code and outputs are preserved and have not been\nrevalidated against current package versions.
\n\nHead/tail breaks is a classification scheme introduced by Jiang (2013) for\nrevealing hierarchies in data with many small values and a few large ones.\nThe related ht-index measures the depth of this hierarchy, rather than\nbeing another name for the classification method.
\n\nThe distributions considered here are strongly right-skewed, with a minority\nof large values in the head and a majority of small values in the tail. This\nimbalance can be expressed as “far more small things than large things”.
\n\nPower-law and lognormal distributions are examples of heavy-tailed\ndistributions. The head/tail breaks literature also considers exponential\ndistributions under its broader description of this imbalance. Nature,\nsociety and finance (Vasicek (2002)) provide examples of rare and extreme\nevents. Taleb (2008) discusses the impact of unexpected extreme events,\noffering another reason to pay attention to low-frequency observations.
\n\nlibrary(classInt)\n\n# 1. Characterization of heavy-tail distributions----\nset.seed(1234)\n# Pareto distribution a=1 b=1.161 n=1000\nsample_par <- 1 / (1 - runif(1000))^(1 / 1.161)\nopar <- par(no.readonly = TRUE)\npar(mar = c(2, 4, 3, 1), cex = 0.8)\nplot(\n sort(sample_par, decreasing = TRUE),\n type = \"l\",\n ylab = \"F(x)\",\n xlab = \"\",\n main = \"80/20 principle\"\n)\nabline(\n h = quantile(sample_par, .8),\n lty = 2,\n col = \"red3\"\n)\nabline(\n v = 0.2 * length(sample_par),\n lty = 2,\n col = \"darkblue\"\n)\nlegend(\n \"topleft\",\n legend = c(\"F(x): p80\", \"x: Top 20%\"),\n col = c(\"red3\", \"darkblue\"),\n lty = 2,\n cex = 0.8\n)\n\nhist(\n sample_par,\n n = 100,\n xlab = \"\",\n main = \"Histogram\",\n col = \"grey50\",\n border = NA,\n probability = TRUE\n)\npar(opar)\n![\"Ranked-value](\"https://dieghernan.github.io/assets/img/blog/20200405_charheavytail-1.webp\")
![\"Histogram](\"https://dieghernan.github.io/assets/img/blog/20200405_charheavytail-2.webp\")
The method itself consists of a four-step process performed recursively until a\nstopping condition is satisfied. Given a vector of values \\(v = (a_1, a_2,\n..., a_n)\\), the process can be described as follows:
\n\nTRUE and the head contains at least two observations, replace\n\\(v\\) with \\(head\\) and repeat. Otherwise, stop.Only values strictly above the mean enter the next iteration. Values equal to\nthe mean are not part of the head. Stopping does not require an exact 50/50\nsplit.
\n\nA threshold of 40% provides a practical stopping rule. It is not a statistical\ntest for whether a distribution is heavy-tailed.
\n\nThe final breaks are the vector of consecutive \\(\\mu\\):
\n\n[breaks = (\\mu_1, \\mu_2, \\mu_3, …, \\mu_n )]
\n\nWe reproduce here the pseudo-code1 as per Jiang (2019):
\n\nRecursive function Head/tail Breaks:\n Rank the input data from the largest to the smallest\n Break the data into the head and the tail around the mean;\n // the head for those above the mean\n // the tail for those below the mean\n While (head <= 40%):\n Head/tail Breaks (head);\nEnd Function\nThe following R example uses prop < thr, whereas the pseudocode above\nuses head <= 40%. At exactly 40%, the R loop stops and the pseudocode\ncontinues. This distinction does not affect the example below.
opar <- par(no.readonly = TRUE)\npar(mar = c(2, 2, 3, 1), cex = 0.8)\nvar <- sample_par\nthr <- .4\nbrks <- c(min(var), max(var)) # Initialise with min and max\n\nsum_table <- data.frame(\n iter = 0,\n mu = NA,\n prop = NA,\n n_var = NA,\n n_head = NA\n)\n# Pars for chart\nlimchart <- brks\n# Iteration\nfor (i in 1:10) {\n mu <- mean(var)\n brks <- sort(c(brks, mu))\n head <- var[var > mu]\n prop <- length(head) / length(var)\n stopit <- prop < thr & length(head) > 1\n sum_table <- rbind(\n sum_table,\n c(i, mu, prop, length(var), length(head))\n )\n hist(\n var,\n main = paste0(\"Iter \", i),\n breaks = 50,\n col = \"grey50\",\n border = NA,\n xlab = \"\",\n xlim = limchart\n )\n abline(v = mu, col = \"red3\", lty = 2)\n ylabel <- max(hist(var, breaks = 50, plot = FALSE)$counts)\n labelplot <- paste0(\"PropHead: \", round(prop * 100, 2), \"%\")\n text(\n x = mu,\n y = ylabel,\n labels = labelplot,\n cex = 0.8,\n pos = 4\n )\n legend(\n \"right\",\n legend = paste0(\"mu\", i),\n col = c(\"red3\"),\n lty = 2,\n cex = 0.8\n )\n if (isFALSE(stopit)) {\n break\n }\n var <- head\n}\npar(opar)\n![\"Histogram](\"https://dieghernan.github.io/assets/img/blog/20200405_stepbystep-1.webp\")
![\"Histogram](\"https://dieghernan.github.io/assets/img/blog/20200405_stepbystep-2.webp\")
![\"Histogram](\"https://dieghernan.github.io/assets/img/blog/20200405_stepbystep-3.webp\")
![\"Histogram](\"https://dieghernan.github.io/assets/img/blog/20200405_stepbystep-4.webp\")
The head proportion varies across iterations and reaches 50% in the fourth,\nwhich stops the loop. It does not increase monotonically.
\n\n| iter | \nmu | \nprop | \nn_var | \nn_head | \n
|---|---|---|---|---|
| 1 | \n5.6755 | \n14.5% | \n1000 | \n145 | \n
| 2 | \n27.2369 | \n21.38% | \n145 | \n31 | \n
| 3 | \n85.1766 | \n19.35% | \n31 | \n6 | \n
| 4 | \n264.7126 | \n50% | \n6 | \n3 | \n
The break vector includes the original minimum and maximum, plus the means\ncomputed during the iterations. Here the original data are sample_par, since\nvar is replaced by the head inside the loop.
The implementation in classIntervals() reproduces these results:
ht_sample_par <- classIntervals(sample_par, style = \"headtails\")\nbrks == ht_sample_par$brks\n## [1] TRUE TRUE TRUE TRUE TRUE TRUE\nAs stated in Jiang (2013), the number of breaks is determined by the data.\nHowever, the thr parameter can help adjust the final number. A lower value\nof thr can yield fewer breaks, while a larger thr can increase the number if\nthe underlying distribution follows the “far more small things than large\nthings” principle.
opar <- par(no.readonly = TRUE)\npar(mar = c(2, 2, 2, 1), cex = 0.8)\n\npal1 <- c(\"wheat1\", \"wheat2\", \"red3\")\n# Minimum: single break\nprint(paste(\"number of breaks\", length(classIntervals(sample_par, style = \"headtails\", thr = 0)$brks - 1)))\nplot(\n classIntervals(sample_par, style = \"headtails\", thr = 0),\n pal = pal1,\n main = \"thr = 0\"\n)\n\n# Two breaks\nprint(paste(\"number of breaks\", length(classIntervals(sample_par, style = \"headtails\", thr = 0.2)$brks - 1)))\nplot(\n classIntervals(sample_par, style = \"headtails\", thr = 0.2),\n pal = pal1,\n main = \"thr = 0.2\"\n)\n\n# Default breaks: 0.4\nprint(paste(\"number of breaks\", length(classIntervals(sample_par, style = \"headtails\")$brks - 1)))\nplot(classIntervals(sample_par, style = \"headtails\"),\n pal = pal1,\n main = \"thr = Default\"\n)\n\n# Maximum breaks\nprint(paste(\"number of breaks\", length(classIntervals(sample_par, style = \"headtails\", thr = 1)$brks - 1)))\nplot(\n classIntervals(sample_par, style = \"headtails\", thr = 1),\n pal = pal1,\n main = \"thr = 1\"\n)\npar(opar)\n![\"Cumulative](\"https://dieghernan.github.io/assets/img/blog/20200405_examplesimp-1.webp\")
![\"Cumulative](\"https://dieghernan.github.io/assets/img/blog/20200405_examplesimp-2.webp\")
![\"Cumulative](\"https://dieghernan.github.io/assets/img/blog/20200405_examplesimp-3.webp\")
![\"Cumulative](\"https://dieghernan.github.io/assets/img/blog/20200405_examplesimp-4.webp\")
For this example, even thr = 0 retains the mean as an internal break.\nThe returned vector also contains the minimum and maximum, so this gives two\nclasses, not one.
Jiang (2013) states that \"the new classification scheme is more natural than\nthe natural breaks in finding the groupings or hierarchy for data with a\nheavy-tailed distribution.\" (p. 482), referring to Jenks’ natural breaks\nmethod. In this case study, we compare headtails vs. fisher, which is the\nalias for the Fisher-Jenks algorithm and is always preferred to the jenks\nstyle (see ?classIntervals). For this example, we will use the afcon\ndataset from the spData package, plus some additional spatial information to\ncreate the data visualization.
library(spData)\ndata(afcon, package = \"spData\")\nLet’s have a look at the top 10 values and the distribution of the variable\ntotcon (index of total conflict 1966-78):
# Top10\nknitr::kable(head(afcon[order(afcon$totcon, decreasing = TRUE), c(\"name\", \"totcon\")], 10))\n\nopar <- par(no.readonly = TRUE)\npar(mar = c(4, 4, 3, 1), cex = 0.8)\nhist(afcon$totcon,\n n = 20,\n main = \"Histogram\",\n xlab = \"totcon\",\n col = \"grey50\",\n border = NA,\n)\nplot(\n density(afcon$totcon),\n main = \"Distribution\",\n xlab = \"totcon\",\n)\npar(opar)\n![\"Histogram](\"https://dieghernan.github.io/assets/img/blog/20200405_summspdata-1.webp\")
![\"Density](\"https://dieghernan.github.io/assets/img/blog/20200405_summspdata-2.webp\")
The values for Egypt (EG) and Sudan (SU) stand out from the rest. The histogram\nshows a strongly right-skewed pattern with many small values and a few large\nones.
\n\nIn addition to headtails and fisher, we use quantile to compare the\nclassification styles. Quantile breaks are based on ranks rather than the\nsize of the gaps between observations.
Applying the three aforementioned methods to break the data:
\n\nbrks_ht <- classIntervals(afcon$totcon, style = \"headtails\")\nprint(brks_ht)\n# Same number of classes for \"fisher\"\nnclass <- length(brks_ht$brks) - 1\nbrks_fisher <- classIntervals(afcon$totcon,\n style = \"fisher\",\n n = nclass\n)\nprint(brks_fisher)\n\nbrks_quantile <- classIntervals(afcon$totcon,\n style = \"quantile\",\n n = nclass\n)\nprint(brks_quantile)\n\npal1 <- c(\"wheat1\", \"wheat2\", \"red3\")\nopar <- par(no.readonly = TRUE)\npar(mar = c(2, 2, 2, 1), cex = 0.8)\nplot(brks_ht, pal = pal1, main = \"headtails\")\nplot(brks_fisher, pal = pal1, main = \"fisher\")\nplot(brks_quantile, pal = pal1, main = \"quantile\")\npar(opar)\n![\"Cumulative](\"https://dieghernan.github.io/assets/img/blog/20200405_breaksample-1.webp\")
![\"Cumulative](\"https://dieghernan.github.io/assets/img/blog/20200405_breaksample-2.webp\")
![\"Cumulative](\"https://dieghernan.github.io/assets/img/blog/20200405_breaksample-3.webp\")
The top three classes of headtails contain five observations, whereas those\nof fisher contain 13. In this example, headtails gives more detail at the\nupper end of the distribution.
The next plot compares density estimates of the rescaled totcon values and\nthe class assignments from each method. The original values are rescaled to\n[1, nclass] and shifted by -0.5 for the visual comparison.
# Helper function to reescale values\nhelp_reescale <- function(x, min = 1, max = 10) {\n r <- (x - min(x)) / (max(x) - min(x))\n r <- r * (max - min) + min\n return(r)\n}\nafcon$ecdf_class <- help_reescale(afcon$totcon,\n min = 1 - 0.5,\n max = nclass - 0.5\n)\nafcon$ht_breaks <- cut(afcon$totcon,\n brks_ht$brks,\n labels = FALSE,\n include.lowest = TRUE\n)\n\nafcon$fisher_breaks <- cut(afcon$totcon,\n brks_fisher$brks,\n labels = FALSE,\n include.lowest = TRUE\n)\n\nafcon$quantile_break <- cut(afcon$totcon,\n brks_quantile$brks,\n labels = FALSE,\n include.lowest = TRUE\n)\n\nopar <- par(no.readonly = TRUE)\npar(mar = c(4, 4, 1, 1), cex = 0.8)\nplot(\n density(afcon$ecdf_class),\n ylim = c(0, 0.8),\n lwd = 2,\n main = \"\",\n xlab = \"class\"\n)\nlines(density(afcon$ht_breaks), col = \"darkblue\", lty = 2)\nlines(density(afcon$fisher_breaks), col = \"limegreen\", lty = 2)\nlines(density(afcon$quantile_break),\n col = \"red3\",\n lty = 2\n)\nlegend(\"topright\",\n legend = c(\n \"Continuous\", \"headtails\",\n \"fisher\", \"quantile\"\n ),\n col = c(\"black\", \"darkblue\", \"limegreen\", \"red3\"),\n lwd = c(2, 1, 1, 1),\n lty = c(1, 2, 2, 2),\n cex = 0.8\n)\npar(opar)\n![\"Density](\"https://dieghernan.github.io/assets/img/blog/20200405_benchmarkbreaks-1.webp\")
In this example, the class assignments from headtails retain more of the\noriginal imbalance. By contrast, quantile aims for similar numbers of\nobservations per class, regardless of the gaps between values.
We now compare the methods using proportional-symbol maps. Symbol size\nrepresents totcon, while color distinguishes the classes.
The first map uses proportional symbols without class-based colors, providing\na reference for the three classified maps.
\n\nlibrary(sf)\nlibrary(giscoR)\nlibrary(cartography)\n\nopar <- par(no.readonly = TRUE)\n\npar(\n mfrow = c(2, 2),\n mar = c(1, 1, 1, 1),\n bg = \"white\"\n)\nafrica <- gisco_get_countries(resolution = 60, region = \"Africa\", epsg = 3857)\n\nafcon.sf <- st_as_sf(afcon, crs = 4326, coords = c(\"x\", \"y\"))\nafcon.sf <- st_transform(afcon.sf, st_crs(africa))\n# afcon.sf <- st_join(africa[, \"admin\"], afcon.sf)\nafcon.sf <- afcon.sf[order(afcon.sf$totcon), ]\n\n\n\n# High granularity map\nplot(st_geometry(africa), col = \"grey80\", border = NA)\npropSymbolsLayer(\n afcon.sf,\n var = \"totcon\",\n inches = 0.2,\n col = adjustcolor(\"grey10\", alpha.f = 0.5),\n border = NA\n)\ntitle(main = \"High granularity map\")\n\n# Quantile\n\npal <- hcl.colors(5, palette = \"inferno\", alpha = 0.6)\nplot(st_geometry(africa), col = \"grey80\", border = NA)\npropSymbolsTypoLayer(\n afcon.sf,\n var = \"totcon\",\n inches = 0.2,\n col = pal,\n border = NA,\n legend.var.pos = \"n\",\n legend.var2.pos = \"bottomleft\",\n var2 = \"quantile_break\"\n)\ntitle(main = \"Quantile\")\n\n\n# Fisher\nplot(st_geometry(africa), col = \"grey80\", border = NA)\npropSymbolsTypoLayer(\n afcon.sf,\n var = \"totcon\",\n inches = 0.2,\n col = pal,\n border = NA,\n legend.var.pos = \"n\",\n legend.var2.pos = \"bottomleft\",\n var2 = \"fisher_breaks\"\n)\ntitle(main = \"Fisher\")\n\n# Head Tails\nplot(st_geometry(africa), col = \"grey80\", border = NA)\npropSymbolsTypoLayer(\n afcon.sf,\n var = \"totcon\",\n inches = 0.2,\n col = pal,\n border = NA,\n legend.var.pos = \"n\",\n legend.var2.pos = \"bottomleft\",\n var2 = \"ht_breaks\"\n)\ntitle(main = \"Head Tails\")\npar(opar)\n![\"Four](\"https://dieghernan.github.io/assets/img/blog/20200405_finalplot-1.webp\")
Compared with the unclassified proportional-symbol map, headtails makes\nthe most extreme values easier to distinguish. The quantile style groups\nobservations by rank, while fisher provides an intermediate view in this\nexample.
It is also important to note that headtails and fisher reveal different\ninformation that can be useful depending on the context. While headtails\nhighlights the outliers, it fails to provide good clustering on the tail, while\nfisher seems to reflect these patterns better. This can be observed in the\nvalues of Western Africa and the Niger River Basin, where headtails does not\nhighlight any special cluster of conflicts, while fisher suggests a\npotential cluster consistent with the unclassified map. This can be\nconfirmed in the histogram generated previously, where a concentration of\ntotcon around 1,000 is visible.
The method implemented in classInt corresponds to head/tail breaks\n1.0, as named in this article. ↑
\nProject discontinued. This page documents a historical project; the\ndescriptions below refer to its period of operation.
\n\nThe microsite documented the impact of COVID-19 in Spain with maps and official data.
\n\nhttps://dieghernan.github.io/COVID19\n[In Spanish]
\n\n![\"Animation](\"https://dieghernan.github.io/COVID19/assets/Fallecidos.gif\")
Overall deaths in Spain due to COVID-19: evolution
\n", "date_published": "2020-04-04T00:00:00+02:00", "date_modified": "2026-10-07T00:00:00+02:00", "image": "https://dieghernan.github.io/COVID19/assets/img/header.png", "summary": "Historical maps and charts of processed COVID-19 data for Spain, preserved as an archive of the discontinued project.", "tags": ["discontinued","project","rstats","maps","sf","COVID19"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/202002_cartography1/", "url": "https://dieghernan.github.io/202002_cartography1/", "title": "New features in the cartography package", "content_html": "This document describes the new features added to cartography in version\n2.4.0 by\ndieghernan and already available on CRAN.
Historical example: The mapping examples use cartography, which is now\nin maintenance mode. Its maintainers recommend mapsf\nfor new work. The original code and outputs are preserved and have not been\nrevalidated against current package versions.
\n\nThose new features are:
\n\nhatchedLayer and legendHatched functions.pngLayer and getPngLayer functions.wordcloudLayer function.These functions don’t handle sp objects on purpose, favoring sf instead.
#install.packages(\"cartography\")\nlibrary(cartography)\npackageVersion(\"cartography\")\n## [1] '3.0.0'\nThis is a way to create typology or choropleth maps using hatching. It is\nparticularly useful for maps that need to be printed in black and white, such\nas academic papers. These maps are also useful for representing overlapping\ndimensions.
\n\nlibrary(sf)\nlibrary(jsonlite)\nlibrary(dplyr)\n\n#Shape\ncntries = st_read(\"https://ec.europa.eu/eurostat/cache/GISCO/distribution/v2/countries/geojson/CNTR_RG_20M_2016_3035.geojson\",\n stringsAsFactors = FALSE)\n## Reading layer `CNTR_RG_20M_2016_3035' from data source `https://ec.europa.eu/eurostat/cache/GISCO/distribution/v2/countries/geojson/CNTR_RG_20M_2016_3035.geojson' using driver `GeoJSON'\n## Simple feature collection with 257 features and 6 fields\n## Geometry type: MULTIPOLYGON\n## Dimension: XY\n## Bounding box: xmin: -7142317 ymin: -9160665 xmax: 16932290 ymax: 15428010\n## Projected CRS: ETRS89-extended / LAEA Europe\n\n# Include trade blocks\ndf <- fromJSON(\"https://raw.githubusercontent.com/dieghernan/Country-Codes-and-International-Organizations/master/outputs/Countrycodesfull.json\")\nISO_memcol <- function(df,\n orgtosearch) {\n ind <- match(orgtosearch, unlist(df[1, \"org_id\"]))\n or <- lapply(1:nrow(df), function(x)\n unlist(df[x, \"org_member\"])[ind])\n or <- data.frame(matrix(unlist(or)), stringsAsFactors = F)\n names(or) <- orgtosearch\n df2 <- as.data.frame(cbind(df, or, stringsAsFactors = F))\n return(df2)\n}\ndf <- ISO_memcol(df, \"EU\")\ndf <- ISO_memcol(df, \"EFTA\")\ndf <- ISO_memcol(df, \"EuroArea\")\n\n\ncntries = merge(cntries,\n df,\n by.x = \"ISO3_CODE\",\n by.y = \"ISO_3166_3\",\n all.x = TRUE)\n\nlibrary(cartography)\n\n\n#Limits EU\n#Plot base map\nplot(\n st_geometry(cntries),\n xlim = c(2200000, 7150000),\n ylim = c(1380000, 5500000),\n)\nplot(st_geometry(cntries), add = TRUE)\nplot(st_geometry(cntries[!is.na(cntries$EU),]), col = \"grey60\", add = TRUE)\nplot(st_geometry(cntries[!is.na(cntries$EFTA),]), col = \"black\", add = TRUE)\n#Add hatching\nhatchedLayer(\n cntries[!is.na(cntries$EuroArea),],\n pattern = \"right2left\",\n col = \"white\",\n density = 3,\n add = TRUE\n)\nlegendTypo(\n \"topright\",\n title.txt = \"\",\n categ = c(\"EU\", \"EFTA\"),\n col = c(\"grey60\", \"black\"),\n nodata = FALSE\n)\n\nlegendHatched(\n \"right\",\n title.txt = \"Within EU\",\n categ = \"Euro\\nArea\",\n patterns = \"right2left\",\n frame = TRUE\n)\nlayoutLayer(\n title = \"European Trade Blocks\",\n theme = \"grey.pal\",\n sources = \"© EuroGeographics for the administrative boundaries.\",\n author = paste0(\"cartography \", packageVersion(\"cartography\")),\n scale = 500,\n frame = TRUE\n)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20200217_hatched-min-1.webp\")
library(sf)\nlibrary(cartography)\n\n# Plot World\nplot(\n cntries$geometry,\n col = \"white\",\n xlim = c(2200000, 7150000),\n ylim = c(1380000, 5500000),\n)\n#Add layers for non european area - left2right\nNOEUR = subset(cntries, CONTINENT.EN != \"Europe\" | is.na(CONTINENT.EN))\nhatchedLayer(\n NOEUR,\n pattern = \"left2right\",\n add = TRUE,\n #Basic usage\n density = 2,\n #Densify default grid\n lwd = 1.2,\n lty = 3,\n col = \"grey50\"\n) #Formatting\n\n#Extract Europe Regions\nEUR = subset(cntries, CONTINENT.EN == \"Europe\" & SUBREGION.EN != \"Western Asia\")[, \"SUBREGION.EN\"]\nlevels <- sort(unique(EUR$SUBREGION.EN))\n\n\n#Plot Regions\n# First element with zigzag\nhatchedLayer(EUR[EUR$SUBREGION.EN == levels[1], ],\n add = TRUE,\n density = 4,\n pattern = \"zigzag\")\n\n#dot with parms\nhatchedLayer(\n EUR[EUR$SUBREGION.EN == levels[2], ],\n add = TRUE,\n pattern = \"dot\",\n pch = 4,\n cex = 0.5,\n density = 3.5)\n\n#vertical\nhatchedLayer(EUR[EUR$SUBREGION.EN == levels[3], ],\n add = TRUE,\n pattern = \"vertical\",\n density = 3)\n\n#another dot\nhatchedLayer(EUR[EUR$SUBREGION.EN == levels[4], ],\n add = TRUE,\n pattern = \"dot\",\n pch= 15,\n density = 3.5)\n\n#create legend\nlegendHatched(\n pos = \"topright\",\n title.txt = \"\",\n title.cex = 0.1,\n categ = c(levels, \"Others\"),\n patterns = c(\"zigzag\",\n \"dot\",\n \"vertical\",\n \"dot\",\n \"left2right\"),\n pch = c(4,15),\n lty = c(1, 1, 3),\n col = c(rep(\"black\", length(levels)), \"grey50\"),\n frame = TRUE\n)\n\nlayoutLayer(\n title = \"Regions of Europe (United Nations)\",\n theme = \"grey.pal\",\n sources = \"© EuroGeographics for the administrative boundaries.\",\n author = paste0(\"cartography \", packageVersion(\"cartography\")),\n scale = 500,\n frame = TRUE\n)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20200217_hatched-1.webp\")
legendHatched honors the order of the parameters. In this case, two dot\npatterns are present, so pch = c(4,15) takes care of that. Note that three\nline-type patterns are also plotted, as in the previous case, and lty = c(1,\n1, 3) respects that order.
hatchedLayer could also be useful for plotting several dimensions on the same map, in combination with another function of the package.
\nlibrary(sf)\nlibrary(cartography)\n\n\n\n#Warsaw Pact - roughly mapped via UN Region\nwp <- subset(cntries, SUBREGION.EN == \"Eastern Europe\")\n\n#European Union - after Brexit\neu <- subset(cntries, !is.na(EU))\n\n#Euro Area\nea <- subset(cntries, !is.na(EuroArea))\n\n#Flags for plotting\nflag = ifelse(cntries$ISO3_CODE %in% eu$ISO3_CODE,\n \"European Union\",\n cntries$CONTINENT.EN)\n\n\nflag = ifelse(!flag %in% c(\"Europe\", \"European Union\"), \"Other\",\n flag)\ncntries$flag <- flag\n\n\n\n#Plot lims\nplot(\n st_geometry(cntries),\n xlim = c(2200000, 7150000),\n ylim = c(1380000, 5500000)\n)\n\n\n#Combine with typoLayer\ntypoLayer(\n x = cntries,\n var = \"flag\",\n legend.pos = \"n\",\n legend.values.order = c(\"European Union\",\n \"Europe\",\n \"Other\"),\n col = c(\"#A6BDDB\",\n \"#FEFEE9\",\n \"#E0E0E0\"),\n add = TRUE\n)\n\n#hatching\nhatchedLayer(\n x = ea,\n pattern = \"left2right\",\n cellsize = 100000,\n add = TRUE\n)\n\nhatchedLayer(\n x = wp,\n pattern = \"vertical\",\n col=\"red\",\n cellsize = 75000,\n add = TRUE\n)\n\n#Legend\nlegendHatched(\n pos = \"right\",\n title.txt = \"Economic Region\",\n categ = c(\n \"Euro Area\",\n \"Former \\nWarsaw Pact\",\n \"European Union\",\n \"Europe\",\n \"Other\"\n ),\n patterns = c(\"left2right\", \"vertical\"),\n col = c(\"black\", \"red\", \"#A6BDDB\",\n \"#FEFEE9\",\n \"#E0E0E0\"),\n ptrn.bg = c(\"white\", \"white\", \"#A6BDDB\",\n \"#FEFEE9\",\n \"#E0E0E0\"),\n frame = TRUE\n)\n\nlayoutLayer(\n title = \"European Countries - Blocks\",\n theme = \"blue.pal\",\n sources = \"© EuroGeographics for the administrative boundaries.\",\n author = paste0(\"cartography \", packageVersion(\"cartography\")),\n scale = 500,\n frame = TRUE\n)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20200217_hatched-adv-1.webp\")
This new capability geotags a .png file, effectively converting the image into a tile. This allows the user to create visual maps by masking an image to the shape of a POLYGON/MULTIPOLYGON.
For high-quality PNG maps, it is recommended to plot your map on an SVG\ngraphics device.
\n\nlibrary(sf)\nlibrary(cartography)\n\ncntries2 = st_read(\"https://ec.europa.eu/eurostat/cache/GISCO/distribution/v2/countries/geojson/CNTR_RG_20M_2016_3857.geojson\",\n stringsAsFactors = FALSE)\n## Reading layer `CNTR_RG_20M_2016_3857' from data source `https://ec.europa.eu/eurostat/cache/GISCO/distribution/v2/countries/geojson/CNTR_RG_20M_2016_3857.geojson' using driver `GeoJSON'\n## Simple feature collection with 257 features and 6 fields\n## Geometry type: MULTIPOLYGON\n## Dimension: XY\n## Bounding box: xmin: -20037510 ymin: -30240970 xmax: 20037510 ymax: 18446790\n## Projected CRS: WGS 84 / Pseudo-Mercator\n\ncntries2 = merge(cntries2,\n df,\n by.x = \"ISO3_CODE\",\n by.y = \"ISO_3166_3\",\n all.x = TRUE)\n\nafrica=subset(cntries2, CONTINENT.EN ==\"Africa\") %>%\n arrange(desc(area_km2))\n\n\n#Get bigger countries\n\nplot(st_geometry(africa[1:20,]), bg=\"lightblue\")\n\n\nplot(st_geometry(cntries2), col=\"grey90\", add=TRUE)\n\n#Iterate for Africa\n#Get flags from repo - low quality to speed up the vignette\nflagrepo = \"https://raw.githubusercontent.com/hjnilsson/country-flags/master/png250px/\"\n\n\nfor (i in 1:nrow(africa)) {\n cntry <- as.character(st_drop_geometry(africa[i, \"ISO_3166_2\"]))\n a = getPngLayer(africa[i,],\n paste(flagrepo, tolower(cntry), \".png\", sep = \"\"))\n pngLayer(a, add = TRUE)\n}\n#Add borders\nplot(st_geometry(cntries2), add = TRUE, col = NA, lwd=0.4)\n\nlayoutLayer(\n title = \"Flags of Africa\",\n theme = \"green.pal\",\n sources = \"© EuroGeographics for the administrative boundaries.\",\n author = paste0(\"cartography \", packageVersion(\"cartography\")),\n scale = 500,\n frame = TRUE\n)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20200217_pnglayer-1.webp\")
\nlibrary(sf)\nlibrary(cartography)\n\nbox <- c(xmin=2200000, xmax=7150000,ymin=1380000, ymax=5500000)\nnuts0 <- st_crop(cntries, box)\n\nUK = nuts0 %>% filter(id == \"UK\")\nurl = \"https://upload.wikimedia.org/wikipedia/commons/thumb/b/b7/Flag_of_Europe.svg/800px-Flag_of_Europe.svg.png\"\n\n\nEU=getPngLayer(nuts0,url, mask=FALSE)\npngLayer(EU, alpha=100)\nurluk=flagrepo = \"https://raw.githubusercontent.com/hjnilsson/country-flags/master/png250px/gb.png\"\n\nUKpng=getPngLayer(UK,urluk)\n\npngLayer(UKpng, add=TRUE)\n![\"European](\"https://dieghernan.github.io/assets/img/blog/20200217_png-adv-1.webp\")
wordcloudLayer()A word cloud (or tag cloud) is a visual representation of text data. In a mapping context, this representation is useful for including several pieces of information at a glance.
\n\nWord cloud layers fitted into a map shape provide a good trade-off between\nphysical location, scale and labels. The size and color of the words are based\non the frequency of the factor being plotted, highlighting the most frequent\nterms.
\n\n\neu$dens=eu$pop/eu$area_km2\n\nwordcloudLayer(eu,txt=\"NAME.EN\",freq=\"dens\",\n fittopol = TRUE,\n nclass=7,\n cex.maxmin = c(3,1) )\nbr=getBreaks(eu$dens, nclass=7)\n\nlegendChoro(breaks=br, title.txt=\"Pop Density\",col=carto.pal(\"blue.pal\",7))\nlayoutLayer(\n title = \"Population Density in Europe\",\n theme = \"blue.pal\",\n sources = \"© EuroGeographics for the administrative boundaries.\",\n author = paste0(\"cartography \", packageVersion(\"cartography\")),\n scale = 500,\n frame = TRUE\n)\n![\"Word](\"https://dieghernan.github.io/assets/img/blog/20200217_wordcloud1-1.webp\")
\n# Genres from MB--\n#Import genres\ncollected = read.csv(\"./assets/data/US_MB.csv\", stringsAsFactors = F)\ncollected=collected[-1,] %>% arrange(desc(n))\n\nset.seed(1234)\n\nlibrary(rnaturalearth)\nshape = ne_countries(country=\"united states of america\", returnclass = \"sf\") %>% st_transform(3857)\n#Get main polygon\nshape = shape %>% st_union %>% st_cast(\"POLYGON\")\nareas = st_area(shape)\nshape = shape[areas == max(areas)]\n\nset.seed(1234)\npoints = 100\n#Sample regular\npoints = st_sample(shape, points + 5, type = \"regular\")\n\n#Center points\n\ncentr=st_centroid(shape, of_largest_polygon = TRUE)\nf=st_distance(points,centr)\ndfpoints=st_sf(dist=f,\n geometry=points) %>%\n arrange((dist))\n\n\n#Create df\npoints=st_sf(collected[1:100,],\n geometry=st_geometry(dfpoints)[1:100])\n\nplot(shape, col=\"grey95\", border = NA)\nwordcloudLayer(points,\n txt=\"genre\",\n freq=\"n\",\n cex.maxmin = c(3, 0.6),\n col=c(\"#ba478f\", \"#eb743b\"),\n nclass=7,\n add=TRUE)\nlayoutLayer(title=\"Most frequent genres on US\",\n sources=\"Musicbrainz\",\n author = paste0(\"cartography \", packageVersion(\"cartography\")),\n theme=\"orange.pal\")\n![\"Word](\"https://dieghernan.github.io/assets/img/blog/20200217_wordcloud2-1.webp\")
This is just a short post regarding Brexit. Setting aside economic, political\nand social considerations, there is another consequence: there is now one fewer\ncountry in the EU.
\n\nWe will miss you, UK. We wish you the best.
\n\nHistorical example: The mapping examples use cartography, which is now\nin maintenance mode. Its maintainers recommend mapsf\nfor new work. The original code and outputs are preserved and have not been\nrevalidated against current package versions.
\n\nlibrary(cartography)\nlibrary(sf)\nlibrary(giscoR)\n\n\n#EU\neu <- giscoR::gisco_countrycode %>% filter(eu)\n\n# Download maps\nNUTS1 <- gisco_get_nuts(epsg = 3035, country = eu$ISO3_CODE, nuts_level = 1)\n\n\nUK <- gisco_get_countries(country = \"GBR\", epsg = 3035)\n\nnoplot = c(\"FRY\", \"ES7\", \"PT2\", \"PT3\")\nNUTS1_Clean = NUTS1 %>% subset(!NUTS_ID %in% noplot) %>%\n group_by(CNTR_CODE) %>% summarise(a=dplyr::n())\n\n# Flag image\nurl = \"https://upload.wikimedia.org/wikipedia/commons/thumb/b/b7/Flag_of_Europe.svg/800px-Flag_of_Europe.svg.png\"\n\n#Mask UK\nflagcut = getPngLayer(NUTS1_Clean,\n url)\n# Full extent\nflag = getPngLayer(NUTS1_Clean,\n url, mask = FALSE)\n\n\npar(mar = c(0, 0, 0, 0))\ntilesLayer(flag, alpha = 150)\ntilesLayer(flagcut, bgalpha = 0, add = T)\nplot(st_geometry(UK),\n col = \"white\",\n border = NA,\n add = TRUE)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20200602_imgpost-1.webp\")
In this post, I show how to produce different filling patterns that can be added\nover your shapefiles with the cartography package.
\n\nHistorical example: The mapping examples use cartography, which is now\nin maintenance mode. Its maintainers recommend mapsf\nfor new work. The original code and outputs are preserved and have not been\nrevalidated against current package versions.
\n\nUpdated 17 February 2020: All these pieces of work are already available\nin cartography >v.2.4.0 through the hatchedLayer\nand legendHatched\nfunctions. Just install it via install.packages(\"cartography\"). A dedicated\nblog post with examples is available in this post.
library(sf)\nlibrary(dplyr)\nlibrary(giscoR)\nlibrary(cartography)\nDE <- gisco_get_countries(country = \"Germany\", epsg = 3857)\nLet’s see how it works.
\n\npar(\n mfrow = c(3, 4),\n mar = c(1, 1, 1, 1),\n cex = 0.5\n)\nhatchedLayer(DE, \"dot\")\ntitle(\"dot\")\nhatchedLayer(DE, \"text\", txt = \"Y\")\ntitle(\"text\")\nhatchedLayer(DE, \"diamond\", density = 0.5)\ntitle(\"diamond\")\nhatchedLayer(DE, \"grid\", lwd = 1.5)\ntitle(\"grid\")\nhatchedLayer(DE, \"hexagon\", col = \"blue\")\ntitle(\"hexagon\")\nhatchedLayer(DE, \"horizontal\", lty = 5)\ntitle(\"horizontal\")\nhatchedLayer(DE, \"vertical\")\ntitle(\"vertical\")\nhatchedLayer(DE, \"left2right\")\ntitle(\"left2right\")\nhatchedLayer(DE, \"right2left\")\ntitle(\"right2left\")\nhatchedLayer(DE, \"zigzag\")\ntitle(\"zigzag\")\nhatchedLayer(DE, \"circle\")\ntitle(\"circle\")\n![\"Eleven](\"https://dieghernan.github.io/assets/img/blog/20191212_showfun-1.webp\")
Let’s play a little bit more with some of the additional features of the\nfunction:
\n\npar(mar = c(1, 1, 1, 1), mfrow = c(2, 3))\nplot(st_geometry(DE))\nhatchedLayer(\n DE,\n \"dot\",\n pch = 10,\n density = 0.5,\n cex = 2,\n col = \"darkblue\",\n add = T\n)\nplot(st_geometry(DE))\nhatchedLayer(\n DE,\n \"dot\",\n pch = 21,\n col = \"red\",\n bg = \"green\",\n cex = 1.25,\n add = T\n)\nplot(st_geometry(DE), col = \"grey\")\nhatchedLayer(\n DE,\n \"text\",\n txt = \"DE\",\n density = 1.1,\n col = \"white\",\n add = T\n)\nplot(st_geometry(DE), col = \"blue\")\nhatchedLayer(\n DE,\n \"horizontal\",\n lty = 3,\n cellsize = 150 * 1000,\n add = T\n)\nhatchedLayer(DE, \"zigzag\", lwd = 2, col = \"red\")\nplot(st_geometry(DE), border = \"orange\", lwd = 2)\nhatchedLayer(DE,\n \"left2right\",\n density = 2,\n col = \"orange\",\n add = T\n)\n![\"Six](\"https://dieghernan.github.io/assets/img/blog/20191212_playing-1.webp\")
legendHatched functionAs a complementary function, there is also legendHatched. The main parameters\nare:
pos, title.txt, title.cex, values.cex, categ, cex and frame:\nSee ?cartography::legendTypo.patterns: Vector of patterns to be created for each element on categ.ptrn.bg: Background of the legend box for each categ.ptrn.text: Text to be used for each categ=\"text\", as a single value or a vector.dot.cex: cex of each categ=\"dot\", as a single value or a vector.text.cex: Text size of each categ=\"text\", as a single value or a vector.hatchedLayer function, different graphical\nparameters can be passed (lty, lwd, pch, bg on points).Note that it is also possible to create solid legends by setting col and\nptrn.bg to the same color. Parameters respect the order of the categ\nvariable.
par(mar = c(0, 0, 0, 0), mfrow = c(1, 1))\nplot(st_geometry(DE)) # Null geometry\nlegendHatched(\n title.txt = \"Example 1\",\n categ = c(\"a\", \"b\"),\n patterns = \"dot\",\n pch = c(16, 23),\n frame = T\n)\nlegendHatched(\n pos = \"left\",\n title.txt = \"Example 2\",\n categ = c(\"c\", \"d\", \"other text\"),\n patterns = c(\"text\", \"zigzag\"),\n ptrn.text = c(\"s\", \"pp\"),\n ptrn.bg = \"grey80\",\n col = c(\"red\", \"blue\")\n)\n\nlegendHatched(\n pos = \"topright\",\n title.txt = \"Example 3\",\n categ = c(\"e\", \"f\", \"solid\"),\n patterns = c(\"circle\", \"left2right\"),\n ptrn.bg = c(\"orange\", \"yellow\", \"green\"),\n col = c(\"white\", \"white\", \"green\"),\n lty = c(2, 4),\n lwd = c(1, 3)\n)\n\n\nlegendHatched(\n pos = \"bottomright\",\n title.txt = \"Example 4\",\n values.cex = 1.2,\n categ = c(\"h\", \"i\", \"j\", \"k\"),\n patterns = c(\"grid\", \"diamond\", \"horizontal\", \"dot\"),\n cex = 2,\n pch = 22,\n col = \"white\",\n ptrn.bg = \"black\",\n bg = \"pink\"\n)\n![\"Outline](\"https://dieghernan.github.io/assets/img/blog/20191212_playinglegend-1.webp\")
I hope that you find these functions useful. Enjoy, and happy mapping!
\n\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20191212_imgpost-1.webp\" "\\"plot")
How to place an inset map in R? There are many solutions out there using\nthe ggplot2 package (see Drawing beautiful maps programmatically with\nR, sf and ggplot2\nby Mel Moreno and Mathieu Basille). However, I like the old reliable plot\nfunction, so the question is: is there another way?
There is. I found inspiration\nhere and I just applied it\nto a map.
\n\nlibrary(sf)\nlibrary(dplyr)\nlibrary(rnaturalearth)\nI present here an alternative version of\nDrawing beautiful maps programmatically with R, sf and ggplot2,\nso the bulk of the detail can be found there. I focus only on the plot()\nside.
world <- ne_countries(scale = \"medium\", returnclass = \"sf\")\nUSA <- subset(world, admin == \"United States of America\")\n\n# Plot mainland USA----\npar(mar = c(0, 0, 0, 0))\nplot(\n st_geometry(world %>%\n st_transform(2163)),\n xlim = c(-2500000, 2500000),\n ylim = c(-2300000, 730000),\n col = \"#F6E1B9\",\n border = \"#646464\",\n bg = \"#C6ECFF\"\n)\nplot(\n st_geometry(USA) %>% st_transform(2163),\n col = \"#FEFEE9\",\n border = \"black\",\n add = T\n)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20191108_main-1.webp\")
# Plot Alaska----\nplot(\n st_geometry(world %>%\n st_transform(3467)),\n xlim = c(-2400000, 1600000),\n ylim = c(200000, 2500000),\n col = \"#F6E1B9\",\n border = \"#646464\",\n bg = \"#C6ECFF\"\n)\nplot(\n st_geometry(USA) %>% st_transform(3467),\n col = \"#FEFEE9\",\n border = \"black\",\n add = T\n)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20191108_Alaska-1.webp\")
# Plot Hawaii----\nplot(\n st_geometry(world %>%\n st_transform(4135)),\n xlim = c(-161, -154),\n ylim = c(18, 23),\n col = \"#F6E1B9\",\n border = \"#646464\",\n bg = \"#C6ECFF\"\n)\nplot(\n st_geometry(USA) %>% st_transform(4135),\n col = \"#FEFEE9\",\n border = \"black\",\n add = T\n)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20191108_Hawaii-1.webp\")
From now on, I focus on the inset part, using the fig argument of par().\nQuoting statmethods:
\n\n\n(…) think of the full graph area as going from
\n(0,0)in the lower left corner to(1,1)in the upper right corner. The format of thefig=parameter is a numerical vector of the formc(x1, x2, y1, y2)(…)\nfig=starts a new plot, so to add to an existing plot usenew=TRUE.
With x1 and y1 as the starting points and x2, y2 as the final points,\nwe can set up those parameters and adjust the final placement of the insets.\nAdditionally, I added a box around the insets using bbox(). I didn’t mimic\nMoreno & Basille here and I just worked it out by myself.
par(mar = c(0, 0, 0, 0))\nplot(\n st_geometry(world %>%\n st_transform(2163)),\n xlim = c(-2500000, 2500000),\n ylim = c(-2300000, 730000),\n col = \"#F6E1B9\",\n border = \"#646464\",\n bg = \"#C6ECFF\"\n)\nplot(\n st_geometry(USA) %>% st_transform(2163),\n col = \"#FEFEE9\",\n border = \"black\",\n add = T\n)\n# Alaska\npar(\n fig = c(0.01, 0.28, 0.01, 0.33),\n new = TRUE\n)\nplot(\n st_geometry(world %>%\n st_transform(3467)),\n xlim = c(-2400000, 1600000),\n ylim = c(200000, 2500000),\n col = \"#F6E1B9\",\n border = \"#646464\",\n bg = \"#C6ECFF\"\n)\nplot(\n st_geometry(USA) %>% st_transform(3467),\n col = \"#FEFEE9\",\n border = \"black\",\n add = T\n)\nbox(which = \"figure\", lwd = 1)\n\n# Hawaii\npar(\n fig = c(0.29, 0.45, 0.01, 0.15),\n new = TRUE\n)\nplot(\n st_geometry(world %>%\n st_transform(4135)),\n xlim = c(-161, -154),\n ylim = c(18, 23),\n col = \"#F6E1B9\",\n border = \"#646464\",\n bg = \"#C6ECFF\"\n)\nplot(\n st_geometry(USA) %>% st_transform(4135),\n col = \"#FEFEE9\",\n border = \"black\",\n add = T\n)\n\nbox(which = \"figure\", lwd = 1)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20191108_inset-1.webp\")
Results may vary depending on the size of the original plot (Mainland USA),\nyour plotting device and the output. However, with a bit of trial and error,\nit is quite easy to adjust the final result.
\n\nAs an example, see one of my contributions to Wikimedia Commons, which\nrepresents a map of the NUTS3 regions of the European Union. Several countries\n(France, Portugal, Spain) have overseas territories, so I made a few insets on\nthe right side.
\n\n![\"Choropleth](\"https://thumb.wikimedia.org/wikipedia/commons/thumb/4/46/Population_density_by_NUTS_3_region_%282017%29.svg/3840px-Population_density_by_NUTS_3_region_%282017%29.svg.png\")
This is a quick post on how to create a map according to the\nWikipedia conventions.\nIn this case, I have chosen to plot the\ninternational organ donor rates,\nretrieved on February 10, 2019, although the data refers to 2017 (source:\nIRODaT).
\n\nHistorical example: The mapping examples use cartography, which is now\nin maintenance mode. Its maintainers recommend mapsf\nfor new work. The original code and outputs are preserved and have not been\nrevalidated against current package versions.
\n\nThe first step is to scrape Wikipedia in order to get the final table. To do\nso, I will use the rvest package. You can get the xpath you want to\nscrape as explained here.
library(rvest)\nlibrary(dplyr)\n\nBase <-\n read_html(\"https://en.wikipedia.org/wiki/International_organ_donor_rates\") %>%\n html_nodes(xpath = '//*[@id=\"mw-content-text\"]/div/table[3]') %>%\n html_table() %>%\n as.data.frame(\n stringsAsFactors = F,\n fix.empty.names = F\n ) %>%\n select(Country,\n RateDonperMill = Number.of.deceased.donors..per.million.of.population\n )\n\nknitr::kable(head(Base, 10), format = \"markdown\")\n| Country | \nRateDonperMill | \n
|---|---|
| Argentina | \n19.60 | \n
| Armenia | \n0.00 | \n
| Australia | \n21.60 | \n
| Austria | \n23.88 | \n
| Azerbaijan | \n0.00 | \n
| Bahrain | \n4.00 | \n
| Bangladesh | \n0.00 | \n
| Belarus | \n26.20 | \n
| Belgium | \n30.30 | \n
| Bolivia | \n0.36 | \n
Now we need to choose a good source of maps:
\n\nlibrary(sf)\nlibrary(giscoR)\n\n# Map import from Eurostat\nWorldMap <- gisco_get_countries(resolution = 3, epsg = 3857) %>%\n select(ISO_3166_3 = ISO3_CODE)\nNow let’s join and have a look to see what is going on. We use the\ncountrycode package to retrieve the ISO3 codes of our scraped dataset:
\n\nlibrary(countrycode)\n\nBase$ISO_3166_3 <- countrycode(Base$Country, origin = \"country.name\", destination = \"iso3c\")\n\n\nDonorRate <- left_join(\n WorldMap,\n Base\n) %>%\n select(\n Country,\n ISO_3166_3,\n RateDonperMill\n )\n.svg fileAs already explained, I would like to follow the Wikipedia conventions, so there\nare some things to bear in mind:
\n\n.svg file following the naming convention.Some libraries remain to be used: RColorBrewer, rsvg and, especially,\none of my favorites, cartography:
\n\nlibrary(RColorBrewer)\nlibrary(cartography)\nlibrary(rsvg)\n\n# Create bbox of the world\nbbox <- st_linestring(rbind(\n c(-180, 90),\n c(180, 90),\n c(180, -90),\n c(-180, -90),\n c(-180, 90)\n)) %>%\n st_segmentize(5) %>%\n st_cast(\"POLYGON\") %>%\n st_sfc(crs = 4326) %>%\n st_transform(crs = \"+proj=robin\")\n\n# Create SVG\nsvg(\n \"Organ donor rate per million by country gradient map (2017).svg\",\n pointsize = 90,\n width = 1600 / 90,\n height = 728 / 90\n)\n\npar(mar = c(0.5, 0, 0, 0))\nchoroLayer(\n DonorRate %>% st_transform(\"+proj=robin\"),\n var = \"RateDonperMill\",\n breaks = c(0, 5, 10, 20, 30, 40, 50),\n col = brewer.pal(6, \"PuBu\"),\n border = \"#646464\",\n lwd = 0.1,\n colNA = \"#E0E0E0\",\n legend.pos = \"left\",\n legend.title.txt = \"\",\n legend.values.cex = 0.25\n)\n\n# Bounding box\nplot(bbox,\n add = T,\n border = \"#646464\",\n lwd = 0.2\n)\n\ndev.off()\nAnd that’s all. Our .svg file is ready to be included in Wikipedia.
![\"World](\"https://dieghernan.github.io/assets/img/blog/20191016_imgpost.webp\")
Update: The map is already part of the Wikipedia article.
\n", "date_published": "2019-10-16T00:00:00+02:00", "date_modified": "2026-10-07T00:00:00+02:00", "image": "https://dieghernan.github.io/assets/img/blog/20191016_imgpost.webp", "summary": "Map international organ donor rates using Wikipedia data and cartography.", "tags": ["r_bloggers","rstats","rspatial","sf","maps","giscoR"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/201906_Beautiful2/", "url": "https://dieghernan.github.io/201906_Beautiful2/", "title": "Beautiful maps with R (II): Fun with flags", "content_html": "Updated 29 December 2020: All these pieces of work are already available\nin cartography >v.2.4.0 in the getPngLayer\nfunction. Just install it via install.packages(\"cartography\"). A dedicated\nblog post with examples is available in this post.
Updated 25 January 2023: cartography is in maintenance mode. You can use\nrasterpic + tidyterra to achieve the same result, see link1\nand link2.
\n\nWant to use a flag (or any *.png file) as a background for your map? You are\nin the right place. I am aware that there are some R packages out\nthere, but we focus here on the\noption provided by cartography::getPngLayer(), which basically converts your\nimage into a raster. See also Paul Murrell’s article “Raster Images in R\nGraphics” (The R Journal, Volume 3/1, June 2011).
library(dplyr)\nlibrary(sf)\nlibrary(cartography)\nlibrary(mapSpain)\nlibrary(giscoR)\nIn this post, I am going to plot a map of Spain with its\nautonomous communities (plus 2 autonomous cities),\nwhich are the first-level administrative divisions of the country.\nWikipedia\nshows an initial map that also identifies the flag of each territory.
\n\nFor that, I will use mapSpain, which uses information from giscoR, whose\nsource is the geodata available in Eurostat.\nI will also use giscoR to get the world around Spain.
\n\nSpain <- esp_get_ccaa(epsg = 3857, res = 3)\n\nWorld <- gisco_get_countries(epsg = 3857, res = 3)\n\nbboxcan <- esp_get_can_box(epsg = 3857)\n\n# Plot\npar(mar = c(0, 0, 0, 0))\nplot(st_geometry(Spain),\n col = NA,\n border = NA,\n bg = \"#C6ECFF\"\n)\nplot(st_geometry(World),\n col = \"#E0E0E0\",\n bg = \"#C6ECFF\",\n add = T\n)\nplot(st_geometry(Spain), col = \"#FEFEE9\", add = T)\nlayoutLayer(\n title = \"\",\n frame = FALSE,\n scale = 500,\n sources = gisco_attributions(),\n author = \"dieghernan, 2019\",\n)\nplot(bboxcan, add = TRUE)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20190618_preparing-1.webp\")
Now we have it! A nice map of Spain with a layout based on the Wikipedia convention for location maps.
\n\nAs a first example, I chose Asturias\nto build my code. The goal here is to create a RasterBrick from the desired\n*.png file, add the necessary geographical information and use the shape of\nAsturias to crop the flag.
# 1.Shape---\nshp <- Spain %>% filter(ccaa.shortname.es == \"Asturias\")\n\n# 2.Get flag---\n\n# Masked\nurl <- \"https://upload.wikimedia.org/wikipedia/commons/thumb/3/3e/Flag_of_Asturias.svg/800px-Flag_of_Asturias.svg.png\"\n\nflagnomask <- getPngLayer(shp, url, mask = FALSE)\n\nflagmask <- getPngLayer(shp, url, mask = TRUE)\n\nopar <- par(no.readonly = TRUE)\npar(mar = c(1, 1, 1, 1), mfrow = c(1, 2))\npngLayer(flagnomask)\nplot(st_geometry(Spain), add = T)\n\n# 4.Mask---\npngLayer(flagmask)\nplot(st_geometry(Spain), add = T)\n![\"Two](\"https://dieghernan.github.io/assets/img/blog/20190618_Asturias-1.webp\")
par(opar)\n Pro tip: Use high-quality *.png files,\notherwise the plot will look quite poor. Here I show an extreme example.
MURshp <- Spain %>% filter(ccaa.shortname.es == \"Murcia\")\nMURLow <- getPngLayer(\n MURshp,\n \"https://upload.wikimedia.org/wikipedia/commons/thumb/a/a5/Flag_of_the_Region_of_Murcia.svg/100px-Flag_of_the_Region_of_Murcia.svg.png\"\n)\nMURHigh <- getPngLayer(\n MURshp,\n \"https://upload.wikimedia.org/wikipedia/commons/thumb/a/a5/Flag_of_the_Region_of_Murcia.svg/1200px-Flag_of_the_Region_of_Murcia.svg.png\"\n)\n\n\n# Plot and compare\nopar <- par(no.readonly = TRUE)\npar(mfrow = c(1, 2), mar = c(1, 1, 1, 1))\nplot_sf(MURshp, main = \"Low\")\npngLayer(MURLow, add = TRUE)\n\nplot_sf(MURshp, main = \"High\")\npngLayer(MURHigh, add = TRUE)\n![\"Two](\"https://dieghernan.github.io/assets/img/blog/20190618_svg-1.webp\")
par(opar)\nNow, we are ready to have fun with flags. It’s time to make the flag map of the autonomous communities of Spain.
\n\n\n\npar(mar = c(0, 0, 0, 0), mfrow = c(1, 1))\nplot(Spain %>%\n st_geometry(),\ncol = NA,\nborder = NA,\nbg = \"#C6ECFF\"\n)\nplot(st_geometry(World),\n col = \"#E0E0E0\",\n add = T\n)\nplot(st_geometry(bboxcan),\n add = T\n)\nlayoutLayer(\n title = \"\",\n frame = FALSE,\n sources = \"© EuroGeographics for the administrative boundaries\",\n author = \"dieghernan, 2019\",\n)\n# Andalucia\nflag <-\n \"https://upload.wikimedia.org/wikipedia/commons/thumb/9/9a/Bandera_de_Andalucia.svg/1000px-Bandera_de_Andalucia.svg.png\"\nshp <- Spain %>% filter(ccaa.shortname.es == \"Andalucía\")\npngLayer(getPngLayer(shp, flag), add = TRUE)\n\n# ...more flags\n# Go to the source code of this post on GitHub for the full code\n\nplot(st_geometry(Spain),\n col = NA,\n lwd = 2,\n add = T\n)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20190618_allCCAA-1.webp\")
We are done now. If you have suggestions, you can leave a comment. As always,\nif you enjoyed the post, you can share it on your preferred social network.
\n", "date_published": "2019-06-18T00:00:00+02:00", "date_modified": "2023-01-23T00:00:00+01:00", "image": "https://dieghernan.github.io/assets/img/blog/20190618_imgpost-1.webp", "summary": "Want to use a flag (or any *.png file) as a background for your map? You are in the right place.", "tags": ["music","r_bloggers","rstats","rspatial","beautiful_maps","maps","raster","flags","function","mapSpain","giscoR"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/201906_Beautiful1/", "url": "https://dieghernan.github.io/201906_Beautiful1/", "title": "Beautiful maps with R (I): Fishnets, honeycombs and pixels", "content_html": "Sometimes you want to produce maps with special layouts. I especially like\nmaps with modified geometries, e.g. simplifying the original shapes to squares\nor dots. When searching the web, I found the fantastic post Fishnets and\nHoneycomb: Square vs. Hexagonal Spatial Grids\nby Matt Strimas-Mackey, which was a huge\ninspiration (by the way, don’t miss his blog, full\nof very interesting pieces of work).
\n\nThe only thing I was not completely comfortable with was that the post used the\nold-fashioned\nsp package instead of my personal favorite, the sf package. The post\nwas published in 2016, and note that the author has also moved to the sf\npackage since then. So I decided to explore further options with sf.
\n\nThe approach is similar, using grids over a map and working with them, but with\nst_make_grid.\nI also expanded it by grouping the grids and producing dots over the geometries.\nSo basically I produced five variations of the map:
| Type | \nReplacement | \nGrouped | \n
|---|---|---|
| Fishnet | \nSquare | \nNo | \n
| Puzzle | \nSquare | \nYes | \n
| Honeycomb | \nHexagon | \nNo | \n
| Hexbin | \nHexagon | \nYes | \n
| Pixel | \nDot | \nNo | \n
library(sf)\nlibrary(giscoR)\nlibrary(dplyr)\nlibrary(RColorBrewer)\nLet’s use the square option of st_make_grid and play a bit with it.
GB <- ne_download(50,\n type = \"map_subunits\",\n returnclass = \"sf\",\n destdir = tempdir()\n) %>%\n subset(CONTINENT == \"Europe\") %>%\n subset(ADM0_A3 == \"GBR\")\n\n# Projecting and cleaning\nGB <- st_transform(GB, 3857) %>% select(NAME_EN, ADM0_A3)\ninitial <- GB\ninitial$index_target <- 1:nrow(initial)\ntarget <- st_geometry(initial)\n\n# Create my own color palette\nmypal <- colorRampPalette(c(\"#F3F8F8\", \"#008080\"))\n Warning: The cellsize should\nbe set in the same unit as the projection (in this case, meters). Pay special\nattention to this because if the parameter is too small, meaning that the grid\nis too dense, R could crash easily.
grid <- st_make_grid(target,\n 50 * 1000,\n # Kms\n crs = st_crs(initial),\n what = \"polygons\",\n square = TRUE\n)\n\n# To sf\ngrid <- st_sf(index = 1:length(lengths(grid)), grid) # Add index\n\n# We identify the grids that belong to an entity by assessing the centroid\ncent_grid <- st_centroid(grid)\ncent_merge <- st_join(cent_grid, initial[\"index_target\"], left = F)\ngrid_new <- inner_join(grid, st_drop_geometry(cent_merge))\n\n# Fishnet\nFishgeom <- aggregate(grid_new,\n by = list(grid_new$index_target),\n FUN = min,\n do_union = FALSE\n)\n\n# Let's add the data frame\nFishnet <- left_join(\n Fishgeom %>% select(index_target),\n st_drop_geometry(initial)\n) %>%\n select(-index_target)\n\n# Now let's create the puzzle\nPuzzlegeom <- aggregate(st_buffer(grid_new, 0.5), # Avoid slivers\n by = list(grid_new$index_target),\n FUN = min,\n do_union = TRUE\n) # This changes!!!\n\nPuzzle <- left_join(\n Puzzlegeom %>% select(index_target),\n st_drop_geometry(initial)\n) %>%\n select(-index_target)\n\n# Plot\npar(mfrow = c(1, 2), mar = c(1, 1, 1, 1), bg = NA)\nplot(st_geometry(Fishnet), col = mypal(4), main = \"Fishnet\")\nplot(st_geometry(Puzzle), col = mypal(4), main = \"Puzzle\")\n![\"Two](\"https://dieghernan.github.io/assets/img/blog/20190602_squares-1.webp\")
Extremely easy. We just need to change the square parameter of\nst_make_grid from TRUE to FALSE.
grid <- st_make_grid(target,\n 50 * 1000, # Kms\n crs = st_crs(initial),\n what = \"polygons\",\n square = FALSE # This is the only piece that changes!!!\n)\n# Make sf\ngrid <- st_sf(index = 1:length(lengths(grid)), grid) # Add index\n\n# We identify the grids that belong to an entity by assessing the centroid\ncent_grid <- st_centroid(grid)\ncent_merge <- st_join(cent_grid, initial[\"index_target\"], left = F)\ngrid_new <- inner_join(grid, st_drop_geometry(cent_merge))\n\n# Honeycomb\nHoneygeom <- aggregate(\n grid_new,\n by = list(grid_new$index_target),\n FUN = min,\n do_union = FALSE\n)\n\n# Let's add the data frame\nHoneycomb <- left_join(\n Honeygeom %>%\n select(index_target),\n st_drop_geometry(initial)\n) %>%\n select(-index_target)\n\n# Now let's create the hexbin\n\nHexbingeom <- aggregate(\n st_buffer(grid_new, 0.5), # Avoid slivers\n by = list(grid_new$index_target),\n FUN = min,\n do_union = TRUE\n)\n\nHexbin <- left_join(\n Hexbingeom %>%\n select(index_target),\n st_drop_geometry(initial)\n) %>%\n select(-index_target)\n\n# Plot\npar(mfrow = c(1, 2), mar = c(1, 1, 1, 1), bg = NA)\nplot(st_geometry(Honeycomb), col = mypal(4), main = \"Honeycomb\")\nplot(st_geometry(Hexbin), col = mypal(4), main = \"Hexbin\")\n![\"Two](\"https://dieghernan.github.io/assets/img/blog/20190602_hex-1.webp\")
Also quite easy, just a couple more tweaks, still using st_make_grid.
grid <- st_make_grid(target,\n 50 * 1000, # Kms\n crs = st_crs(initial),\n what = \"centers\"\n)\n\n# Make sf\ngrid <- st_sf(index = 1:length(lengths(grid)), grid) # Add index\n\n# We identify the grids that belong to an entity by assessing the centroid\ncent_grid <- st_centroid(grid)\ncent_merge <- st_join(cent_grid, initial[\"index_target\"], left = F)\ngrid_new <- st_buffer(cent_merge, 50 * 1000 / 2)\nPixelgeom <- aggregate(\n grid_new,\n by = list(grid_new$index_target),\n FUN = min,\n do_union = FALSE\n)\n# Let's add the data frame\nPixel <- left_join(\n Pixelgeom %>%\n select(index_target),\n st_drop_geometry(initial)\n) %>%\n select(-index_target)\n\n# Plot\npar(mfrow = c(1, 1), mar = c(1, 1, 1, 1), bg = NA)\nplot(st_geometry(Pixel), col = mypal(4), main = \"Pixel\")\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20190602_pix-1.webp\")
Finally, I wrapped all that in a function named stdh_gridpol. See the code in\nmy repo:
stdh_gridpol <- function(sf,\n to = \"fishnet\",\n gridsize = as.integer(\n min(\n diff(st_bbox(sf)[c(1, 3)]),\n diff(st_bbox(sf)[c(2, 4)])\n ) / 40\n ),\n sliver = 0.5) {\n if (!unique(st_geometry_type(sf)) %in% c(\"POLYGON\", \"MULTIPOLYGON\")) {\n stop(\"Input should be MULTIPOLYGON or POLYGON\")\n }\n if (!to %in% c(\"fishnet\", \"puzzle\", \"honeycomb\", \"hexbin\", \"pixel\")) {\n stop(\"'to' should be 'fishnet','puzzle','honeycomb','hexbin' or 'pixel'\")\n }\n\n if (class(sf)[1] == \"sf\") {\n initial <- sf\n initial$index_target <- 1:nrow(initial)\n } else {\n initial <- st_sf(index_target = 1:length(sf), geom = sf)\n }\n\n target <- st_geometry(initial)\n\n if (to %in% c(\"fishnet\", \"puzzle\")) {\n sq <- T\n } else {\n sq <- F\n }\n if (to == \"pixel\") {\n grid <- st_make_grid(target,\n gridsize,\n crs = st_crs(initial),\n what = \"centers\"\n )\n } else {\n grid <- st_make_grid(\n target,\n gridsize,\n crs = st_crs(initial),\n what = \"polygons\",\n square = sq\n )\n }\n grid <- st_sf(index = 1:length(lengths(grid)), grid) # Add index\n if (to == \"pixel\") {\n cent_merge <- st_join(grid, initial[\"index_target\"], left = F)\n grid_new <- st_buffer(cent_merge, gridsize / 2)\n } else {\n cent_grid <- st_centroid(grid)\n cent_merge <- st_join(cent_grid, initial[\"index_target\"], left = F)\n grid_new <- inner_join(grid, st_drop_geometry(cent_merge))\n }\n if (to %in% c(\"fishnet\", \"honeycomb\", \"pixel\")) {\n geom <- aggregate(\n grid_new,\n by = list(grid_new$index_target),\n FUN = min,\n do_union = FALSE\n )\n } else {\n geom <- aggregate(\n st_buffer(grid_new, sliver),\n by = list(grid_new$index_target),\n FUN = min,\n do_union = TRUE\n )\n }\n if (class(initial)[1] == \"sf\") {\n fin <- left_join(\n geom %>% select(index_target),\n st_drop_geometry(initial)\n ) %>%\n select(-index_target)\n fin <- st_cast(fin, \"MULTIPOLYGON\")\n return(fin)\n } else {\n fin <- st_cast(geom, \"MULTIPOLYGON\")\n return(st_geometry(fin))\n }\n}\n# End of the function-----\n\nfish <- stdh_gridpol(GB, to = \"fishnet\", gridsize = 50 * 1000)\npuzz <- stdh_gridpol(GB, to = \"puzzle\", gridsize = 50 * 1000)\nhon <- stdh_gridpol(GB, to = \"honeycomb\", gridsize = 50 * 1000)\nhex <- stdh_gridpol(GB, to = \"hexbin\", gridsize = 50 * 1000)\npix <- stdh_gridpol(GB, to = \"pixel\", gridsize = 50 * 1000)\n![\"Grid](\"https://dieghernan.github.io/assets/img/blog/20190602_functionex-1.webp\")
And that’s it! The function stdh_gridpol has some alert mechanisms, such as\naccepting only POLYGON or MULTIPOLYGON, and the default value of gridsize\nis computed so that the shortest dimension has 40 cells.
Recently, I have been struggling when trying to embed a\nleaflet map created with\nRStudio on my blog, hosted on GitHub via\nJekyll (Spoiler: I succeeded\n).\nIn my case, I use the Chulapa\nremote theme that I created.
\n\nIndex
\n\nReady? Let’s go!
\n\nThe first step is to install the required libraries on your GitHub\npage. As Jekyll basically transforms Markdown into HTML, this step\nis a matter of what to include and where in your own repository.
\n\nThis part is not really hard. When looking at the source code of the\nLeaflet for R site, you can see this\nchunk:
\n\n<head>\n <!--code-->\n\n <script src=\"libs/jquery/jquery.min.js\"></script>\n <meta name=\"viewport\" content=\"width=device-width, initial-scale=1\" />\n <link href=\"libs/bootstrap/css/flatly.min.css\" rel=\"stylesheet\" />\n <script src=\"libs/bootstrap/js/bootstrap.min.js\"></script>\n <script src=\"libs/bootstrap/shim/html5shiv.min.js\"></script>\n\n ...\n <!--more libraries-->\n ...\n\n <link href=\"libs/rstudio_leaflet/rstudio_leaflet.css\" rel=\"stylesheet\" />\n <script src=\"libs/leaflet-binding/leaflet.js\"></script>\n\n <!--code-->\n</head>\nSo now we have it! The only thing to remember is that we need to load\nthe libraries from the leaflet server\n(https://rstudio.github.io/leaflet), meaning that we have to prepend\nthat URL to the libraries in our installation:
<script src=\"https://rstudio.github.io/leaflet/libs/jquery/jquery.min.js\"></script>\n<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\" />\n<link\n href=\"https://rstudio.github.io/leaflet/libs/bootstrap/css/flatly.min.css\"\n rel=\"stylesheet\"\n/>\n\n...\n<!--more libraries-->\n...\n\n<link\n href=\"https://rstudio.github.io/leaflet/libs/rstudio_leaflet/rstudio_leaflet.css\"\n rel=\"stylesheet\"\n/>\n<script src=\"https://rstudio.github.io/leaflet/libs/leaflet-binding/leaflet.js\"></script>\nYou can have a look at my implementation in\n./_includes/leaflet.html.
This is a little more complicated, depending on the structure of your\nJekyll template. The code chunk should be included in the <head>\nsection of your page, so you would need to find where to put it. In the\ncase of Chulapa it is on\n./_includes/custom/custom_head_before_css.html.
So now you just have to paste the code that you got in step 1 into the\n<head>.
Pro tip: For a better performance of the\nsite, include these libraries only when you need them. In my case, I added\na custom variable in my YAML front matter for those posts with a leaflet\nmap, leafletmap: true. Go to step 4 for a working example.
Now it’s time to create a leaflet map with RStudio. I will keep it\nsimple for this post, so I took the first example provided in Leaflet\nfor R - Introduction.
\n\nlibrary(leaflet)\n\nm <- leaflet() %>%\n addTiles() %>% # Add default OpenStreetMap map tiles\n addMarkers(lng=174.768, lat=-36.852, popup=\"The birthplace of R\")\nm # Print the map\nIt is assumed that you are creating a post with\nRStudio,\nso the code presented above should be embedded in an .Rmd file.
Before knitting your .Rmd, you have to set up the YAML front\nmatter.\nHere it is essential to set up the option always_allow_html: yes,\nas well as output: github_document. As an example, this post was\ncreated with this front matter:
---\ntitle: Leaflet, <strong>R</strong>, Markdown, Jekyll and GitHub\nsubtitle: Make it work in 6 steps - a short tutorial\ntags: [R, leaflet, Jekyll, html, maps]\nheader_img: https://dieghernan.github.io/assets/figs/20190520_imgpost.webp\nleafletmap: true\nalways_allow_html: yes\nlast_modified_at: 2021-05-30\noutput:\n md_document:\n variant: gfm\n preserve_yaml: true\n---\nWe are almost there! Now “Knit” your code and get the corresponding\n.md file.
.md fileUpdate: This is no longer needed. I have kept it here for reference.\nYou can skip to the next section.
\n\nHave a look at the .md code that you have just created. Although not\ndisplayed in the preview, you can see in the file itself a chunk that\nlooks like this:
<script type=\"application/json\" data-for=\"7ab57412f7b1df4d5773\">\n {\"x\":{\"options\":\n ...\n \"jsHooks\":[]}\n</script>\nActually that chunk is your leaflet map, created with RStudio. You\ncan’t see it now because you are previewing a markdown file in your\nlocal PC, and the libraries installed in step 1 are installed on GitHub,\nbut we will solve that later.
Now you just need to paste this piece of code before that chunk:
\n\n<!--html_preserve-->\n<div id=\"htmlwidget-7ab57412f7b1df4d5773\" style=\"width:100%;height:216px;\" class=\"leaflet html-widget\"></div>\n <script type=\"application/json\" data-for=\"htmlwidget-7ab57412f7b1df4d5773\">\n ...\n Warning: Be sure that the\nwidget id (7ab57412f7b1df4d5773 in the example) is the same in the\n<div> and in the <script> part. If not, your map would not load.
The style=\"width:100%; height:216px;\" part controls the actual size of\nthe leaflet widget. In this case, the map will adapt to the width of\nthe page with a fixed height of 216px. I put some examples of\ndifferent size options at the end of the post so you can have a look and see\nwhich one is more suitable for your needs.
Now you just have to publish your post as usual! If everything has been\nproperly set, when Jekyll builds your post it will include the\nlibraries in the header and make the magic happen, just like this:
\n\n\n\n\n Warning: Have you checked\nthe YAML front matter of your .md file? Have another look, especially\nif you have followed my Pro tip.
A note: For a complete understanding of this section, it is\nrecommended to access it on multiple devices, so you can see the\ndifferent behavior on different screens. Google Chrome allows you to\nsimulate different devices (more info\nhere).
\n\nWith these examples, you can see how to control the absolute size of the\nleaflet map. The disadvantage of this method is that the size would be\nfixed for all the devices, so maps sized for smartphones or tablets\nwouldn’t look as nice on laptops, and vice versa.
\n\nFixed size in pixels. The default on my machine:
\n\nleaflet(options = leafletOptions(minZoom = 1.25, maxZoom = 8)) %>%\n addTiles() %>%\n setMaxBounds(-200, -90, 200, 90) %>%\n setView(-3.56948, 40.49181, zoom = 3)\nLet’s go narrow and long with html \"width:200px;height:300px;\":
leaflet(\n options = leafletOptions(minZoom = 1.25, maxZoom = 8),\n width = \"200px\", height = \"300px\"\n) %>%\n addTiles() %>%\n setMaxBounds(-200, -90, 200, 90) %>%\n setView(-3.56948, 40.49181, zoom = 3)\nRecommended option. These maps will adapt to the width of your\nscreen, no matter what device you are using.
\n\nleaflet(\n options = leafletOptions(minZoom = 1.25, maxZoom = 8),\n width = \"100%\"\n) %>%\n addTiles() %>%\n setMaxBounds(-200, -90, 200, 90) %>%\n setView(-3.56948, 40.49181, zoom = 3)\nThis is a very personal post, where I just show the map of all the places I have\ntraveled to by plane.
\n\n\n\n\n✈️ 255,622.0 km flown so far.
\n\n| City | \nCountry | \nN | \n
|---|---|---|
| Bilbao | \nSpain | \n66 | \n
| London | \nUnited Kingdom | \n23 | \n
| Edinburgh | \nUnited Kingdom | \n21 | \n
| Barcelona | \nSpain | \n16 | \n
| Brussels | \nBelgium | \n8 | \n
| Berlin | \nGermany | \n6 | \n
| Munich | \nGermany | \n6 | \n
| Palma de Mallorca | \nSpain | \n6 | \n
| Amsterdam | \nNetherlands | \n4 | \n
| Frankfurt | \nGermany | \n4 | \n
| Country | \nContinent | \nN | \n
|---|---|---|
| Spain | \nEurope | \n101 | \n
| United Kingdom | \nEurope | \n46 | \n
| Germany | \nEurope | \n18 | \n
| Belgium | \nEurope | \n8 | \n
| France | \nEurope | \n6 | \n
| Continent | \nRegion | \nN | \n
|---|---|---|
| Europe | \nSouthern Europe | \n105 | \n
| Europe | \nNorthern Europe | \n52 | \n
| Europe | \nWestern Europe | \n38 | \n
| Asia | \nWestern Asia | \n6 | \n
| North America | \nNorthern America | \n6 | \n
This post introduces a user-defined function for casting sf objects of class\nLINESTRING or POLYGON into substrings.
library(sf)\nlibrary(rnaturalearth)\nlibrary(dplyr)\nThe sf package includes st_cast,\na powerful function that transforms geometries into other types of geometries\n(i.e. LINESTRING to POLYGON, etc.).
italy <- ne_countries(country = \"italy\", returnclass = \"sf\")\nitaly_pol <- italy %>% st_cast(\"POLYGON\")\nitaly_lin <- italy_pol %>% st_cast(\"LINESTRING\")\nitaly_pt <- italy_lin %>% st_cast(\"POINT\")\npar(mfrow = c(2, 2), mar = c(1, 1, 1, 1), bg = NA)\nplot(st_geometry(italy), col = c(\"red\", \"yellow\", \"blue\"), main = \"MULTIPOLYGON\")\nplot(st_geometry(italy_pol), col = c(\"red\", \"yellow\", \"blue\"), main = \"POLYGON\")\nplot(st_geometry(italy_lin), col = c(\"red\", \"yellow\", \"blue\"), main = \"LINE\")\nplot(st_geometry(italy_pt), col = c(\"red\", \"yellow\", \"blue\"), main = \"POINT\")\n![\"Four](\"https://dieghernan.github.io/assets/img/blog/20190505_italycast-1.webp\")
What I missed when using st_cast was the possibility of breaking\nLINESTRING objects into subsegments:
![\"Outline](\"https://dieghernan.github.io/assets/img/blog/20190505_italycastsub-1.webp\")
One possible solution is to create LINESTRING objects for each consecutive\npair of POINT objects across the original geometry. Let’s check it:
par(mfrow = c(1, 2), mar = c(1, 1, 1, 1))\ntest <- ne_countries(country = \"spain\", returnclass = \"sf\") %>%\n st_cast(\"POLYGON\") %>%\n st_cast(\"LINESTRING\")\nplot(st_geometry(test), col = c(\"red\", \"yellow\", \"blue\"), main = \"LINESTRING\")\n\ngeom <- lapply(\n 1:(length(st_coordinates(test)[, 1]) - 1),\n function(i) {\n rbind(\n as.numeric(st_coordinates(test)[i, 1:2]),\n as.numeric(st_coordinates(test)[i + 1, 1:2])\n )\n }\n) %>%\n st_multilinestring() %>%\n st_sfc(crs = st_crs(test)) %>%\n st_cast(\"LINESTRING\")\nplot(st_geometry(geom), col = c(\"red\", \"yellow\", \"blue\"), main = \"AFTER FUNCTION\")\n![\"Two](\"https://dieghernan.github.io/assets/img/blog/20190505_testspain-1.webp\")
stdh_cast_substringFinally, I wrapped the solution into a function and extended it a little bit:
\n\nWhen the input is not a LINESTRING or a POLYGON, it returns an error and\nstops.
The function accepts sf objects with several rows or sfc objects with\nseveral geometries, and returns the same class as the input. In the case of\nsf objects, the input data.frame is added.
By default, the output is a MULTILINESTRING geometry. This has the benefit\nthat the output has the same number of geometries as the input. This can be\nmodified by setting the to parameter to LINESTRING, which only casts the\nMULTILINESTRING object into LINESTRING.
stdh_cast_substring <- function(x, to = \"MULTILINESTRING\") {\n ggg <- st_geometry(x)\n\n if (!unique(st_geometry_type(ggg)) %in% c(\"POLYGON\", \"LINESTRING\")) {\n stop(\"Input should be LINESTRING or POLYGON\")\n }\n for (k in 1:length(st_geometry(ggg))) {\n sub <- ggg[k]\n geom <- lapply(\n 1:(length(st_coordinates(sub)[, 1]) - 1),\n function(i) {\n rbind(\n as.numeric(st_coordinates(sub)[i, 1:2]),\n as.numeric(st_coordinates(sub)[i + 1, 1:2])\n )\n }\n ) %>%\n st_multilinestring() %>%\n st_sfc()\n\n if (k == 1) {\n endgeom <- geom\n }\n else {\n endgeom <- rbind(endgeom, geom)\n }\n }\n endgeom <- endgeom %>% st_sfc(crs = st_crs(x))\n if (class(x)[1] == \"sf\") {\n endgeom <- st_set_geometry(x, endgeom)\n }\n\n if (to == \"LINESTRING\") {\n endgeom <- endgeom %>% st_cast(\"LINESTRING\")\n }\n return(endgeom)\n}\nThe function could be improved in terms of performance. Given that it works at\nthe coordinate level, high-resolution objects introduce some delay.
\n\ntest100 <- ne_countries(\n continent = \"south america\",\n returnclass = \"sf\"\n) %>%\n st_cast(\"POLYGON\")\n\ntest50 <- ne_countries(50,\n continent = \"south america\",\n returnclass = \"sf\"\n) %>%\n st_cast(\"POLYGON\")\n\n\n\ninit <- Sys.time()\nt1 <- stdh_cast_substring(test100, \"LINESTRING\")\nend <- Sys.time()\nkable(end - init, format = \"markdown\")\n| x | \n
|---|
| 0.1729319 secs | \n
init <- Sys.time()\nt2 <- stdh_cast_substring(test50, \"LINESTRING\")\nend <- Sys.time()\nkable(end - init, format = \"markdown\")\n| x | \n
|---|
| 2.288558 secs | \n
par(mfrow = c(1, 1), mar = c(0, 0, 0, 0))\nplot(st_geometry(test50), col = NA, bg = \"#C6ECFF\")\nplot(st_geometry(ne_countries(50, returnclass = \"sf\")), col = \"#F6E1B9\", border = \"#646464\", add = T)\nplot(st_geometry(test50), col = \"#FEFEE9\", border = \"#646464\", add = T)\nplot(st_geometry(t2), col = c(\"red\", \"yellow\", \"blue\"), add = T, lwd = 0.5)\n![\"Map](\"https://dieghernan.github.io/assets/img/blog/20190505_benchmarkfunction-1.webp\")
There is a difference in performance: test100 has 15 polygons decomposed\ninto 914 substrings, while test50 has 80 polygons decomposed into 8,414\nsubstrings. In that sense, the original st_cast is much faster, although\nthis solution may work well in most cases.
This vignette shows how to use the database provided in the GitHub project\nCountry Codes and International Organizations & Groups\nwith the sf package in R.
\n\nlibrary(sf)\nlibrary(jsonlite)\nlibrary(rnaturalearth)\nlibrary(dplyr)\nThe first step is to read the provided database (in this example, the json\nfile) and extract one international organization. In this example, we will plot\nthe Commonwealth of Nations.
df <- fromJSON(\"https://raw.githubusercontent.com/dieghernan/Country-Codes-and-International-Organizations/master/outputs/Countrycodesfull.json\")\n# Identify Commonwealth acronym\norgsdb <- read.csv(\"https://raw.githubusercontent.com/dieghernan/Country-Codes-and-International-Organizations/master/outputs/CountrycodesOrgs.csv\") %>%\n distinct(org_id, org_name)\n\nkable(orgsdb[grep(\"Common\", orgsdb$org_name), ], format = \"markdown\")\n| \n | org_name | \norg_id | \n
|---|---|---|
| 25 | \nCommonwealth | \nC | \n
| 26 | \nCentral American Common Market | \nCACM | \n
| 30 | \nCaribbean Community and Common Market | \nCARICOM | \n
| 42 | \nCommonwealth of Independent States | \nCIS | \n
| 43 | \nCommon Market for Eastern and Southern Africa | \nCOMESA | \n
| 115 | \nSouthern Cone Common Market | \nMERCOSUR | \n
In our case, the value to search for is C. A function that extracts the\nmembership from the json database is also provided:
ISO_memcol <- function(df,\n orgtosearch) {\n ind <- match(orgtosearch, unlist(df[1, \"org_id\"]))\n or <- lapply(1:nrow(df), function(x) {\n unlist(df[x, \"org_member\"])[ind]\n })\n or <- data.frame(matrix(unlist(or)), stringsAsFactors = F)\n names(or) <- orgtosearch\n df2 <- as.data.frame(cbind(df, or, stringsAsFactors = F))\n return(df2)\n}\ndf_org <- ISO_memcol(df, \"C\")\nNow df_org has a new column, named C, containing the membership status\nof each country.
df_org %>%\n count(C) %>%\n kable(format = \"markdown\")\n| C | \nn | \n
|---|---|
| member | \n53 | \n
| NA | \n222 | \n
df_org %>%\n filter(!is.na(C)) %>%\n select(\n ISO_3166_3,\n NAME.EN,\n C\n ) %>%\n head() %>%\n kable(format = \"markdown\")\n| ISO_3166_3 | \nNAME.EN | \nC | \n
|---|---|---|
| ATG | \nAntigua & Barbuda | \nmember | \n
| AUS | \nAustralia | \nmember | \n
| BHS | \nBahamas | \nmember | \n
| BGD | \nBangladesh | \nmember | \n
| BRB | \nBarbados | \nmember | \n
| BLZ | \nBelize | \nmember | \n
In this example the rnaturalearth package is used for retrieving an sf\nobject. The code below replaces the data.frame part of the sf object with\nthe dedicated database.
testmap <- ne_countries(50,\n \"countries\",\n returnclass = \"sf\"\n) %>%\n select(ISO_3166_3 = adm0_a3) %>%\n full_join(df_org)\n\n# We also add tiny countries\ntiny <- ne_countries(50,\n \"tiny_countries\",\n returnclass = \"sf\"\n) %>%\n select(ISO_3166_3 = adm0_a3) %>%\n full_join(df_org)\n\n# Identify dependencies\nISOCommon <- df_org %>%\n filter(!is.na(C)) %>%\n select(\n ISO_3166_3.sov = ISO_3166_3,\n C_sov = C\n )\ntiny <- left_join(tiny, ISOCommon)\ntiny$C <- coalesce(tiny$C, tiny$C_sov)\nNow we will try to plot a map resembling the one presented in the\nWikipedia page for the\nCommonwealth.
\n\n![\"World](\"https://upload.wikimedia.org/wikipedia/commons/e/e2/Member_states_of_the_Commonwealth_of_Nations.svg\")
The map we will generate is presented in a Robinson projection, and the color\npalette will be based on the Wikipedia convention for Orthographic Maps,\nsince it is the one used in the example.
\n\n# Projecting the map\ntestmap_rob <- st_transform(testmap, \"+proj=robin\")\ntiny_rob <- st_transform(tiny, \"+proj=robin\")\n\n# Bounding box\nbbox <- st_linestring(rbind(\n c(-180, 90),\n c(180, 90),\n c(180, -90),\n c(-180, -90),\n c(-180, 90)\n)) %>%\n st_segmentize(5) %>%\n st_cast(\"POLYGON\") %>%\n st_sfc(crs = 4326) %>%\n st_transform(crs = \"+proj=robin\")\n\n# Plotting\npar(mar = c(0, 0, 0, 0), bg = NA)\nplot(bbox,\n col = \"#FFFFFF\",\n border = \"#AAAAAA\",\n lwd = 1.5\n)\nplot(\n st_geometry(testmap_rob),\n col = \"#B9B9B9\",\n border = \"#FFFFFF\",\n lwd = 0.1,\n add = T\n)\n\nplot(\n st_geometry(testmap_rob %>%\n filter(!is.na(C))),\n col = \"#346733\",\n border = \"#FFFFFF\",\n lwd = 0.1,\n add = T\n)\n\n# Finally, add tiny countries\n# All\nplot(\n st_geometry(tiny_rob),\n col = \"#000000\",\n bg = \"#B9B9B9\",\n add = T,\n pch = 21\n)\n# Dependencies\nplot(\n st_geometry(tiny_rob %>%\n filter(!is.na(C)) %>%\n filter(!is.na(ISO_3166_3.sov))),\n bg = \"#C6DEBD\",\n col = \"#000000\",\n pch = 21,\n add = T\n)\n# Independent\nplot(\n st_geometry(tiny_rob %>%\n filter(!is.na(C)) %>%\n filter(is.na(ISO_3166_3.sov))),\n bg = \"#346733\",\n col = \"#000000\",\n pch = 21,\n add = T\n)\nplot(bbox,\n col = NA,\n border = \"#AAAAAA\",\n lwd = 1.5,\n add = T\n)\n![\"World](\"https://dieghernan.github.io/assets/img/blog/20190427_mapfin-1.webp\")
Complete database of countries and territories, their different country codes\nunder common standards (ISO-3166, GEC (formerly FIPS), M49 (UN), STANAG\n(NATO), NUTS (EU), etc.) and their membership in different international\norganizations.
\n\nNote that blanks are presented as \"\" instead of NA since ISO-3166-ALPHA 2 for Namibia is NA.
.csvMain .csv file\n(link)\ncontaining:
| Field | \nDescription | \nSource | \nNotes | \n
|---|---|---|---|
ISO_3166_1 | \n ISO 3166-1 numeric | \nWikipedia | \n\n |
ISO_3166_2 | \n ISO 3166-1 alpha-2 | \nWikipedia | \n\n |
ISO_3166_3 | \n ISO 3166-1 alpha-3 | \nWikipedia | \n\n |
FIPS_GEC | \n Geopolitical Entities and Codes (GEC) | \nCIA World Factbook | \nFormerly FIPS 1PUB 10-4 (historical CIA reference) | \n
STANAG | \n STANAG 1059 Country Codes | \nCIA World Factbook | \nUsed by NATO | \n
M49 | \n UN Country Code | \nUN Stats | \n\n |
NUTS | \n NUTS 0 code | \nWikipedia | \nUsed by EU | \n
geonameId | \n geonameId | \ngeonames | \n\n |
continentcode | \n geonames Continent Code | \ngeonames | \n\n |
regioncode | \n UN Regional Code | \nUN Stats | \n\n |
interregioncode | \n Interregional Code | \nUN Stats | \n\n |
subregioncode | \n Subregion Code | \nUN Stats | \n\n |
ISO_3166_3.sov | \n Sovereign code | \nWikipedia, Statoids | \nIf non-independent | \n
.csvA single .csv file\n(link)\ndescribing the membership status of each country across 186 international\norganizations.
| Field | \nDescription | \n
|---|---|
ISO_3166_2 | \n Matches Countrycodes .csv | \n
ISO_3166_3 | \n Matches Countrycodes .csv | \n
NAME.EN | \n Matches Countrycodes .csv | \n
source | \n Main data source | \n
org_name | \n Name of the organization | \n
org_id | \n Abbreviation or internal ID | \n
org_member | \n Membership status | \n
.jsonThis .json file\n(link)\ncombines the previous files:
[\n ...\n {\n \"ISO_3166_1\": 12,\n \"ISO_3166_2\": \"DZ\",\n \"ISO_3166_3\": \"DZA\",\n \"ISO_Official\": true,\n \"FIPS_GEC\": \"AG\",\n \"STANAG\": \"DZA\",\n \"M49\": 12,\n \"geonameId\": 2589581,\n \"continentcode\": \"AF\",\n \"regioncode\": 2,\n \"subregioncode\": 15,\n \"currency\": \"DZD\",\n \"independent\": true,\n \"NAME.EN\": \"Algeria\",\n \"CONTINENT.EN\": \"Africa\",\n \"REGION.EN\": \"Africa\",\n \"SUBREGION.EN\": \"Northern Africa\",\n \"CAPITAL.EN\": \"Algiers\",\n \"NAME.ES\": \"Argelia\",\n \"CONTINENT.ES\": \"Africa\",\n \"REGION.ES\": \"África\",\n \"SUBREGION.ES\": \"África septentrional\",\n \"CAPITAL.ES\": \"Argel\",\n \"pop\": 34586184,\n \"area_km2\": 2381740,\n \"Developed\": \"Developing\",\n \"org_id\": [\"ABEDA\", \"ACP\", \"ADB\", \"AFDB\", \"AFESD\", \"AG\", \"AL\",\n ...\n ],\n \"org_member\": [\"member\", null, null, \"member\", \"member\", null,\n \"member\",\n ...\n ]\n },\n ...\n]\nA complementary function (intended to be used in R) has been developed:
\n\nISO_memcol = function(df, #Input dataframe\n orgtosearch #org id\n) {\n ind = match(orgtosearch, unlist(df[1, \"org_id\"]))\n or = lapply(1:nrow(df), function(x)\n unlist(df[x, \"org_member\"])[ind])\n or = data.frame(matrix(unlist(or)), stringsAsFactors = F)\n names(or) = orgtosearch\n df2 = as.data.frame(cbind(df, or, stringsAsFactors = F))\n return(df2)\n}\nProject discontinued due to the shutdown of Pebble.
\n\nBzel integrates the bezel into your watch face. Display minutes as digits,\nas a moving dot or as a fill in the bezel.
\n\n![\"Bzel](\"https://raw.githubusercontent.com/dieghernan/Bzel/master/store/BannerBzel.png\")
Bzel uses the bezel as an extra space for displaying the minutes.
\n\n\n\nAutomatic weekday translation is supported for:
\n\n![\"Animated](\"https://raw.githubusercontent.com/dieghernan/Bzel/master/store/BezelPTR.gif\")
\n Minute progress displayed around the Pebble Time Round bezel.
\n![\"Animated](\"https://raw.githubusercontent.com/dieghernan/Bzel/master/store/BezelPT.gif\")
\n The bezel minute indicator adapted to the Pebble Time screen.
\n![\"Animated](\"https://raw.githubusercontent.com/dieghernan/Bzel/master/store/BezelBW.gif\")
\n Monochrome version of the bezel-based minute display.
\n![\"Weather](\"https://icons.wxug.com/logos/PNG/wundergroundLogo_4c.png\"){kind=icon}
\n![\"OpenWeatherMap\"](\"https://openweathermap.org/themes/openweathermap/assets/vendor/owm/img/icons/logo_60x60.png\"){kind=icon}
\nMaster Key (pmkey.xyz) was a service for Pebble users that managed API keys\nthrough a unique PIN.
\n\nLicensed under the MIT license.
\n\nMade in Madrid, Spain ❤️
\n", "date_published": "2017-05-25T00:00:00+02:00", "image": "https://raw.githubusercontent.com/dieghernan/Bzel/master/store/BannerBzel.png", "summary": "Bzel integrates the bezel into your watch face. Display minutes as digits, as a moving dot or as a fill in the bezel.", "tags": ["discontinued","project","pebble","watchface","javascript","C"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/projects/7egment/", "url": "https://dieghernan.github.io/projects/7egment/", "title": "7egment", "content_html": "Project discontinued due to the shutdown of Pebble.
\n\n7egment is a customizable watch face based on the classic 7-segment display\nthat adds your location and current weather information in the language used on\nyour watch and smartphone.
\n\n![\"7egment](\"https://raw.githubusercontent.com/dieghernan/7egment/master/store/Banner.png\")
The 7egment layout combines time, location and weather on a Pebble display.
\n\n\n\n![\"Animated](\"https://raw.githubusercontent.com/dieghernan/7egment/master/store/PC.gif\")
\n The Pebble Classic edition uses a monochrome display.
\n![\"Animated](\"https://raw.githubusercontent.com/dieghernan/7egment/master/store/PT.gif\")
\n The Pebble Time edition presents the same layout on a color screen.
\n![\"Animated](\"https://raw.githubusercontent.com/dieghernan/7egment/master/store/PTR.gif\")
\n The Pebble Time Round edition adapts the layout to a circular screen.
\n\n\nMaster Key (pmkey.xyz) was a service for Pebble users that managed API keys\nthrough a unique PIN.
\n\nLicensed under the MIT license.
\n\nMade in Madrid, Spain ❤️
\n", "date_published": "2017-05-17T00:00:00+02:00", "image": "https://raw.githubusercontent.com/dieghernan/7egment/master/store/Banner.png", "summary": "7egment is a customizable watch face based on the classic 7-segment display that adds your location and current weather information in the language used on your watch and smartphone.", "tags": ["discontinued","project","pebble","watchface","javascript","C"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/projects/Sfera/", "url": "https://dieghernan.github.io/projects/Sfera/", "title": "Sfera", "content_html": "Project discontinued due to the shutdown of Pebble.
\n\nSfera for Pebble Time Round is a highly customizable watch face that gets\nthe most out of the smartwatch’s capabilities. Set your preferences and enjoy this\nbeautifully designed watch face.
\n\n![\"Sfera](\"https://raw.githubusercontent.com/dieghernan/Sfera/master/assets/SferaBanner.png\")
Users can choose analog, digital, dual or mixed clock modes.
\n\n\n\nAutomatic weekday translation is supported for:
\n\n![\"Animated](\"https://raw.githubusercontent.com/dieghernan/Sfera/master/assets/SferaGif.gif\")
The face also offers a battery arc, weather and an automatic night theme.
\n\n![\"Powered](\"https://poweredby.yahoo.com/purple.png\")
\n\n\nMaster Key (pmkey.xyz) was a service for Pebble users that managed API keys\nthrough a unique PIN.
\n\nLicensed under the MIT license.
\n\nMade in Madrid, Spain ❤️
\n", "date_published": "2017-03-14T00:00:00+01:00", "image": "https://raw.githubusercontent.com/dieghernan/Sfera/master/assets/SferaBanner.png", "summary": "Sfera for Pebble Time Round is a highly customizable watch face that gets the most out of the smartwatch’s capabilities. Set your preferences and enjoy this beautifully designed watch face.", "tags": ["discontinued","project","pebble","watchface","javascript","C"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] }, { "id": "https://dieghernan.github.io/projects/TextWatchClima/", "url": "https://dieghernan.github.io/projects/TextWatchClima/", "title": "TextWatch Clima", "content_html": "Project discontinued due to the shutdown of Pebble.
\n\nTextWatch Clima upgrades the classic TextWatch watch face by adding a set of\nnew capabilities.
\n\n![\"TextWatch](\"https://raw.githubusercontent.com/dieghernan/TextWatchClima/master/store/BannerRound.png\")
Weather and battery indicators can accompany the word-based time.
\n\nAvailable for all Pebble Classic, Pebble Time and Pebble 2 models
\n\n\n\n![\"TextWatch](\"https://raw.githubusercontent.com/dieghernan/TextWatchClima/master/store/BannerTime.png\")
Fuzzy time and animated text are optional display settings.
\n\n![\"TextWatch](\"https://raw.githubusercontent.com/dieghernan/TextWatchClima/master/store/BannerClass.png\")
The watch face supports multiple languages and optional date formats.
\n\n\n\n\n![\"Animated](\"https://raw.githubusercontent.com/dieghernan/TextWatchClima/master/store/ScrShClass.gif\")
\n The Classic edition supports multilingual display and optional weather.
\n![\"Animated](\"https://raw.githubusercontent.com/dieghernan/TextWatchClima/master/store/ScrShTime.gif\")
\n Text animation and fuzzy time are optional on this edition.
\n![\"Animated](\"https://raw.githubusercontent.com/dieghernan/TextWatchClima/master/store/ScrShRound.gif\")
\n Weather, battery status and a night theme are additional options.
\nLicensed under the MIT license.
\n\nMade in Madrid, Spain ❤️
\n", "date_published": "2017-02-16T00:00:00+01:00", "image": "https://raw.githubusercontent.com/dieghernan/TextWatchClima/master/store/BannerRound.png", "summary": "TextWatch Clima upgrades the classic TextWatch watch face by adding a set of new capabilities.", "tags": ["discontinued","project","pebble","watchface","javascript","C"], "authors": [{ "name": "Diego HH", "url": "https://dieghernan.github.io/" }] } ] }