covid19 berlin cases

.gitignore

.Rhistory
.Rproj.user
covid19-berlin.Rproj
.Renviron

covid19-berlin-new.png

covid19-berlin-weekdays.png

covid19-cases-berlin.csv

plot-new-cases.R

needs(tidyverse, ggtext, zoo, modelr)
source('./write_datawrapper.R')

# load data from Jakub's Github repository
covid19 <- read_csv('https://raw.githubusercontent.com/jakubvalenta/covid-berlin-data/master/covid_berlin_data_incl_hospitalized.csv') %>% 
         # compute new cases
  mutate(new=cases - lag(cases),
         # compute new deaths
         new.deaths=deaths-lag(deaths),
         # compute rolling average over 7
         new.avg=rollmean(new, 7, align = 'center', na.pad = T),
         # add row number index
         index=row_number()) 

# compute Loess prediction for new cases
mod <- loess(new ~ index, covid19, na.action='na.exclude', span=0.5)

# store dataset
covid19 %>% 
  add_predictions(mod) %>% 
  select(date, new, new.deaths, new.avg, pred) %>% 
  mutate(pred=ifelse(pred<0, NA, pred)) %>% 
  write_datawrapper('RnWgL') %>% 
  write_csv('covid19-cases-berlin.csv', na = '-')

# create R plot for reference
png('covid19-berlin-new.png', width =20, height=15, units='cm',
    res=120)

covid19 %>%
  add_predictions(mod) %>% 
  ggplot(aes(date, new)) +
  geom_col(fill='#aeebd9') +
  geom_col(aes(y=new.deaths), fill='#15607a') +
  geom_hline(aes(yintercept=0)) +
  geom_area(aes(y=new.avg), fill='#29a793', alpha=0.2) +
  geom_line(aes(y=new.avg), color='#29a793', size=1) +
  geom_line(aes(y=pred), color='#000000', span=0.45, se=F, linetype=3,  size=0.7) +
  scale_x_date(name='')+
  scale_y_continuous(name='', limits = c(0, NA))+
  labs(title='New COVID-19 cases in Berlin per day',
     subtitle = paste('**bars** = reported number of new <b style="color:#7bd1b8">cases</b> and <b style="color:#15607a">deaths</b> per day',
     '**lines** = 7-day average number of cases (solid) + loess smooth (dotted)', sep='<br>'),
     caption='Source:  Pressemitteilungen der Senatsverwaltung für Gesundheit, Pflege und Gleichstellung\nData via https://github.com/jakubvalenta/covid-berlin-data') +
  theme_minimal() +
  theme(text = element_text(size = 12),
        plot.title = element_markdown(size = 17, face = 'bold'),
        plot.subtitle = element_markdown(size = 12),
        plot.caption = element_text(color='#777777'),
        plot.margin=unit(c(0.4,0.2,0.49,0),'cm'))

dev.off()

# compute different moving average spans

covid19 %>%
  select(date, index, new) %>% 
  mutate(zero=0,
    average3=rollmean(new, 3, align = 'center', na.pad = T),
    average7=rollmean(new, 7, align = 'center', na.pad = T),
    average10=rollmean(new, 10, align = 'center', na.pad = T),
    average14=rollmean(new, 14, align = 'center', na.pad = T),
    average21=rollmean(new, 21, align = 'center', na.pad = T)) %>% 
  write_datawrapper('RBL4y') %>% 
  ggplot(aes(date, new)) +
  geom_col(fill='#aeebd9') +
  geom_hline(aes(yintercept=0)) +
  geom_line(aes(y=average3), color=1, size=1) +
  geom_line(aes(y=average7), color=1, size=1) +
  geom_line(aes(y=average10), color=4, size=1) +
  geom_line(aes(y=average14), color=2, size=1) +
  geom_line(aes(y=average21), color=3, size=1) +
  scale_x_date(name='')+
  scale_y_continuous(name='', limits = c(0, NA))+
  theme_minimal() 

# different moving average alignments

