How we created a dashboard on internet speed in Europe

What’s the average internet speed in Europe? Our new dashboard shows the extent of the digital divide between, and within, European countries – here’s how it was made and what's the key R code behind it.

Ornaldo Gjergji – OBC Transeuropa

Published On: March 25th, 2021

The dashboard on the average internet speed in Europe created by OBC Transeuropa for EDJNet is based on data provided by Speedtest by Ookla Global Fixed and Mobile Network Performance Maps, based on analysis by Ookla of Speedtest Intelligence data for the first quarter of 2022.

The data consists in a gridded spatial data frame. Every tile of the grid contains several internet speed measurements, voluntarily sent by users through the Speedtest platform.

Joining tiles with European administrative units

In order to get a sense of the state of internet speed across Europe, I joined Ookla data with the shapefiles of Europe’s Nomenclature of Territorial Units for Statistics (NUTS), and Local Administrative Units (LAU).

Copy to Clipboard

## Libraries
if (!require("pacman")) install.packages("pacman")
pacman::p_load_gh("teamokla/ooklaOpenDataR") # Source for Speedtest data
pacman::p_load_gh("giocomai/latlon2map") # Source for European geometries
pacman::p_load(tidyverse, 
               sf, 
               here, 
               lubridate)

## Geometries
lau <- ll_get_lau_eu() %>% 
 rename("id" = "GISCO_ID", 
 "name" = "LAU_NAME") %>% 
 select(id, name)

nuts_3 <- ll_get_nuts_eu(level = 3, resolution = 1) %>% 
 rename("id" = "NUTS_ID", 
 "name" = "NAME_LATN") %>% 
 select(id, name)

nuts_2 <- ll_get_nuts_eu(level = 2, resolution = 1) %>%
 rename("id" = "NUTS_ID", 
 "name" = "NAME_LATN") %>% 
 select(id, name)

nuts_0 <- ll_get_nuts_eu(level = 0, resolution = 1) %>%
 rename("id" = "NUTS_ID", 
 "name" = "NAME_LATN") %>% 
 select(id, name)

## Vectors to loop 
year <- c(2019, 2020, 2021, 2022)
quarter <- c(1, 2, 3, 4)
level <- c("lau", "nuts_3", "nuts_2", "nuts_0")

## Folders
dir.create(here("data"))
dir.create(here("data", "raw_data"))

## Turn off spherical geometries
sf_use_s2(F)

## Loop to download raw data/analyse/write outputs
for (i in year) {
  
  for (j in quarter) {

if (!file.exists(here("data", "raw_data", paste(i, j, sep = "_") %>% paste0(".rds")))) {
 
 df <- get_performance_tiles("fixed", year = i, quarter = j, sf = T) %>%
 write_rds(here("data", "raw_data", paste(i, j, sep = "_") %>% paste0(".rds"))) 
 
 for (k in level) {
 
 dir.create(here("data", k)) 
 
 st_join(get(k), df) %>% 
 st_set_geometry(NULL) %>%
 group_by(id, name) %>% 
 summarise(across(contains("avg"), weighted.mean, w = tests, na.rm = T)) %>% 
 mutate(quarter = yq(paste(i, j, sep = "_")),
 avg_d = round(avg_d_kbps/1000, 2), 
 avg_u = round(avg_u_kbps/1000, 2),
 avg_l = round(avg_lat_ms, 2), 
 .keep = "unused") %>%
 write_csv(here("data", k, paste(k, i, j, sep = "_") %>% paste0(".csv")))
 
 }

} else {

df <- read_rds(here("data", "raw_data", paste(i, j, sep = "_") %>% paste0(".rds")))
 
 for (k in level) {
 
 dir.create(here("data", k)) 
 
 st_join(get(k), df) %>%
 st_set_geometry(NULL) %>%
 group_by(id) %>% 
 summarise(across(contains("avg"), weighted.mean, w = tests, na.rm = T)) %>% 
 mutate(quarter = yq(paste(i, j, sep = "_")),
 avg_d = round(avg_d_kbps/1000, 2),
 avg_u = round(avg_u_kbps/1000, 2),
 avg_l = round(avg_lat_ms, 2), 
 .keep = "unused") %>%
 write_csv(here("data", k, paste(k, i, j, sep = "_") %>% paste0(".csv")))
 
 }
 
 }
 
 }
 
}

## Timeseries
dir.create(here("data", "timeseries"))

