Excess deaths for 2020

The reported COVID19 deaths in each country are often undercounts due to different reporting practices, or people dying of COVID19 related causes without ever being tested. One way to explore the true mortality effect of the pandemic is to look at “excess deaths” — the difference between death rates this year and the same time in previous years.

The Financial Times (and other media outlets) have been collecting data from many countries to try to measure this effect. Now the Human Mortality Database has made this much easier by publishing weekly deaths data for 13 countries.

Unfortunately, many countries do not have the processes in place to allow such data to be readily available. In Australia, for example, the most recent official deaths data is from 2018! The fact that there is no public organized national data collection for deaths during a pandemic is a sad indictment on the responsible government authorities.

Download the data

Here is some code to download and organize the data from the HMD

library(dplyr)
library(tidyr)
library(ggplot2)
stmf <- readr::read_csv("https://www.mortality.org/Public/STMF/Outputs/stmf.csv", skip=1)
stmf
## # A tibble: 29,994 x 19
##    CountryCode  Year  Week Sex   D0_14 D15_64 D65_74 D75_84  D85p DTotal
##    <chr>       <dbl> <dbl> <chr> <dbl>  <dbl>  <dbl>  <dbl> <dbl>  <dbl>
##  1 AUT          2000     1 m      6.28   184.   211.   237.  176.    814
##  2 AUT          2000     1 f      5.35   101.   141.   335.  471.   1053
##  3 AUT          2000     1 b     11.5    285.   355.   573.  643.   1867
##  4 AUT          2000     2 m      6.58   192.   217.   244.  180.    840
##  5 AUT          2000     2 f      5.81   109.   141.   335.  471.   1062
##  6 AUT          2000     2 b     12.2    302.   359.   580.  650.   1902
##  7 AUT          2000     3 m      7.73   226.   220.   248.  183.    886
##  8 AUT          2000     3 f      6.11   115.   152.   361.  507.   1141
##  9 AUT          2000     3 b     13.8    341.   378.   610.  684.   2027
## 10 AUT          2000     4 m      7.30   214.   217.   245.  181.    864
## # … with 29,984 more rows, and 9 more variables: R0_14 <dbl>,
## #   R15_64 <dbl>, R65_74 <dbl>, R75_84 <dbl>, R85p <dbl>, RTotal <dbl>,
## #   Split <dbl>, SplitSex <dbl>, Forecast <dbl>

The columns beginning with D show deaths for different age groups, while mortality rates are in the columns starting with R.

Wrangle the data into long form

Let’s drop the rates columns and wrangle it into a form more suitable for analysis. To keep it simple, I’ll only keep aggregate deaths over age and sex.

deaths <- stmf %>%
  janitor::clean_names() %>%
  select(country_code:d_total) %>%
  pivot_longer(5:10,
    names_to = "age", values_to = "deaths",
    names_pattern = "[d_]*([a-z0-9_p]*)"
  ) %>%
  filter(age == "total", sex == "b") %>%
  mutate(
    country = recode(country_code,
      AUT = "Austria",
      BEL = "Belgium",
      DEUTNP = "Germany",
      DNK = "Denmark",
      ESP = "Spain",
      FIN = "Finland",
      GBRTENW = "England & Wales",
      ISL = "Iceland",
      NLD = "Netherlands",
      NOR = "Norway",
      PRT = "Portugal",
      SWE = "Sweden",
      USA = "United States")
  ) %>%
  select(year, week, country, deaths)

The only tricky part here is in converting the age groups which are part of the column names into a variable using a regex via names_pattern.

deaths
## # A tibble: 9,998 x 4
##     year  week country deaths
##    <dbl> <dbl> <chr>    <dbl>
##  1  2000     1 Austria   1867
##  2  2000     2 Austria   1902
##  3  2000     3 Austria   2027
##  4  2000     4 Austria   1940
##  5  2000     5 Austria   1928
##  6  2000     6 Austria   1760
##  7  2000     7 Austria   1666
##  8  2000     8 Austria   1628
##  9  2000     9 Austria   1566
## 10  2000    10 Austria   1524
## # … with 9,988 more rows

Weekly deaths highlighting 2020

Now we can plot the deaths from this year compared to those from all other available years (the start year ranges from 1990 for Finland to 2017 for Iceland).

deaths %>%
  mutate(thisyear = (year == 2020)) %>%
  ggplot(aes(x=week, y=deaths, group=year)) +
    geom_line(aes(col=thisyear)) +
    facet_wrap(~ country, scales='free_y') +
    scale_color_manual(values=c("FALSE"='gray',"TRUE"='red')) +
    guides(col=FALSE) +
    ggtitle("Weekly deaths")

