How was the Slovak COVID-19 full-scale testing experiment?
Miroslav Štefánik (miroslav.stefanik@savba.sk)
Institute of Economic Research, Slovak Academy of Sciences
#rm(list=ls( ))
require(dplyr)
require(ggplot2)
require(ggrepel)
library(COVID19)
library(reshape2)
library(ggpubr)
library(zoo)
library(httr)
library(jsonlite)
library(eurostat)
library(knitr)
library(stringr)
library(magrittr)
library(data.table)
library(matrixStats)
world<-read.csv("https://covid.ourworldindata.org/data/owid-covid-data.csv")
world$date <- as.Date(world$date,format='%Y-%m-%d')
vari<-c("date", "location", "total_cases_per_million", "new_cases", "new_cases_smoothed", "new_cases_per_million", "new_cases_smoothed_per_million", "total_deaths_per_million", "new_tests_smoothed_per_thousand", "tests_per_case", "positive_rate", "stringency_index", "hosp_patients_per_million", "new_deaths_smoothed_per_million", "population")
op<-c("2020-03-01")
SK<-subset(world, location=="Slovakia" & date>=op, vari)
CZ<-subset(world, location=="Czechia" & date>=op, vari)
AT<-subset(world, location=="Austria" & date>=op, vari)
HU<-subset(world, location=="Hungary" & date>=op, vari)
PL<-subset(world, location=="Poland" & date>=op, vari)
#ua<-subset(world, location=="Ukraine" & date>="2020-09-01", vari)In Autumn 2020, Slovakia decided for an innovative measure in combating the second wave of the COVID-19 pandemic. The measure combines a semi-lock-down with full-scale testing of its population (older than 10), using rapid antigen (AG) testing. Using daily data on the COVID-19 Pandemic, we aim to describe the course of the main disease spreading indicators after the Slovak full-scale testing experiment. This report is being updated automatically on daily basis.
print(paste("Last update:", max(SK$date)[is.numeric(SK$new_cases_smoothed_per_million)]))## [1] "Last update: 2021-07-30"We start our observation period on the day when the rate of positive tests reached 5 percent. We align the observation points for the Czech Republic and Slovakia in relative time since reaching the threshold of 5 percent of positive tests. In the case of Slovakia the observation period starts on 25th of September; in the case of the Czech Republic on 5th of September 2020. Unfortunatelly, Slovakia decided to include the AG teting into the calculation of the rate of positive tests. Because other countries ony report the rate of positive PCR tests, including AG test limits international comparability of this indicator since the end of October 2020.
countriesNames <- c("Slovakia", "Czechia", "Austria", "Hungary", "Poland")
g_var<-c("date", "location", "positive_rate")
g_df<-subset(world, location %in% countriesNames, g_var)
g_df<-subset(g_df, date>="2020-06-01")
ag_daily<-read.csv("https://raw.githubusercontent.com/Institut-Zdravotnych-Analyz/covid19-data/main/DailyStats/OpenData_Slovakia_Covid_DailyStats.csv", sep = ";")
ggplot(data = g_df, aes(x=date, y=positive_rate, colour=location)) +
geom_point() +
geom_line() +
geom_hline(yintercept = 0.05) +
geom_text(data=g_df, aes(x=date, y=positive_rate), label="Outbreak of the Autumn wave", x=as.Date("2020-07-01"), y=0.06, show.legend = FALSE) +
xlab("Date")+
ylab("The share of positive tests") +
scale_x_date(date_breaks = "1 month", date_labels = "%D") +
labs(title = "Rate of positive tests", colour = "Country", caption="Source: European Centre for Disease Prevention and Control (ECDC)") +
theme(plot.caption = element_text(hjust = 0), legend.position = "top")+
scale_color_manual(values = c("#999999","#FF0000","#CCCCCC","#666666","#3333FF"))
Implementation of the stringency measures during Autumn 2020
Countries of the Central and Eastern European region implemented comparable stringency measures within a relative short time window. Nevertheless, lock-downs were implemented in different stages of the pandemic. During Autumn 2020, the Czech Republic locked down in a relatively later stage of the second wage, but experienced the most positive reaction to the lock-down.
The Slovak lock-down consisted of: i. online schooling for pupils and students older than 10; ii. recommended home-based work (where possible); iii. closure of indoor-spaces of restaurants and pubs (Pubs operating until 22.00); iv. banning all public meetings with over 6 participants (concerning cultural and sports events); v. face-masks being mandatory inside as well as outside. The intensity of the lock-down in the Czech Republic was comparable to the Slovak, except of the full-scale testing and restaurants and pubs, together with shops not selling essentials being shut down completely.
In the end of October 2020, Slovakia launched the lock-down together the pilot wave of full-scale testing in 4 (of its 79) districts with the highest COVID - 19 incidence. The first wave of the full-scale testing followed the next weekend after the pilot wave and start of the lock-down. It was carried out in all of the 79 districts (ending on 1st November 2020). The second wave of the full-scale testing was carried out in 45 out of the 79 districts where the rate of positive tests in the first wave was above 0,7 percent.
The first wave of the full-scale testing (inc. the pilot) identified 38 359 positive cases (7 103 per million), with the rate of positive tests 1.06%. 58 percent of the total population of Slovakia participated in the first wave.
The second wave of the full-scale testing identified 13 509 positive cases (2 502 per million), with the rate of positive tests 0.66%. 61 percent of the population in tested districts participated in the second wave
[Source] (https://www.somzodpovedny.sk/)
Implementation of the stringency measures in 2021
Since December 2020, countries considered here wwnt through a set of restrictive and relaxing policies, creating confusion and a drop in compliance with the currently valid stringency measures. For this reason, instead of displayin an overview of the actual measures, we display an indication of the population reaction to the measures by reducing mobility.
op<-c("2020-02-06")
measures <- covid19(verbose = FALSE, gmr = "https://www.gstatic.com/covid19/mobility/Global_Mobility_Report.csv")
#measures pre vsetky EU
mob_dim0<-c("date", "retail_and_recreation_percent_change_from_baseline", "grocery_and_pharmacy_percent_change_from_baseline", "parks_percent_change_from_baseline", "transit_stations_percent_change_from_baseline", "workplaces_percent_change_from_baseline", "residential_percent_change_from_baseline")
mob_dim<-c("retail_and_recreation_percent_change_from_baseline", "grocery_and_pharmacy_percent_change_from_baseline", "parks_percent_change_from_baseline","transit_stations_percent_change_from_baseline", "workplaces_percent_change_from_baseline", "residential_percent_change_from_baseline")
code2 <- c("AT","CZ","HU","SK","PL")
for(iCountry in code2) {
str_ind<-subset(measures, iso_alpha_2 == iCountry & date>=op, c("date", "stringency_index"))
tmp <- subset(measures, iso_alpha_2 == iCountry & date>=op, mob_dim0)
arrange(tmp,date)
tmp$grocery_and_pharmacy<-rollapply(tmp$grocery_and_pharmacy_percent_change_from_baseline,7,mean,align='right',fill=NA)
tmp$parks_percent<-rollapply(tmp$parks_percent_change_from_baseline,7,mean,align='right',fill=NA)
tmp$residential<-rollapply(tmp$residential_percent_change_from_baseline,7,mean,align='right',fill=NA)
tmp$retail_and_recreation<-rollapply(tmp$retail_and_recreation_percent_change_from_baseline,7,mean,align='right',fill=NA)
tmp$transit_stations<-rollapply(tmp$transit_stations_percent_change_from_baseline,7,mean,align='right',fill=NA)
tmp$workplaces<-rollapply(tmp$workplaces_percent_change_from_baseline,7,mean,align='right',fill=NA)
tmp<-select(tmp, c("date", "grocery_and_pharmacy", "parks_percent", "residential", "retail_and_recreation", "transit_stations", "workplaces"))
tmp<-melt(tmp, id=c("date"))
const<-max(select(get(paste(iCountry, sep="")),new_cases_smoothed_per_million), na.rm=TRUE)/35
# ld_date<-min(df$date[df$stringency_index>70 & df$date>"2020-10-01"], na.rm=TRUE)
gg<-ggplot() +
geom_area(data=tmp, aes(x=date, y = value, fill=variable)) +
geom_line(data=str_ind, aes(x=date, y = stringency_index)) +
scale_fill_discrete(name = "Mobility domain")+
# geom_line(data=get(paste(iCountry, sep="")), aes(x=date, y = new_cases_smoothed_per_million/7), legend=TRUE) +
# geom_vline(xintercept = ld_date) +
scale_y_continuous(name = "Change in mobility by domains/The stringency index", limits = c(-300, 250)) +
# scale_x_datetime(breaks = date_breaks("month")) +
labs(title = paste(iCountry, sep = "")) +
scale_x_date(name="Date", date_breaks = "2 months", date_labels = "%D")
assign(paste("gg_",iCountry, sep=""), gg)
}
gg_SK + labs(title = "Change in mobility of Slovaks",caption="Source: COVID-19 Community Mobility Reports-Google")
ggarrange(gg_CZ, gg_AT, gg_HU, gg_PL, ncol=2, nrow=2, common.legend = TRUE, legend="right")
The number of new COVID 19 cases per million
The following graph displays evidence is based on the official statistics, only accounting for the results of the PCR testing. The number of new cases presents the most sensitive out of the selected indicators. It´is the first, where a potential change in the trend would be observable.
#SK_pdon<-min(SK$date[SK$positive_rate>=0.05], na.rm = TRUE)
ld_dateSK<-"2020-10-25"
ld_dateCZ<-"2020-10-22"
ld_dateAT<-"2020-11-03"
ld_dateHU<-"2020-11-09"
ld_datePL<-"2020-11-10"
cData <- c("SK", "CZ", "AT", "HU", "PL")
for (iCountry in cData) {
tmp<-paste(iCountry, sep="")
df<-subset(get(tmp), date>="2020-09-01", vari)
ld_date<-as.Date(paste("ld_date",iCountry, sep=""), format='%Y-%m-%d')
df$pd_on[df$date>=min(df$date[df$positive_rate>=0.05 & df$date>"2020-09-01"], na.rm = TRUE)]<-TRUE
df$pd_on[df$date<min(df$date[df$positive_rate>=0.05 & df$date>"2020-09-01"], na.rm = TRUE)]<-FALSE
df<-df[order(df$date),]
df<-subset(df, date>=min(df$date[df$positive_rate>=0.05 & df$date>"2020-09-01"], na.rm = TRUE))
df$reltime<-sequence(rle(df$pd_on)$lengths)
df$reltime_ld<-df$date-ld_date
# df<-select(df, c("date", "location", "reltime", "reltime_ld", "new_cases_smoothed_per_million", "total_cases_per_million", "total_deaths_per_million", "icu_patients_per_million", "hosp_patients_per_million", "weekly_icu_admissions_per_million", "weekly_hosp_admissions_per_million"))
tmp<-assign(tmp, df)
}
cz_ld<-CZ$reltime[CZ$date=="2020-10-22"]
t0<-SK$reltime[SK$date=="2020-10-25"]
t1<-SK$reltime[SK$date=="2020-11-01"]
t2<-SK$reltime[SK$date=="2020-11-08"]
t3<-SK$reltime[SK$date=="2020-12-19"]
t4<-SK$reltime[SK$date=="2021-01-01"]
t5<-SK$reltime[SK$date=="2021-01-27"]
t0y <-SK$new_cases_smoothed_per_million[SK$date =="2020-10-25"]
t1y <- SK$new_cases_smoothed_per_million[SK$date =="2020-11-01"]
t2y <- SK$new_cases_smoothed_per_million[SK$date =="2020-11-08"]
t3y <- SK$new_cases_smoothed_per_million[SK$date =="2020-12-19"]
t4y <- SK$new_cases_smoothed_per_million[SK$date =="2021-01-01"]
t5y <- max(SK$new_cases_smoothed_per_million)
cz_ldy <- CZ$new_cases_smoothed_per_million[CZ$date=="2020-10-22"]
ggplot() +
geom_point(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million, colour=location))+
geom_line(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million, colour=location))+
geom_point(data=CZ, aes(x=reltime, y=new_cases_smoothed_per_million, colour=location))+
geom_line(data=CZ, aes(x=reltime, y=new_cases_smoothed_per_million, colour=location))+
geom_point(data=AT, aes(x=reltime, y=new_cases_smoothed_per_million, colour=location))+
geom_line(data=AT, aes(x=reltime, y=new_cases_smoothed_per_million, colour=location))+
geom_point(data=HU, aes(x=reltime, y=new_cases_smoothed_per_million, colour=location))+
geom_line(data=HU, aes(x=reltime, y=new_cases_smoothed_per_million, colour=location))+
geom_point(data=PL, aes(x=reltime, y=new_cases_smoothed_per_million, colour=location))+
geom_line(data=PL, aes(x=reltime, y=new_cases_smoothed_per_million, colour=location))+
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label=paste("Slovak lockdown with the \n pilot full-scale testing"), x=13, y=575, angle = 0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label="First wave of full-scale testing", x=24, y=790, angle=0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label=paste("Second wave of \n full-scale testing"), x=28, y=1050, angle=0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label="Czech lockdown", x=35, y=1250, angle=0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label="Second Slovak lockdown \n (19th of December 2020) \n (with ongoing local Ag testing)", x=80, y=1025, angle=0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label="Start of 2021 with a \n stricter lockdown", x=100, y=700, angle=0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label="27th of January 2021: Start of the screening AG testing", x=125, y=0, angle=0, size =3) +
xlab("Days since the Autumn outbreak")+ ylab("New cases per million")+
labs(title = "The number of new cases per million (smoothed)", colour = "Country", caption="Source: European Centre for Disease Prevention and Control (ECDC)") +
theme(plot.caption = element_text(hjust = 0), legend.position = "top")+
# scale_color_manual(values = c("#999999","#FF0000","#CCCCCC","#666666","#3333FF"))+
scale_color_manual(values = c("#FF0000","#CCCCCC","#666666","#3333FF"))+
geom_segment(aes(x = 20, y=550, xend = t0, yend=t0y), arrow = arrow(length = unit(0.5, "cm")), size =0.5) +
geom_segment(aes(x = 25, y=750, xend = t1, yend=t1y), arrow = arrow(length = unit(0.5, "cm")), size =0.5) +
geom_segment(aes(x = 30, y=1000, xend = t2, yend=t2y), arrow = arrow(length = unit(0.5, "cm")), size =0.5) +
geom_segment(aes(x = 35, y=1200, xend = cz_ld, yend=cz_ldy), arrow = arrow(length = unit(0.5, "cm")), size =0.5) +
geom_segment(aes(x = 80, y=1000, xend = t3, yend=t3y), arrow = arrow(length = unit(0.5, "cm")), size =0.5)+
geom_segment(aes(x = 100, y=680, xend = t4, yend=t4y), arrow = arrow(length = unit(0.5, "cm")), size =0.5)+
geom_segment(aes(x = t5, y=50, xend = 175, yend=50), arrow = arrow(length = unit(0.5, "cm")), size =1)
Antigen testing
Positive cases from the full-scale testing, “steal” from the official PCR statistics displayed in the following graphs. This is because once someone turns positive in the full-scale testing, he is not send for re-testing by a PCR test. These cases are only instructed to keep a strict quarantine for 10 days and notify their recent contacts. Since the start of November 2020, the PCR statistics is biased by the introduction of antigen (AG) testing. After the full-scale testing weekends, AG testing was made available at the municipality level for free to anyone interested. Since 27th of January, the ongoing screening antigen testing was launched. This involves conoditionaing free movement based on an negative AG test either 7 or 14 days old (depending on the Pandemics situation in the particular region).
Comparison of Slovakia to its neighbours
We are aware of the complexity of the factors potentially affecting the development of the Pandemic. Therefore, we do not make any causal claims, nor aim to identify the impact of the full-scale testing. Instead, we utilize the Czech development as the counterfactual, commonly perceived by the Slovaks. The Czech Republic is further ahead in the second (Autumn 2020) wave of the COVID-19 pandemic. Thanks to this, we could generate a prediction for Slovakia based on the observations from the Czech Republic, or simply display the development in both countries. On the other hand, the Czech Republic decided for the first (Autumn) lock-down in a later stage of the the pandemic. Benefits yielded from introducing a lock-down might be driven by the stage in which it is introduced (slope of the incidence of new cases). To account for that we generate a simple comparison on the development of Slovak new COVID cases per million based on the daily increases observed after the lock-downs introduced in Austria and Poland (countries introducing their lock-downs in comparable stages as Slovakia).
When compared to a synthetic, average, post-lock-down development of Austria and Poland, the Slovak lock-down seems to be yielding better results in reducing the numbers of new positive cases. What we observe, might be related to the full-scale AG testing which was in Slovakia (unlike in CZ, AT or PL) introduced on a large scale, together with the lock-down. Relatively lower numbers captured by the PCR tests should be driven by stealing out positive cases captured by AG testing.
cData <- c("SK", "CZ", "AT", "HU", "PL")
for (iCountry in cData) {
tmp<-paste(iCountry, sep="")
df<-subset(get(tmp), date>="2020-09-01")
# ld_date<-min(measures$date[measures$stringency_index>70 & measures$date>"2020-10-01"& measures$iso_alpha_2==iCountry], na.rm=TRUE)
ld_date<-paste("ld_date",iCountry, sep = "")
pd_startd<-first(df$date[df$positive_rate>=0.05])
df$pd_on[df$date>=pd_startd]<-TRUE
df$pd_on[df$date<pd_startd]<-FALSE
df<-df[order(df$date),]
df<-subset(df, pd_on==TRUE)
df$reltime<-sequence(rle(df$pd_on)$lengths)
df$reltime_ld<-df$date-as.Date(get(ld_date))
# df<-select(df, c("date", "reltime", "reltime_ld", "new_cases_smoothed_per_million", "total_cases_per_million"))
tmp<-assign(tmp, df)
}
df<-NULL
df<-merge(CZ, PL, by="reltime_ld", all=TRUE, suffixes = c(".CZ",".PL"))
df<-merge(df, AT, by="reltime_ld", all=TRUE)
df<-merge(df, HU, by="reltime_ld", all=TRUE, suffixes = c(".AT",".HU"))
df<-merge(df, SK, by="reltime_ld", all=TRUE)
dAT<-(df$new_cases_smoothed_per_million.AT[df$reltime_ld==0]-df$new_cases_smoothed_per_million[df$reltime_ld==0])
dCZ<-abs(df$new_cases_smoothed_per_million.CZ[df$reltime_ld==0]-df$new_cases_smoothed_per_million[df$reltime_ld==0])
#dHU<-abs(df$new_cases_smoothed_per_million.HU[df$reltime_ld==0]-df$new_cases_smoothed_per_million[df$reltime_ld==0])
dPL<-abs(df$new_cases_smoothed_per_million.PL[df$reltime_ld==0]-df$new_cases_smoothed_per_million[df$reltime_ld==0])
min_nc<-min(dAT, dCZ, dPL)
max_nc<-max(dAT, dCZ, dPL)
wAT<-(min_nc-dAT)/(max_nc-min_nc)+1
wCZ<-(min_nc-dCZ)/(max_nc-min_nc)+1
#wHU<-(min_nc-dHU)/(max_nc-min_nc)+1
wPL<-(min_nc-dPL)/(max_nc-min_nc)+1
sum_w<-wAT+wCZ+wPL
df$gAT<-df$new_cases_smoothed_per_million.AT/lag(df$new_cases_smoothed_per_million.AT)
df$gCZ<-df$new_cases_smoothed_per_million.CZ/lag(df$new_cases_smoothed_per_million.CZ)
#df$gHU<-df$new_cases_smoothed_per_million.HU/lag(df$new_cases_smoothed_per_million.HU)
df$gPL<-df$new_cases_smoothed_per_million.PL/lag(df$new_cases_smoothed_per_million.PL)
df$nc<-0
df$nc[df$reltime_ld<1]<-df$new_cases_smoothed_per_million[df$reltime_ld<1]
df$wg=((df$gAT*wAT+df$gCZ*wCZ+df$gPL*wPL)/sum_w)
for (k in 1:max(df$reltime_ld)){
df$nc[df$reltime_ld==k]<-df$wg[df$reltime_ld==k]*lag(df$nc)[df$reltime_ld==k]
}
ag_daily<-read.csv("https://raw.githubusercontent.com/Institut-Zdravotnych-Analyz/covid19-data/main/DailyStats/OpenData_Slovakia_Covid_DailyStats.csv", sep = ";")
ag_daily$date<-as.Date(ag_daily$Datum)
ag_daily<-subset(ag_daily, date>=SK$date[SK$reltime==1])
ag_daily<-select(ag_daily, date, AgPosit)
ag_daily$AgPosit[is.na(ag_daily$AgPosit)]<-0
ag_daily$fs_pag<-0
ag_daily$fs_pag[ag_daily$date=="2020-10-23"]<-2225
ag_daily$fs_pag[ag_daily$date=="2020-10-24"]<-2207
ag_daily$fs_pag[ag_daily$date=="2020-10-25"]<-1162
ag_daily$fs_pag[ag_daily$date=="2020-10-31"]<-25850
ag_daily$fs_pag[ag_daily$date=="2020-11-01"]<-7817
ag_daily$fs_pag[ag_daily$date=="2020-11-07"]<-8170
ag_daily$fs_pag[ag_daily$date=="2020-11-08"]<-3435
ag_daily$fs_pag<-rollapply(ag_daily$fs_pag,7,mean,align='right',fill=NA)
ag_daily$AgPosit<-rollapply(ag_daily$AgPosit,7,mean,align='right',fill=NA)
SK<-merge(SK, ag_daily, by="date")
SK$fs_pag<-SK$fs_pag/(SK$population/1000000)
SK$AgPosit<-SK$AgPosit/(SK$population/1000000)
t_lc<-SK$date[SK$reltime_lc==0]
t0<-SK$reltime[SK$date=="2020-10-25"]
t1<-SK$reltime[SK$date=="2020-11-01"]
t2<-SK$reltime[SK$date=="2020-11-08"]
ggplot() +
geom_ribbon(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million, ymin=new_cases_smoothed_per_million, ymax=new_cases_smoothed_per_million + AgPosit, colour="SK (regular AG)"), fill = "grey70") +
geom_ribbon(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million, ymin=new_cases_smoothed_per_million + AgPosit, ymax=new_cases_smoothed_per_million + AgPosit + fs_pag, colour="SK (AG full-scale testing)"), fill = "grey90") +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label=paste("Slovak lockdown with the \n pilot full-scale testing"), x=13, y=575, angle = 0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label="First wave of full-scale testing", x=24, y=790, angle=0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label=paste("Second wave of \n full-scale testing"), x=28, y=1050, angle=0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label="Czech lockdown", x=35, y=1250, angle=0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label="Second Slovak lockdown \n (ongoing local Ag testing)", x=80, y=1025, angle=0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label="Start of 2021 with a \n stricter lockdown", x=100, y=700, angle=0, size =3) +
geom_text(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million), label="27th of January 2021: Start of the screening AG testing", x=125, y=0, angle=0, size =3) +
geom_point(data=df, aes(x=reltime, y=nc, colour="Comparable after-lock-down development"))+
geom_line(data=df, aes(x=reltime, y=nc, colour="Comparable after-lock-down development"))+
geom_point(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million, colour="SK (PCR)"))+
geom_line(data=SK, aes(x=reltime, y=new_cases_smoothed_per_million, colour="SK (PCR)"))+
geom_point(data=CZ, aes(x=reltime, y=new_cases_smoothed_per_million, colour="CZ (PCR)"))+
geom_line(data=CZ, aes(x=reltime, y=new_cases_smoothed_per_million, colour="CZ (PCR)"))+
xlab("Days since the Autumn outbreak")+ ylab("New cases per million")+
labs(title = "The number of new cases per million (smoothed)", colour = "Country", caption="Source: European Centre for Disease Prevention and Control (ECDC)") +
theme(plot.caption = element_text(hjust = 0), legend.position = "top")+
scale_color_manual(values = c("purple","red","grey48","blue","grey70"))+
geom_segment(aes(x = 20, y=550, xend = t0, yend=t0y), arrow = arrow(length = unit(0.5, "cm")), size =0.5) +
geom_segment(aes(x = 25, y=750, xend = t1, yend=t1y), arrow = arrow(length = unit(0.5, "cm")), size =0.5) +
geom_segment(aes(x = 30, y=1000, xend = t2, yend=t2y), arrow = arrow(length = unit(0.5, "cm")), size =0.5) +
geom_segment(aes(x = 35, y=1200, xend = cz_ld, yend=cz_ldy), arrow = arrow(length = unit(0.5, "cm")), size =0.5) +
geom_segment(aes(x = 80, y=1000, xend = t3, yend=t3y), arrow = arrow(length = unit(0.5, "cm")), size =0.5)+
geom_segment(aes(x = 100, y=680, xend = t4, yend=t4y), arrow = arrow(length = unit(0.5, "cm")), size =0.5)+
geom_segment(aes(x = t5, y=50, xend = 175, yend=50), arrow = arrow(length = unit(0.5, "cm")), size =1)+
xlab("Days since the Autumn outbreak")+ ylab("New cases per million")+
labs(title = "The number of new cases per million (smoothed)", colour = "", caption="Source: European Centre for Disease Prevention and Control (ECDC)") +
theme(plot.caption = element_text(hjust = 0), legend.position = "top") +
guides(colour = guide_legend(nrow = 2))
#scale_color_manual(values = c("#666666","#3333FF"))After the full-scale testing, accessible AG testing was established at the municipality level. This is free of charge, with no pre-selection, based on individual, voluntary decisions to be tested. This (regular) AG testing reveals a relativelly smaler amount of positive cases, in comparison to the established contact-tracking based PCR testing. Even after considering the additional positive cases from the regular AG testing, the Slovak lock-down (with a full-scale AG testing) yiealds better results in comparison to the lock-downs of the neighbouring countries. Nevertheless, this is only confirmed for the two weeks following the last wave of the full-scale testing.
Hospitalisations and COVID related deaths present evidence less-affected by the differences in the measurement method (PCR or AG). Here, the benefit of the full-scale AG testing is less observable.
sm_hosp<-lm(df$hosp_patients_per_million ~ lag(df$new_cases_smoothed_per_million, k=3))
#summary(sm_hosp)
df$sm_hosp<-sm_hosp[["coefficients"]][["(Intercept)"]]+sm_hosp[["coefficients"]][["lag(df$new_cases_smoothed_per_million, k = 3)"]]*df$nc
sm_d<-lm(df$new_deaths_smoothed_per_million ~ lag(df$hosp_patients_per_million, k=3))
#summary(sm_d)
df$sm_d<-sm_d[["coefficients"]][["(Intercept)"]]+sm_d[["coefficients"]][["lag(df$hosp_patients_per_million, k = 3)"]]*df$sm_hosp
gg_hosp<-ggplot() +
geom_point(data=df, aes(x=reltime, y=sm_hosp, colour="Comparable after-lock-down development"))+
geom_line(data=df, aes(x=reltime, y=sm_hosp, colour="Comparable after-lock-down development"))+
geom_point(data=SK, aes(x=reltime, y=hosp_patients_per_million, colour="Real data - SK"))+
geom_line(data=SK, aes(x=reltime, y=hosp_patients_per_million, colour="Real data - SK"))+
geom_point(data=CZ, aes(x=reltime, y=hosp_patients_per_million, colour="Real data - CZ"))+
geom_line(data=CZ, aes(x=reltime, y=hosp_patients_per_million, colour="Real data - CZ"))+
xlab("Days since the Autumn outbreak")+ ylab("hospital patients per million")+
labs(title = "The number of hospital patients per million", colour = "", caption="Source: European Centre for Disease Prevention and Control (ECDC)") +
theme(plot.caption = element_text(hjust = 0), legend.position = "top")+
scale_color_manual(values = c("#666666","red", "#3333FF"))
gg_d<-ggplot() +
geom_point(data=df, aes(x=reltime, y=sm_d, colour="Comparable after-lock-down development"))+
geom_line(data=df, aes(x=reltime, y=sm_d, colour="Comparable after-lock-down development"))+
geom_point(data=SK, aes(x=reltime, y=new_deaths_smoothed_per_million, colour="Real data - SK"))+
geom_line(data=SK, aes(x=reltime, y=new_deaths_smoothed_per_million, colour="Real data - SK"))+
geom_point(data=CZ, aes(x=reltime, y=new_deaths_smoothed_per_million, colour="Real data - CZ"))+
geom_line(data=CZ, aes(x=reltime, y=new_deaths_smoothed_per_million, colour="Real data - CZ"))+
xlab("Days since the Autumn outbreak")+ ylab("New deaths per million")+
labs(title = "The number of new deaths per million", colour = "", caption="Source: European Centre for Disease Prevention and Control (ECDC)") +
theme(plot.caption = element_text(hjust = 0), legend.position = "top")+
scale_color_manual(values = c("#666666", "red","#3333FF"))
ggarrange(gg_hosp, gg_d, ncol=2, nrow=1, common.legend = TRUE, legend="top")
Looking at the ultimate outcomes of interest, the number of hospital patients and deaths, the benefit of implementing a lock-down in an earlier stage of the spread becomes clearly observable. This is represented in the comparison between the Czech and Slovak development. Nevertheless, when compared to a simplistic counterfactual of implementing the stringency measures in a comparable stage of the pandemic.
Finally, we look at the development in terms of unexplained mortality.
# Coded by Tomas Miklosovic
pop <- get_eurostat("demo_gind", filters = list(indic_de = c("JAN"), geo=c("SK","CZ","AT","HU","PL","FI","SE","IT","UK" )), select_time="Y")
pop<-pop %>% filter(time>="2015-01-01")
pop<-dcast(pop, geo ~time, value.var="values")
names(pop)[names(pop) == "2015-01-01"] <- "pop2015"
names(pop)[names(pop) == "2016-01-01"] <- "pop2016"
names(pop)[names(pop) == "2017-01-01"] <- "pop2017"
names(pop)[names(pop) == "2018-01-01"] <- "pop2018"
names(pop)[names(pop) == "2019-01-01"] <- "pop2019"
names(pop)[names(pop) == "2020-01-01"] <- "pop2020"
names(pop)[names(pop) == "2021-01-01"] <- "pop2021"
id <- search_eurostat("Deaths by week and sex",type = "dataset")$code[1]
print(id)## [1] "demo_r_mwk_ts"dat <- get_eurostat(id, filters = list(sex = c("T"), geo=c("SK","CZ","AT","HU","PL","FI","SE","IT","UK" )), time_format="raw")
dat$week <- str_sub(dat$time, start=6, end=7)
dat$year <- str_sub(dat$time, start=1, end=4)
dat<-dat %>% filter(year>=2015)
dat<-dat %>% filter(week!=99)
dat<-dat %>% filter(week!=53)
dat<-dcast(dat, geo + week ~ year, value.var="values")
dat$week <-as.numeric(as.character(dat$week))
colnames(dat)[colnames(dat)=="2015"] <- "rok_2015"
colnames(dat)[colnames(dat)=="2016"] <- "rok_2016"
colnames(dat)[colnames(dat)=="2017"] <- "rok_2017"
colnames(dat)[colnames(dat)=="2018"] <- "rok_2018"
colnames(dat)[colnames(dat)=="2019"] <- "rok_2019"
colnames(dat)[colnames(dat)=="2020"] <- "rok_2020"
colnames(dat)[colnames(dat)=="2021"] <- "rok_2021"
dat<-left_join(dat, pop)
dat$rok_2015<-dat$rok_2015/dat$pop2015*1000000
dat$rok_2016<-dat$rok_2016/dat$pop2016*1000000
dat$rok_2017<-dat$rok_2017/dat$pop2017*1000000
dat$rok_2018<-dat$rok_2018/dat$pop2018*1000000
dat$rok_2019<-dat$rok_2019/dat$pop2019*1000000
dat$rok_2020<-dat$rok_2020/dat$pop2020*1000000
dat$rok_2020[dat$rok_2020<100]<-NA
dat$rok_2021<-dat$rok_2021/dat$pop2020*1000000
dat$rok_2021[dat$rok_2021<100]<-NA
dat$priemer<-rowMeans(dat[,3:7])
matrix<-data.matrix(dat, rownames.force = NA)
dat$sd<-rowSds(matrix[,3:7])
countriesNames <- c("SK")
g_var<-c("week", "geo", "priemer", "rok_2020", "sd")
g_df<-subset(dat, geo %in% countriesNames, g_var)
cData <- c("SK", "CZ", "AT", "HU", "PL", "FI", "SE", "UK", "IT")
for (iCountry in cData) {
df<- subset(dat, geo == iCountry)
gg<-ggplot(data= df, aes(x=week)) +
geom_point(aes(y = priemer, group = 1, color = "Average 2015-2019")) +
geom_point(aes(y = rok_2020, group = 2, color="2020"), na.rm = TRUE) +
geom_point(aes(y = rok_2021, group = 3, color="2021"), na.rm = TRUE) +
geom_line(aes(y =priemer, group = 1 )) +
geom_line(aes(y =rok_2020, group = 2),lwd=1.5, na.rm = TRUE ) +
geom_line(aes(y =rok_2021, group = 3),lwd=1.5, na.rm = TRUE ) +
scale_x_continuous(breaks = c(1, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50))+
scale_y_continuous(name="The number of new deaths per million", limits = c(0, 450)) +
xlab("Week")+
scale_colour_manual("", breaks = c("Average 2015-2019", "2020", "2021"), values = c("red", "black", "darkblue")) +
labs(title = paste(iCountry, sep = ""), caption="Source: EUROSTAT (demo_r_mwk_ts)")+
geom_ribbon(aes(ymin=priemer -sd, ymax=priemer+sd), alpha = 0.2)+
geom_ribbon(aes(ymin=priemer -2*sd, ymax=priemer+2*sd), alpha = 0.1)
assign(paste("gg_",iCountry, sep=""), gg)
}
gg_SK + labs(title = "Unexplained mortality - Slovakia", caption="Source: EUROSTAT (demo_r_mwk_ts) - coded by Tomáš Miklošovič")
ggarrange(gg_CZ, gg_AT, gg_HU, gg_PL, ncol=2, nrow=2, common.legend = TRUE, legend="right")
District data (in preparation)
This work was supported by the Slovak Research and Development Agency under the contract no. APVV-17-0329.
References:
Institút zdravotných analýz, Ministry of Health of the Slovak republic, Retrieved from: https://github.com/Institut-Zdravotnych-Analyz/covid19-data [Online Resource]
Guidotti, E., Ardia, D., (2020), “COVID-19 Data Hub”, Journal of Open Source Software 5(51):2376, doi: 10.21105/joss.02376.
Max Roser, Hannah Ritchie, Esteban Ortiz-Ospina and Joe Hasell (2020) - “Coronavirus Pandemic (COVID-19)”. Published online at OurWorldInData.org. Retrieved from: ‘https://ourworldindata.org/coronavirus’ [Online Resource]