Is second wave coming to London?


 


The some columns on the data file has changed so I have updated the code from my last post.

It is worrying that the daily number of new cases has risen to the same level as when the lock down started. The speed of the increase remains quite slow however. This can be because but not limited to:
  • The level of immunity in London is higher
  • People are more careful (but, as I observe, more and more relaxed as days go by)
  • Restricted mobility and work from home
  • Better ventilation as the weather has been very warm and people here have no air conditioning.
It is therefore quite tempting to conclude the critical threshold for the second wave is going to be higher than roughly 150 people per day when the last lock-down started. I am going to venture a guess - 200-300 people per day potentially? If the trend continues, mindful that the latest dip is due to lag, then the level can be breached in 2-4 weeks time?

#data.table #R #covid19 #secondwave

Full code below:
library(data.table)
library(ggplot2)
data_url <- "https://c19downloads.azureedge.net/downloads/csv/coronavirus-cases_latest.csv"
raw_data <- fread(data_url, check.names = TRUE)

plot_lab_confirmed_cases <- function(raw_data, area_name, area_type){
  area_data <- raw_data[
    Area.name == area_name &
      Area.type == area_type,,
    ][,Specimen.date := as.Date(Specimen.date)
      ][,c("Specimen.date","Daily.lab.confirmed.cases")][
        order(Specimen.date)
        ]
  area_data <- merge(area_data,
                       data.table(Specimen.date = seq(
                         min(area_data[,Specimen.date]),
                         max(area_data[,Specimen.date]),
                         by = "1 day"
                       )), all = TRUE, by = "Specimen.date")
  setkey(area_data, Specimen.date)
  setnafill(area_data, type = "const", fill = 0,
            cols = c("Daily.lab.confirmed.cases"))
  area_data[,roll_mean := frollmean(Daily.lab.confirmed.cases, n = 7, align = "right")]
  m_area_data <- melt(area_data, id.vars="Specimen.date",
                        measure.vars = c("Daily.lab.confirmed.cases","roll_mean"))
  area_plot <- ggplot(m_area_data, aes(x = Specimen.date, y = value, fill = variable, color = variable))+
    geom_bar(data = subset(m_area_data, variable == "Daily.lab.confirmed.cases"),
             stat = "identity") +
    geom_line(data = subset(m_area_data, variable == "roll_mean")) +
    labs(x="Specimen Date", y="Number of Confirmed Cases",
         fill = "", color = "") +
    scale_fill_manual(values = c("#ff0000","#000000"),
                      labels = c(sprintf("%s # Daily Confirmed cases",area_name),
                                 "7 day average")) +
    scale_color_manual(values = c("#ff0000","#000000"),
                       labels = c(sprintf("%s # Daily Confirmed cases",area_name),
                                  "7 day average")) +
    scale_x_date(date_breaks = "2 weeks", date_labels = "%Y-%m-%d") +
    theme_bw() %+replace% theme(legend.position = "top",
                                legend.justification = "left")
  area_plot
}


london_plot <- plot_lab_confirmed_cases(raw_data, "London", "region")
ggsave(filename = "London_COVID.png", london_plot,
       width = 10, height = 6)


Comments