Clearly there are a few problems with the last week of available data from Finland, Norway and the United States. These are due to incomplete counts as noted in the meta data provided by HMD, and the same problem may affect other countries too. As more data are made available, earlier weeks may also be updated.

Note that there is a lag before the data are made available. We can see how far each country is behind by comparing the last week of available data with the current week number.

deaths %>%
  filter(year==2020) %>%
  group_by(country) %>%
  summarise(last_week = max(week)) %>%
  mutate(
    current_week = lubridate::week(Sys.Date()),
    lag = current_week - last_week
  )
## # A tibble: 13 x 4
##    country         last_week current_week   lag
##    <chr>               <dbl>        <dbl> <dbl>
##  1 Austria                14           21     7
##  2 Belgium                19           21     2
##  3 Denmark                17           21     4
##  4 England & Wales        18           21     3
##  5 Finland                18           21     3
##  6 Germany                16           21     5
##  7 Iceland                15           21     6
##  8 Netherlands            16           21     5
##  9 Norway                 17           21     4
## 10 Portugal               18           21     3
## 11 Spain                  19           21     2
## 12 Sweden                 18           21     3
## 13 United States          17           21     4

Before continuing, I’ll remove that last week of data for all countries (which will make the lag one week longer).

deaths <- deaths %>%
  group_by(country, year) %>%
  filter(!(year==2020 & week==max(week))) %>%
  select(year, week, country, deaths)

Estimate excess deaths

To estimate the total excess deaths up to the most recent data, we can first compute weekly median deaths over the last five years, then calculate the difference between the 2020 deaths numbers and these weekly medians. I’m using medians because Germany appears to have some big fluctuations at the start of the year and I’m not sure how reliable those numbers are.

recent_deaths <- deaths %>%
  filter(year >= 2015 & year <= 2019) %>%
  group_by(country,week) %>%
  summarise(median_deaths = median(deaths)) %>%
  ungroup()
excess_deaths <- deaths %>%
  filter(year >= 2015) %>%
  left_join(recent_deaths) %>%
  mutate(excess = deaths - median_deaths)
excess_deaths %>%
  mutate(thisyear = (year == 2020)) %>%
  ggplot(aes(x=week, y=excess, group=year)) +
  geom_hline(yintercept=0, col='gray') +
  geom_line(aes(col=thisyear)) +
  facet_wrap(~ country, scales='free_y') +
  scale_color_manual(values=c("FALSE"='gray',"TRUE"='red')) +
  guides(col=FALSE) +
  ggtitle("Weekly excess deaths")

This graph shows the excess deaths of the last six years, with 2020 highlighted in red. The other years help to see the natural variability in this calculation. Interestingly, many countries have negative excess deaths for the first 10 weeks of the year, probably due to precautions being taken before the virus had spread. So there were fewer car accidents, for example.

I’m fairly sure the numbers for the United States in the last week shown above are also incorrect, as the official COVID19 deaths have not stopped decreasing, but the data will presumably get corrected over time.

Finally, we can summarise the total excess deaths per country for 2020.

excess_deaths %>%
  filter(year==2020) %>%
  group_by(country) %>%
  summarise(
    excess = sum(excess),
    last_week = max(week),
    as_at = as.Date("2020-01-01") + 7*(last_week-1)
  ) %>%
  select(country, excess, as_at)
## # A tibble: 13 x 3
##    country         excess as_at     
##    <chr>            <dbl> <date>    
##  1 Austria          -204  2020-03-25
##  2 Belgium          6322  2020-04-29
##  3 Denmark          -485  2020-04-15
##  4 England & Wales 33581  2020-04-22
##  5 Finland          -260  2020-04-22
##  6 Germany          -602. 2020-04-08
##  7 Iceland             5  2020-04-01
##  8 Netherlands      4670  2020-04-08
##  9 Norway           -558  2020-04-15
## 10 Portugal         -168  2020-04-22
## 11 Spain           19530  2020-04-29
## 12 Sweden           1227  2020-04-22
## 13 United States    8457  2020-04-15
  • Some countries have negative excess deaths, due to early interventions.
  • The numbers for England & Wales and the United States are substantially lower than what the Financial Times is estimating, probably due to the available data. I suspect the data used by the FT is more recent.
  • These numbers are substantially larger than the numbers of reported COVID19 deaths at the same date.
  • Further discussion on “excess deaths” is available in this article from VoxEU.

Reproducibility details