for (k in level) {
  
  list.files(here("data", k)) %>%
    map_df(~read_csv(here("data", k, .x))) %>% 
    arrange(id, quarter) %>% 
    write_csv(here("data", "timeseries", paste("timeseries_", ".csv", sep = k)))
  
}

The values of download speed, upload speed, and latency for each administrative unit were obtained by calculating the average of all the observations within the administrative unit’s boundaries, weighted by the number of tests. Average download and upload speed values are expressed in megabit per second (Mbps), not to be mistaken with megabyte per second (MBps). Average latency values are expressed in milliseconds (ms).

Matching municipalities (LAU) with regions (NUTS 2)

To match European municipalities with higher administrative units I relied on the systematization of Eurostat correspondence tables made here by EDJNet. In this way I could assign European cities to their respective sub-national level administrative units and compare the differences among European regions.

Copy to Clipboard

## Libraries
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, 
               sf)

## We need to match the data at the city level with their respective regions and countries
## The dataset obtained by this matching will be used for the maps and the density plots
matcher <- read_csv("https://raw.githubusercontent.com/EDJNet/lau_centres/main/lau_nuts_concordance_by_geo/lau_2020_nuts_2021_concordance_by_geo.csv") %>%
 select(gisco_id, nuts_2) %>% 
 left_join(nuts_2 %>% 
 st_set_geometry(NULL) %>% 
 rename("nuts_2" = "id",
 "region" = "name"))

lau_matched <- read_csv(here("data", "lau", "lau_2022_1.csv")) %>% 
 mutate(country_id = substr(id, 1, 2)) %>% 
 drop_na(avg_d) %>% #some small cities do not have data and their internet speed is NA
 left_join(matcher, by = c("id" = "gisco_id")) %>% 
 left_join(lau) %>% 
 left_join(nuts_0 %>% 
 st_set_geometry(NULL) %>% 
 rename("country_id" = "id", "Country" = "name")) %>% 
 mutate(City = name,
 Country = str_replace_all(Country, "/", "-"),
 region = str_replace_all(region, "/", "-"),
 "Average Download Speed" = avg_d %>% paste0(" Mbps"),
 "Average Upload Speed" = avg_u %>% paste0(" Mbps"),
 "Average Latency" = avg_l %>% paste0(" ms")) %>% 
 st_set_geometry(.$geometry)

This matching makes it possible to compare European regions both intranationally and internationally. It is possible to browse a map with all the municipalities within a given region, as well as to observe the distribution of the average internet speed in the municipalities of a given region and compare it with the distribution of average speed in the other municipalities of the same country as well as in Europe as a whole.

Mapping

In order to generate the maps for every European region I used a simple loop and saved the maps as html files.

Copy to Clipboard

## Libraries
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, 
               sf, 
               here, 
               leaflet, 
               leaflet.extras, 
               leafpop, 
               cartography, 
               htmlwidgets)

## Folders for outputs
dir.create(here("visualizations"))
dir.create(here("visualizations", "maps"))

setwd(here("visualizations", "maps"))

## NUTS2 regions maps
region <- lau_matched %>% 
 pull(region) %>% 
 unique()

for (i in region) {
 
 lau_i <- lau_matched %>% filter(region == i)
 
 bins <- c(0,10,20,30,40,50,60,70,80,90,100,120,140,160,180,200,1200)
 
 qpal <- colorBin(palette = cartography::carto.pal("turquoise.pal", 20), 
 domain = lau_i$avg_d,
 bins = bins)
 
 map <- leaflet() %>%
 addProviderTiles(providers$CartoDB.PositronNoLabels) %>% 
 addPolygons(data = lau_i,
 fillColor = ~qpal(lau_i$avg_d),
 fillOpacity = 1,
 smoothFactor = .2,
 color = "#5d5d5d",
 opacity = .2,
 weight = .25,
 label = ~City,
 group = "City",
 popup = popupTable(lau_i,
 zcol = c(12:15), 
 row.numbers = F,
 feature.id = F)) %>% 
 addLegend(pal = qpal,
 values = lau_i$avg_d,
 opacity = 1,
 position = "bottomright",
 title = "Download speed (Mbps)") %>%
 addSearchFeatures(targetGroups = 'City',
 options = searchFeaturesOptions(zoom = 11,
 openPopup = T,
 hideMarkerOnCollapse = T))
 
 saveWidget(map, i %>% paste0(".html"), selfcontained = T)
 
}

