Thematic Interactive Map

January 4, 2017
By

(This article was first published on Jkunst - R category, and kindly contributed to R-bloggers)

Last week all the rstatsosphere see the beautiful
Timo Grossenbacher
work.

The last month, yep, the past year I’ve working on create maps
easily with highcharter.
When I saw this chart I took as challege to replicate this nice
map in using highcharter:

So…

giphy gif source

Challenge accepted. it’s gonna be legen…
Me.

# packages ----------------------------------------------------------------
library(dplyr)
library(rmapshaper)
library(maptools)
library(highcharter)
library(geojsonio)
library(readr)
library(viridis)
library(purrr)

Data

The data used fhor this chart is the same using by Timo. But the workflow
was slightly modified:

  1. Read the shapefile with maptools::readShapeSpatial.
  2. Simplify the shapefile (optional step) using rmapshaper::ms_simplify.
  3. Then transform the map data to geojson using geojsonio::geojson_list.
# data --------------------------------------------------------------------
folder <- "data/thematicmap/"

map <- readShapeSpatial(file.path(folder, "gde-1-1-15.shp"))
map <- ms_simplify(map, keep = 1) # because ms_simplify fix the ü's
map <- geojson_list(map)

str(map, max.level = 1)
## List of 2
##  $ type    : chr "FeatureCollection"
##  $ features:List of 2324
##   .. [list output truncated]
##  - attr(*, "class")= chr "geo_list"
##  - attr(*, "from")= chr "SpatialPolygonsDataFrame"
str(map$features[[7]], max.level = 5)
## List of 4
##  $ type      : chr "Feature"
##  $ id        : int 6
##  $ properties:List of 3
##   ..$ Secondary_  : chr "Knonau"
##   ..$ BFS_ID      : int 7
##   ..$ rmapshaperid: int 6
##  $ geometry  :List of 2
##   ..$ type       : chr "MultiPolygon"
##   ..$ coordinates:List of 1
##   .. ..$ :List of 1
##   .. .. ..$ :List of 7
##   .. .. .. ..$ : num [1:2] 676327 230767
##   .. .. .. ..$ : num [1:2] 675655 233007
##   .. .. .. ..$ : num [1:2] 676458 233252
##   .. .. .. ..$ : num [1:2] 679285 230257
##   .. .. .. ..$ : num [1:2] 679590 229402
##   .. .. .. ..$ : num [1:2] 678887 229152
##   .. .. .. ..$ : num [1:2] 676327 230767
# this was to put the name on the tooltip
map$features <- map(map$features, function(x) {
  x$properties$name <- x$properties[["Secondary_"]] 
  x
})

data <- read_csv(file.path(folder, "avg_age_15.csv"))
data <- select(data, -X1)
data <- rename(data, value = avg_age_15)

# colors
no_classes <- 6

colors <- magma(no_classes + 2) %>% 
  rev() %>% 
  head(-1) %>% 
  tail(-1) %>% 
  gsub("FF$", "", .)

# brks <- quantile(data$value, probs = seq(0, 1, length.out = no_classes + 1))
brks <- c(min(data$value), c(40,42,44,46,48), max(data$value))
brks <- ifelse(1:(no_classes + 1) < no_classes, floor(brks), ceiling(brks))

Map

Create the raw map is straightforward. The main challege was replicate the
relief feature of the orignal map. This took some days to figure
how add the backgound image. I almost loose the hope but you know, new year,
so I tried a little more and it was possible :):

  1. First I searched a way to transform the tif image to geojson. I wrote
    a mail @frzambra a geoRexpert :D. and
    he kindly said me that I was wrong. And he was right. NEXT!
  2. I tried with use divBackgroundImage but with this the image use all the
    container… so… NEXT.
  3. Finally surfing in the web I met plotBackgroundImage argument in highcharts
    which is uesd to put and image only in plot container (inside de axis) and
    it works nicely. It was necessary hack the image using the preserveAspectRatio
    (html world) to center the image but nothing magical.
urlimage <- "https://raw.githubusercontent.com/jbkunst/r-posts/master/061-beautiful-thematic-maps-with-ggplot2-highcharter-version/02-relief-georef-clipped-resampled.jpg"

highchart(type = "map") %>% 
  # data part
  hc_add_series(mapData = map, data = data, type = "map",
                joinBy = c("BFS_ID", "bfs_id"), value = "value",
                borderWidth = 0) %>% 
  hc_colorAxis(dataClasses = color_classes(brks, colors)) %>% 
  # functionality
  hc_tooltip(headerFormat = "",
             pointFormat = "{point.name}: {point.value}",
             valueDecimals = 2) %>% 
  hc_legend(align = "right", verticalAlign = "bottom", layout = "vertical",
            floating = TRUE) %>%
  hc_mapNavigation(enabled = FALSE) %>% # if TRUE to zoom the relief image dont zoom.
  # info
  hc_title(text = "Switzerland's regional demographics") %>% 
  hc_subtitle(text = "Average age in Swiss municipalities, 2015") %>% 
  hc_credits(enabled = TRUE,
             text = "Map CC-BY-SA; Author: Joshua Kunst (@jbkunst) based mostly on Timo Grossenbacher (@grssnbchr) work, Geometries: ThemaKart, BFS; Data: BFS, 2016; Relief: swisstopo, 2016") %>% 
  # style
  hc_chart(plotBackgroundImage = urlimage,
           backgroundColor = "transparent",
           events = list(
             load = JS("function(){ $(\"image\")[0].setAttribute('preserveAspectRatio', 'xMidYMid') }")
           ))

open

DARY! Legendary.
Me.

Same as the original/ggplot2 version. I’m very happy with the result.
But anyway, there are some details:

  1. The image/relief need to be accesible in web. I don’t know how
    to add images as dependencies yet. I tried econding the image but didn’t work.
  2. I could not do the legend same as the original. So I used dataClasses
    instead of stops in hc_colorAxis.

To leave a comment for the author, please follow the link and comment on their blog: Jkunst - R category.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Search R-bloggers


Sponsors

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)