options(width=100)
sessioninfo::session_info()
## ─ Session info ───────────────────────────────────────────────────────────────────────────────────
##  setting  value                       
##  version  R version 4.0.0 (2020-04-24)
##  os       Ubuntu 20.04 LTS            
##  system   x86_64, linux-gnu           
##  ui       X11                         
##  language en_AU:en                    
##  collate  en_AU.UTF-8                 
##  ctype    en_AU.UTF-8                 
##  tz       Australia/Melbourne         
##  date     2020-05-25                  
## 
## ─ Packages ───────────────────────────────────────────────────────────────────────────────────────
##  package     * version    date       lib source                            
##  assertthat    0.2.1      2019-03-21 [1] CRAN (R 4.0.0)                    
##  blogdown      0.18.1     2020-05-18 [1] Github (rstudio/blogdown@dbd9ca1) 
##  bookdown      0.19.1     2020-05-18 [1] Github (rstudio/bookdown@9b15639) 
##  cli           2.0.2      2020-02-28 [1] CRAN (R 4.0.0)                    
##  colorspace    1.4-1      2019-03-18 [1] CRAN (R 4.0.0)                    
##  crayon        1.3.4.9000 2020-05-18 [1] Github (r-lib/crayon@dcf6d44)     
##  digest        0.6.25     2020-02-23 [1] CRAN (R 4.0.0)                    
##  dplyr       * 0.8.5      2020-03-07 [1] CRAN (R 4.0.0)                    
##  ellipsis      0.3.1      2020-05-15 [1] RSPM (R 4.0.0)                    
##  evaluate      0.14       2019-05-28 [1] CRAN (R 4.0.0)                    
##  fansi         0.4.1      2020-01-08 [1] CRAN (R 4.0.0)                    
##  farver        2.0.3      2020-01-16 [1] CRAN (R 4.0.0)                    
##  generics      0.0.2      2018-11-29 [1] CRAN (R 4.0.0)                    
##  ggplot2     * 3.3.0      2020-03-05 [1] CRAN (R 4.0.0)                    
##  glue          1.4.1      2020-05-13 [1] RSPM (R 4.0.0)                    
##  gtable        0.3.0      2019-03-25 [1] CRAN (R 4.0.0)                    
##  htmltools     0.4.0.9003 2020-05-24 [1] Github (rstudio/htmltools@984b39c)
##  janitor       2.0.1      2020-04-12 [1] CRAN (R 4.0.0)                    
##  knitr         1.28       2020-02-06 [1] CRAN (R 4.0.0)                    
##  labeling      0.3        2014-08-23 [1] CRAN (R 4.0.0)                    
##  lifecycle     0.2.0      2020-03-06 [1] CRAN (R 4.0.0)                    
##  lubridate     1.7.8      2020-04-06 [1] CRAN (R 4.0.0)                    
##  magrittr      1.5        2014-11-22 [1] CRAN (R 4.0.0)                    
##  munsell       0.5.0      2018-06-12 [1] CRAN (R 4.0.0)                    
##  pillar        1.4.4      2020-05-05 [1] CRAN (R 4.0.0)                    
##  pkgconfig     2.0.3      2019-09-22 [1] CRAN (R 4.0.0)                    
##  purrr         0.3.4      2020-04-17 [1] CRAN (R 4.0.0)                    
##  R6            2.4.1      2019-11-12 [1] CRAN (R 4.0.0)                    
##  Rcpp          1.0.4.6    2020-04-09 [1] CRAN (R 4.0.0)                    
##  rlang         0.4.6.9000 2020-05-23 [1] Github (r-lib/rlang@691b5a8)      
##  rmarkdown     2.1        2020-01-20 [1] CRAN (R 4.0.0)                    
##  scales        1.1.1      2020-05-11 [1] RSPM (R 4.0.0)                    
##  sessioninfo   1.1.1      2018-11-05 [1] CRAN (R 4.0.0)                    
##  snakecase     0.11.0     2019-05-25 [1] CRAN (R 4.0.0)                    
##  stringi       1.4.6      2020-02-17 [1] CRAN (R 4.0.0)                    
##  stringr       1.4.0      2019-02-10 [1] CRAN (R 4.0.0)                    
##  tibble        3.0.1      2020-04-20 [1] CRAN (R 4.0.0)                    
##  tidyr       * 1.0.3      2020-05-07 [1] CRAN (R 4.0.0)                    
##  tidyselect    1.1.0      2020-05-11 [1] RSPM (R 4.0.0)                    
##  utf8          1.1.4      2018-05-24 [1] CRAN (R 4.0.0)                    
##  vctrs         0.3.0      2020-05-11 [1] RSPM (R 4.0.0)                    
##  withr         2.2.0      2020-04-20 [1] CRAN (R 4.0.0)                    
##  xfun          0.13       2020-04-13 [1] CRAN (R 4.0.0)                    
##  yaml          2.2.1      2020-02-01 [1] CRAN (R 4.0.0)                    
## 
## [1] /home/robjhyndman/R/x86_64-pc-linux-gnu-library/4.0
## [2] /usr/local/lib/R/site-library
## [3] /usr/lib/R/site-library
## [4] /usr/lib/R/library
comments powered by Disqus