Overlaying heatmap to image

Question

I'm looking to build a heat map of tickets sold and apply it over the actual image of the stadium.

Here is my current code:

# plot with picture as layer
library(ggplot2)
library(magick) 

#download picture of the football pitch 
image_url <- "https://www.kindpng.com/picc/m/202-2026208_soccer-field-coloring-page-png-download-circle-transparent.png"
pic <- image_read(image_url)

#Build the dataset which has the geometry for the different blocks 

ids <- factor(c("block_1",
                "block_2",
                "block_3",
                "block_4",
                "block_5"))

values <- data.frame(
  id = ids,
  value = c(3,
            4,
            2,
            1,
            10)
)

#input the coordinates for the polygons 
positions <- data.frame(
  id = rep(ids, each = 4),
  x = c(1, 3, 3,1,  #block1
        3.75, 6.25, 6.25, 3.75, #block2
        3.75, 6.25, 6.25, 3.75, #ect.. 
        2,3,3,2,
        7,8,8,7),
  y = c(10, 10, 8, 8,
        9, 9, 8,8,
        2, 2, 1,1,
        6.5,6.5,3.5,3.5,
        6.5,6.5,3.5,3.5)
  )


datapoly <- merge(values, positions, by = c("id"))

#plot out the results

ggplot(datapoly, aes(x = x, y = y)) +
  annotation_raster(pic, xmin = 3, xmax =7, ymin = 8, ymax = 2) +
  geom_polygon(aes(fill = value, group = id,colour=id)) +
  scale_x_continuous(limits = c(0,10),breaks = c(seq(1,10,1))) +
  scale_y_continuous(limits = c(0,10),breaks = c(seq(1,10,1))) +
  geom_point(alpha=0) +theme_light()+theme(aspect.ratio = 0.75,
                                           panel.grid.minor = element_line(color = 2,
                                                                             size = 0.25,
                                                                             linetype = 1),
                                           panel.grid.major = element_line(color = 1,
                                                                           size = 0.25,
                                                                           linetype = 1)) 

It gives me this output:

Having read into the a few similar questions like this one, I've decided to plot out each of my polygons and fill them one at a time.

My question is I feel that this is a very long way round the problem and if I need to make any changes or change the stadium it will be very time consuming.

Is there a better way of doing this if sf? I would really prefer to have an output like an actual stadium, like this.

Answer 1

I think this should be pretty straightforward to do. To somewhat breakdown your problem into parts, you want to:

• Make a map, with polygons representing each ticketing area,
• Join in ticket sales with each of the polygons, and colour accordingly.

In this sense, I would think the process is much the same as mapping the world or a country, and colouring each country/state by a category such as population size (or area, or GDP etc).

I apologise for this very basic example, but it might help break it down for you.

So basically we take our set of polygons, in this case a map of New Zealand, but in your case it will be the map of the stadium. And we plot and colour by whatever category we like, in this case the population.

library(tidyverse)
library(sf)
library(spData)
library(tmap)

# built in data of the regions of NZ
nz

# Simple feature collection with 16 features and 6 fields
# Geometry type: MULTIPOLYGON
# Dimension:     XY
# Bounding box:  xmin: 1090144 ymin: 4748537 xmax: 2089533 ymax: 6191874
# Projected CRS: NZGD2000 / New Zealand Transverse Mercator 2000
# First 10 features:
#                 Name Island Land_area Population Median_income Sex_ratio                           geom
# 1          Northland  North 12500.561     175500         23400 0.9424532 MULTIPOLYGON (((1745493 600...
# 2           Auckland  North  4941.573    1657200         29600 0.9442858 MULTIPOLYGON (((1803822 590...
# 3            Waikato  North 23900.036     460100         27900 0.9520500 MULTIPOLYGON (((1860345 585...
# 4      Bay of Plenty  North 12071.145     299900         26200 0.9280391 MULTIPOLYGON (((2049387 583...
# 5           Gisborne  North  8385.827      48500         24400 0.9349734 MULTIPOLYGON (((2024489 567...
# 6        Hawke's Bay  North 14137.524     164000         26100 0.9238375 MULTIPOLYGON (((2024489 567...
# 7           Taranaki  North  7254.480     118000         29100 0.9569363 MULTIPOLYGON (((1740438 571...
# 8  Manawatu-Wanganui  North 22220.608     234500         25000 0.9387734 MULTIPOLYGON (((1866732 566...
# 9         Wellington  North  8048.553     513900         32700 0.9335524 MULTIPOLYGON (((1881590 548...
# 10        West Coast  South 23245.456      32400         26900 1.0139072 MULTIPOLYGON (((1557042 531...

tm_shape(nz)+
  tm_polygons(col = 'Population')

Now, this all assumes you have an electronic version of the map of the stadium, and you will also need to have ticketing areas (the individual polygons) numbered or identified in some way that you can combine in ticket sales. This is probably going to be the easiest, or the hardest part. Your options are probably either:

• Acquire the electronic map of the stadium with labelled ticketing areas from the stadium/client/workplace (if this is a real-world example)
• Manually create a map in something like Google Earth (or maybe some other GIS software). I guess you'd want to essentially draw a polygon, and name it with the ticketing area label or ID. Although manual and a little slow, once you have this it should only take a small amount of effort to modify the stadium.

Once you've got your electronic stadium map (let's call it the shapefile), then you can join in ticket sales based on the polygon IDs. This is pretty simple using the sf package in R, and can be plotted with any package you like including base R graphics, ggplot2, leaflet, tmap (like my examples), etc...

# pull out region names
nz %>% 
  st_drop_geometry %>% 
  select(Name) %>% 
  
  # make up some ticket sales
  mutate(
    ticket_sales = runif(16, 0, 10)
  ) %>% 
  {. ->> my_tickets}

#                 Name ticket_sales
# 1          Northland    8.0724858
# 2           Auckland    2.8206753
# 3            Waikato    4.9444361
# 4      Bay of Plenty    4.0886536
# 5           Gisborne    0.9570615
# 6        Hawke's Bay    2.1361859
# 7           Taranaki    6.6003576
# 8  Manawatu-Wanganui    1.9189200
# 9         Wellington    0.6957359
# 10        West Coast    6.2897355
# 11        Canterbury    8.0833498
# 12             Otago    0.3928478
# 13         Southland    1.0016767
# 14            Tasman    6.7290024
# 15            Nelson    4.9923827
# 16       Marlborough    2.8184060

# now, join in ticket sales and colour the map accoridngly
nz %>% 
  left_join(my_tickets) %>% 
  tm_shape(.)+
  tm_polygons(col = 'ticket_sales')

In short, what you will need to do is:

1. Get a shapefile version of your stadium (or if you already have one, provide it and I'll do an example using it)
2. Then use pretty simple (spatial) data handling code to combine and plot the data

If you're after some good examples and tutorials of spatial data in R, check out Geocomputation with R.