## Countries map
country <- lau_matched %>%
 pull(Country) %>% 
 unique()

for (i in country) {
 
 lau_i <- lau_matched %>% filter(Country == i)
 
 bins <- c(0,10,20,30,40,50,60,70,80,90,100,120,140,160,180,200,1200)
 
 qpal <- colorBin(palette = cartography::carto.pal("turquoise.pal", 20), 
 domain = lau_i$avg_d,
 bins = bins)
 
 map <- leaflet() %>%
 addProviderTiles(providers$CartoDB.PositronNoLabels) %>% 
 addPolygons(data = lau_i,
 fillColor = ~qpal(lau_i$avg_d),
 fillOpacity = 1,
 smoothFactor = .2,
 color = "#5d5d5d",
 opacity = .2,
 weight = .25,
 label = ~City,
 group = "City",
 popup = popupTable(lau_i,
 zcol = c(12:15), 
 row.numbers = F,
 feature.id = F)) %>% 
 addLegend(pal = qpal,
 values = lau_i$avg_d,
 opacity = 1,
 position = "bottomright",
 title = "Download speed (Mbps)") %>%
 addSearchFeatures(targetGroups = 'City',
 options = searchFeaturesOptions(zoom = 11,
 openPopup = T,
 hideMarkerOnCollapse = T)) 
 
 saveWidget(map, i %>% paste0(".html"), selfcontained = T)
 
}

## European maps
euro_maps <- c("nuts_0", "nuts_2", "nuts_3")

for (i in euro_maps) {
 
 level_i <- read_csv(here("data", i, i %>% paste("2022_1.csv", sep = "_"))) %>% 
 left_join(get(i)) %>% 
 mutate(Name = name, 
 "Average Download Speed" = avg_d %>% paste0(" Mbps"),
 "Average Upload Speed" = avg_u %>% paste0(" Mbps"),
 "Average Latency" = avg_l %>% paste0(" ms")) %>% 
 st_set_geometry(.$geometry)
 
 bins <- c(0,10,20,30,40,50,60,70,80,90,100,120,140,160,180,200,1200)
 
 qpal <- colorBin(palette = cartography::carto.pal("turquoise.pal", 20), 
 domain = level_i$avg_d,
 bins = bins)
 
 map <- leaflet() %>%
 addProviderTiles(providers$CartoDB.PositronNoLabels) %>% 
 addPolygons(data = level_i,
 fillColor = ~qpal(level_i$avg_d),
 fillOpacity = 1,
 smoothFactor = .2,
 color = "#5d5d5d",
 opacity = .2,
 weight = .25,
 label = ~Name,
 group = "Name",
 popup = popupTable(level_i,
 zcol = c(8:11), 
 row.numbers = F,
 feature.id = F)) %>% 
 addPolylines(data = nuts_0 %>% 
 st_cast("MULTILINESTRING"),
 fillColor = NULL,
 color = "#FAF9F6",
 opacity = 1,
 weight = .65) %>% 
 addLegend(pal = qpal,
 values = lau_i$avg_d,
 opacity = 1,
 position = "bottomright",
 title = "Download speed (Mbps)") %>%
 addSearchFeatures(targetGroups = 'City',
 options = searchFeaturesOptions(zoom = 11,
 openPopup = T,
 hideMarkerOnCollapse = T)) %>% 
 setView(13.3, 47.13, 5)
 
 saveWidget(map, i %>% paste0(".html"), selfcontained = T)
 
}
view rawmaps.R hosted with ❤ by GitHub

Why are legend scales the same for every map?

The distribution of European municipalities’ average download speed is right skewed.

In order to find a compromise between completeness of information and readability, every map has the same legend scale values. This choice has been made in order to prevent the cognitive dissonance that could be engendered by having a given download speed value coloured in green in a map, and in blue in the following one.

In other words, in many maps most of the values that appear in the legend are not plotted because every download speed value is associated with the same colour gradient across the dashboard.

Density plots

These plots show the distribution of the European municipalities’ average internet speed, comparing the distributions of up to three different geographical levels: European, national, and regional.

Given the European municipalities’ distribution shape, the x axis has been limited to 300 Mbps if in the regional subset of data there are no cities with average download speed values higher than 300 Mbps. Whereas if there are values higher than 300 Mbps, the x axis is limited to 350 Mbps. Also, if the region consists in one city, as in the case of Berlin, it is plotted as a segment.

