Dane

The data comes from Eurostat’s demo_r_mwk table (converted from tsv to csv long format)

z00 <- read.csv("demo_r_mwk_ts.csv", sep = ';',  header=T, na.string="NA" )

We limit the analysis to 16 countries and remove week 99 (undefined?):

nuts <- c('BE', 'BG', 'CH', 'CZ', 'DE', 'DK', 'ES', 'FI', 'FR', 'HU', 
          'IT', 'LT', 'NO', 'PL', 'SE', 'UK')
z00 <- z00 %>% filter (week < 54 & geo %in% nuts)

Latest reported week:

lastO <- first(z00$date)
lastO
## [1] 2021-05-03
## 1114 Levels: 2000-01-03 2000-01-10 2000-01-17 2000-01-24 ... 2021-05-03
lastT <- first(z00$week)
lastT
## [1] 18
lastY <- substr(as.character(lastO), 1, 4)
lastY
## [1] "2021"

Excess deaths

z0 <- z00 %>% filter ( year >= 2015  & year < 2020 ) %>% as.data.frame
z1 <- z00 %>% filter ( year == 2020 ) %>% as.data.frame
z2 <- z00 %>% filter ( year == 2021 ) %>% as.data.frame

## means 2015--2019
zz0 <- z0 %>% group_by(geo,week) %>% summarise( year = 't19', vv = mean(value, na.rm=TRUE)) %>% as.data.frame
## `summarise()` has grouped output by 'geo'. You can override using the `.groups` argument.
## 2020
zz1 <- z1 %>% group_by(geo,week) %>% summarise( year = 't20', 
               vv = mean(value, na.rm=TRUE)) %>% as.data.frame
## `summarise()` has grouped output by 'geo'. You can override using the `.groups` argument.
## 2021
zz2 <- z2 %>% group_by(geo,week) %>% summarise( year = 't21', 
               vv = mean(value, na.rm=TRUE)) %>% as.data.frame
## `summarise()` has grouped output by 'geo'. You can override using the `.groups` argument.
zz1 <- bind_rows(zz0, zz1, zz2)

## change to %%
zz1p <- zz1 %>% pivot_wider(names_from = year, values_from = vv) %>%
   mutate (t20p = t20/t19 * 100, t21p = t21 / t19 * 100) %>%
   select(geo, week, t20p, t21p) %>%
   pivot_longer(cols=c(t20p, t21p), names_to="year", values_to="vv") %>%
      as.data.frame()
  
lastWeek <- last(zz1$week)
##lastWeek

## firstWeek <- lastWeek - windowLen
firstWeek <- firstYrWeek
##firstWeek
zz1 <- zz1 %>% filter ( week >= firstWeek  ) %>% as.data.frame

## zz1p = name = woj, week = dow, year, vv
p4 <- ggplot(zz1p, aes(x=week, y=vv, group=year, color=year)) +
 geom_smooth(method="loess", se=F, span=spanV, size=.4) +
 geom_point(size=.4, alpha=.5) +
 #facet_wrap( ~geo, scales = "free_y") +
 facet_wrap( ~geo, scales = "fixed") +
 xlab(label="") +
 ylab(label="") +
 geom_hline(yintercept = 200, color="firebrick", alpha=.3, size=0.4) +
 geom_hline(yintercept = 150, color="green1", alpha=.3, size=0.4) +
 ##theme_nikw()+
 ##labs(caption=source) +
 theme(plot.subtitle=element_text(size=9), legend.position="top")+
 scale_color_manual(name="Year: ", labels = c("2020", "2021"), 
    values = c("t20p"=farbe20, "t21p"=farbe21 )) +
 ggtitle(sprintf("Weekly excess deaths 2020--21 as %% of 2015--2019 average"),
         subtitle = "Zgony nadmiarowe wg tygodni 2020--2021  (jako % średniej z lat 2015--2019)")

p4
## `geom_smooth()` using formula 'y ~ x'

Summary

miss.median <- function(x) {
   # doing something here with x and arg1
   median(x, na.rm = T)
}

p5box <- zz1p %>% 
   ggplot(aes(x=reorder(geo, vv, FUN = miss.median), y=vv) ) + 
   geom_boxplot(fill=default_cyan) + 
   ylab("#") + 
   xlab('') +
   labs(caption='Source/źródło: Eurostat demo_r_mwk table') +
   theme(legend.position  = "none") +
   ggtitle(sprintf("Weekly excess deaths 2020--21 as %% of 2015--2019 average"), 
            subtitle = "Zgony nadmiarowe wg tygodni 2020--2021  (jako % średniej z lat 2015--2019)")
   #coord_flip()

####
p5box
## Warning: Removed 605 rows containing non-finite values (stat_boxplot).

zz1p.s <- zz1p %>% group_by(geo) %>% summarise (t = mean(vv, na.rm=T), m=median(vv, na.rm = T))

p3 <- zz1p.s %>%
   ggplot(aes(x = reorder(geo, t ))) +
   geom_bar(aes(y = t), stat="identity", alpha=.25, fill=default_cyan ) +
   geom_text(aes(label=sprintf("%.2f", t), y= t ), 
             vjust=0.25, hjust=1.25, size=2, color="black" ) +
   xlab(label="") +
   ylab(label="") +
   labs(caption='Source/źródło: Eurostat demo_r_mwk table') +
   ggtitle("Mean weekly excess deaths 2020--2021 as %% of 2015--2019 average",
            subtitle="Średnia tygodniowa wielkość zgonów nadmiarowych 2020--2021 (jako % średniej z lat 2015--2019)") +
   theme(axis.text = element_text(size = 7)) +
   coord_flip()

p3

p3m <- zz1p.s %>%
   ggplot(aes(x = reorder(geo, m ))) +
   geom_bar(aes(y = m), stat="identity", alpha=.25, fill=default_cyan ) +
   geom_text(aes(label=sprintf("%.2f", m), y= m ), 
             vjust=0.25, hjust=1.25, size=2, color="black" ) +
   xlab(label="") +
   ylab(label="") +
   ggtitle("Median of weekly excess deaths 2020--2021 as %% of 2015--2019 average",
           subtitle="Mediana tygodniowej wielkości zgonów nadmiarowych 2020--2021 (jako % średniej z lat 2015--2019)") +
   theme(axis.text = element_text(size = 7)) +
   labs(caption='Source/źródło: Eurostat demo_r_mwk table') +
   coord_flip()

p3m