covid19 %>%
  select(date, index, new) %>% 
  add_predictions(mod) %>% 
  mutate(pred=ifelse(pred<0, NA, pred)) %>% 
  mutate(zero=0,
         average.left=rollmean(new, 14, align = 'left', na.pad = T),
         average.center=rollmean(new, 14, align = 'center', na.pad = T),
         average.right=rollmean(new, 14, align = 'right', na.pad = T)) %>% 
  write_datawrapper('MiExN') %>% 
  ggplot(aes(date, new)) +
  geom_col(fill='#aeebd9') +
  geom_hline(aes(yintercept=0)) +
  geom_line(aes(y=pred), color=1, size=0.5) +
  geom_line(aes(y=average.left), color=1, size=1) +
  geom_line(aes(y=average.center), color=1, size=1) +
  geom_line(aes(y=average.right), color=4, size=1) +
  scale_x_date(name='')+
  scale_y_continuous(name='', limits = c(0, NA))+
  theme_minimal() 



covid19 %>%
  select(date, new) %>% 
  mutate(zero=0,
         average3=rollmean(new, 3, align = 'center', na.pad = T),
         average7=rollmean(new, 7, align = 'center', na.pad = T),
         average14=rollmean(new, 14, align = 'center', na.pad = T),
         average21=rollmean(new, 21, align = 'center', na.pad = T)) %>% 
  write_datawrapper('RBL4y') %>% 
  ggplot(aes(date, new)) +
  geom_col(fill='#aeebd9') +
  geom_hline(aes(yintercept=0)) +
  geom_line(aes(y=average3), color=1, size=1) +
  geom_line(aes(y=average7), color=1, size=1) +
  geom_line(aes(y=average14), color=2, size=1) +
  geom_line(aes(y=average21), color=3, size=1) +
  scale_x_date(name='')+
  scale_y_continuous(name='', limits = c(0, NA))+
  theme_minimal() 

covid19 %>% 
  ggplot(aes(date, hospitalized)) +
  geom_col(fill='#aeebd9') +
  geom_col(aes(y=icu), fill='#29a793') +
  theme_minimal()

plot-seas-adj.R

needs(tidyverse)

covid19 <- read_csv('https://raw.githubusercontent.com/jakubvalenta/covid-berlin-data/master/covid_berlin_data.csv')

DAYS <- c(
  '0'='Sunday',
  '1'='Monday',
  '2'='Tuesday',
  '3'='Wednesday',
  '4'='Thursday',
  '5'='Friday',
  '6'='Saturday')


new_cases <- covid19 %>% 
  mutate(weekday = DAYS[format(date, '%w')],
      new=cases - lag(cases)) 

new_cases.ts <- ts(new_cases$new, start=0, frequency = 7)
dts <- decompose(new_cases.ts, "multiplicative")

plot(dts)

Rplots.pdf

weekdays.R

needs(tidyverse, zoo)

data <- read_csv('covid19-cases-berlin.csv', na = '-') 

Sys.setlocale("LC_TIME", 'en_GB.UTF-8')

png('covid19-berlin-weekdays.png', width =20, height=15, units='cm',
    res=140)

data %>% 
  filter(date > '2020-03-01') %>%
  select(date, new) %>% 
  # add zero values for February for the rolling average
  bind_rows(tibble(date=as.Date(c(paste0('2020-02-',c(1,29)), '2020-03-01'), new=0))) %>% 
  mutate(wd=as.numeric(format(date, '%u'))) %>% 
  group_by(wd) %>% 
  arrange(date) %>% 
  mutate(new.avg=rollmean(new, 4, align = 'center', na.pad = T)) %>% 
  ungroup() %>% 
  arrange(date) %>% 
  filter(date >= '2020-03-01') %>% 
  mutate(weekday=fct_reorder(format(date, '%A'), wd, first),
         lastweek=date > max(data$date-7)) %>%
  ggplot(aes(date, new, color=lastweek)) +
  geom_point() +
  scale_color_manual(values=c('#00000066','#dd0000'), guide=F) +
  facet_wrap(weekday ~ .) +
  geom_line(aes(y=new.avg), color=1, size=0.5) +
  theme_minimal() +
  ggtitle('New COVID-19 cases in Berlin, by weekday',
          'Line shows rolling 4-week average, past 7 days highlighted in red')


dev.off()

write_datawrapper.R

needs(httr)

readRenviron('~/.Renviron')


write_datawrapper <- function(data, chartid) {
  token <- Sys.getenv('dw_api_key')
  r <- httr::PUT(
    paste0('https://api.datawrapper.de/v3/charts/', chartid,'/data'),
    add_headers(Authorization=paste0('Bearer ', token)),
    encode = 'raw',
    body=format_csv(data, na = '-'))
  print(r)
  data
}