Copy to Clipboard

## Libraries
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, 
               here, 
               cowplot, 
               ggtext)

dir.create(here("visualizations", "density_plots"))

## Density plots regions

region <- lau_matched %>%
 pull(region) %>% 
 unique()

for (i in region) {
 
 region_i <- lau_matched %>% filter(region == i)
 
 country_i <- lau_matched %>% filter(country_id == unique(region_i$country_id))
 
 if(nrow(region_i) == 1) {
 
 plt <- ggplot() + 
 geom_segment(aes(x = 64, y = 0, xend = 64, yend = Inf), size = 1, linetype = 2) +
 geom_density(data = lau_matched, aes(avg_d), color = "#283377", fill = "#283377", alpha = .2, size = 1) +
 geom_density(data = country_i, aes(avg_d), color = "#337728", fill = "#337728", alpha = .2, size = 1) +
 geom_segment(aes(x = region_i$avg_d, y = 0, xend = region_i$avg_d, yend = Inf), size = 1, linetype = 1, color = "#a9073b") +
 scale_x_continuous(limits = c(0, 305), expand = c(0,0), breaks = c(0, 30, 50, 64, 100, 150, 200, 250, 300)) +
 scale_y_continuous(expand = c(0, 0)) +
 xlab("Download speed (Mbps)") +
 ylab("") +
 labs(title = "Municipalities' average download speed distribution in Europe, " %>% 
 paste0(unique(country_i$Country)) %>% 
 paste0(", and ") %>% 
 paste0(unique(region_i$region)) %>% 
 paste0(""),
 subtitle = "64 Mbps is the median download speed of European cities") +
 theme_half_open() +
 theme(plot.title = element_markdown(hjust = .5),
 plot.subtitle = element_text(hjust = .5),
 axis.line = element_line(colour = "black", size = 1),
 axis.ticks = element_line(colour = "black", size = 1))
 
 ggsave(filename = here("visualizations", "density_plots", i %>% paste0(".png")), plt, width = 23, height = 13, units = "cm", dpi = 333)
 
 } else { 
 
 if(max(region_i$avg_d) > 250) {
 
 plt <- ggplot() + 
 geom_segment(aes(x = 64, y = 0, xend = 64, yend = Inf), size = 1, linetype = 2) +
 geom_density(data = lau_matched, aes(avg_d), color = "#283377", fill = "#283377", alpha = .2, size = 1) +
 geom_density(data = country_i, aes(avg_d), color = "#337728", fill = "#337728", alpha = .2, size = 1) +
 geom_density(data = region_i, aes(avg_d), color = "#a9073b", fill = "#a9073b", alpha = .2, size = 1) +
 scale_x_continuous(limits = c(0, 355), expand = c(0,0), breaks = c(0, 30, 50, 64, 100, 150, 200, 250, 300, 350)) +
 scale_y_continuous(expand = c(0,0)) +
 xlab("Download speed (Mbps)") +
 ylab("") +
 labs(title = "Municipalities' average download speed distribution in Europe, " %>% 
 paste0(unique(country_i$Country)) %>% 
 paste0(", and ") %>% 
 paste0(unique(region_i$region)) %>% 
 paste0(""),
 subtitle = "64 Mbps is the median download speed of European cities") +
 theme_half_open() +
 theme(plot.title = element_markdown(hjust = .5),
 plot.subtitle = element_text(hjust = .5),
 axis.line = element_line(colour = "black", size = 1),
 axis.ticks = element_line(colour = "black", size = 1))
 
 ggsave(filename = here("visualizations", "density_plots", i %>% paste0(".png")), plt, width = 23, height = 13, units = "cm", dpi = 333)
 
 } else {
 
 plt <- ggplot() + 
 geom_segment(aes(x = 64, y = 0, xend = 64, yend = Inf), size = 1, linetype = 2) +
 geom_density(data = lau_matched, aes(avg_d), color = "#283377", fill = "#283377", alpha = .2, size = 1) +
 geom_density(data = country_i, aes(avg_d), color = "#337728", fill = "#337728", alpha = .2, size = 1) +
 geom_density(data = region_i, aes(avg_d), color = "#a9073b", fill = "#a9073b", alpha = .2, size = 1) +
 scale_x_continuous(limits = c(0, 305), expand = c(0,0), breaks = c(0, 30, 50, 64, 100, 150, 200, 250, 300)) +
 scale_y_continuous(expand = c(0,0)) +
 xlab("Download speed (Mbps)") +
 ylab("") +
 labs(title = "Municipalities' average download speed distribution in Europe, " %>% 
 paste0(unique(country_i$Country)) %>% 
 paste0(", and ") %>% 
 paste0(unique(region_i$region)) %>% 
 paste0(""),
 subtitle = "64 Mbps is the median download speed of European cities") +
 theme_half_open() +
 theme(plot.title = element_markdown(hjust = .5),
 plot.subtitle = element_text(hjust = .5),
 axis.line = element_line(colour = "black", size = 1),
 axis.ticks = element_line(colour = "black", size = 1))
 
 ggsave(filename = here("visualizations", "density_plots", i %>% paste0(".png")), plt, width = 23, height = 13, units = "cm", dpi = 333)
 
 } 
 
 }
 
}

## Density plots countries

country <- lau_matched %>%
 pull(Country) %>% 
 unique()

for (i in country) {
 
 country_i <- lau_matched %>% filter(Country == i)
 
 
 if(max(country_i$avg_d) > 250) {
 
 plt <- ggplot() + 
 geom_segment(aes(x = 64, y = 0, xend = 64, yend = Inf), size = 1, linetype = 2) +
 geom_density(data = lau_matched, aes(avg_d), color = "#283377", fill = "#283377", alpha = .2, size = 1) +
 geom_density(data = country_i, aes(avg_d), color = "#337728", fill = "#337728", alpha = .2, size = 1) +
 scale_x_continuous(limits = c(0, 355), expand = c(0,0), breaks = c(0, 30, 50, 64, 100, 150, 200, 250, 300, 350)) +
 scale_y_continuous(expand = c(0,0)) +
 xlab("Download speed (Mbps)") +
 ylab("") +
 labs(title = "Municipalities' average download speed distribution in Europe, and " %>% 
 paste0(unique(country_i$Country)) %>%
 paste0(""),
 subtitle = "64 Mbps is the median download speed of European cities") +
 theme_half_open() +
 theme(plot.title = element_markdown(hjust = .5),
 plot.subtitle = element_text(hjust = .5),
 axis.line = element_line(colour = "black", size = 1),
 axis.ticks = element_line(colour = "black", size = 1))
 
 ggsave(filename = here("visualizations", "density_plots", i %>% paste0(".png")), plt, width = 23, height = 13, units = "cm", dpi = 333)
 
 } else {
 
 plt <- ggplot() + 
 geom_segment(aes(x = 64, y = 0, xend = 64, yend = Inf), size = 1, linetype = 2) +
 geom_density(data = lau_matched, aes(avg_d), color = "#283377", fill = "#283377", alpha = .2, size = 1) +
 geom_density(data = country_i, aes(avg_d), color = "#337728", fill = "#337728", alpha = .2, size = 1) +
 scale_x_continuous(limits = c(0, 305), expand = c(0,0), breaks = c(0, 30, 50, 64, 100, 150, 200, 250, 300)) +
 scale_y_continuous(expand = c(0,0)) +
 xlab("Download speed (Mbps)") +
 ylab("") +
 labs(title = "Municipalities' average download speed distribution in Europe, and " %>% 
 paste0(unique(country_i$Country)) %>%
 paste0(""),
 subtitle = "64 Mbps is the median download speed of European cities") +
 theme_half_open() +
 theme(plot.title = element_markdown(hjust = .5),
 plot.subtitle = element_text(hjust = .5),
 axis.line = element_line(colour = "black", size = 1),
 axis.ticks = element_line(colour = "black", size = 1))
 
 ggsave(filename = here("visualizations", "density_plots", i %>% paste0(".png")), plt, width = 23, height = 13, units = "cm", dpi = 333)
 
 } 
 
}
view rawdensity.R hosted with ❤ by GitHub

The dashboard

The last step was to join all these elements in a dashboard to make the data available and fully accessible to everyone, making it possible to have a look at the differences in internet speed across European regions…

…and at the municipalities’ internet speed within single European countries.

How we created a dashboard on internet speed in Europe

Joining tiles with European administrative units

Matching municipalities (LAU) with regions (NUTS 2)

Mapping

Why are legend scales the same for every map?

Density plots

The dashboard

Tags:

Licence:

Stay up to date with our newsletter!

EDJNet - The European Data Journalism Network