Downloading data

Some useful code for downloading the data was provided here.

https://joshualoftus.com/posts/2020-12-28-is-the-new-variant-of-covid-really-more-transmissible/

Note on the new variant.

https://www.gisaid.org/references/gisaid-in-the-news/uk-reports-new-variant-termed-vui-20201201/

library(tidyverse)
download_filename <- "covid_positivity.xlsx"
download.file(
  url = paste0(
  "https://www.ons.gov.uk/file?",
  "uri=/peoplepopulationandcommunity/",
  "healthandsocialcare/conditionsanddiseases",
  "/adhocs/12708covid19infectionsurveyorf1abn",
  "positivityrates/orf1abnmodellingadhoc.xlsx"),
  destfile = download_filename)

c19rates <- readxl::read_xlsx(download_filename,
                              col_names = FALSE,
                              sheet = "Data",
                              range  = "A6:BI54")

deleted <- file.remove(download_filename)

names(c19rates) <- c("date", 
do.call(paste, 
expand.grid(
  c("positive", "lower", "upper"),
  c("new", "other"),
  c("England", "NorthEast", "NorthWest", "YorkshHum", "EastMid",
    "WestMid", "EastEngland", "London", "SouthEast", "SouthWest"))
))

d <- c19rates %>%
  pivot_longer(!date) %>%
  separate(col = name, sep = " ",
           into = c("est", "variant", "region")) %>%
  pivot_wider(names_from = est, values_from = value)

Percent positive for each variant

A difficulty with the data as provided by the ONS site is that the actual number of tests are not provided. Instead a confidence interval is placed on the positivity values. These confidence intervals are a function of the sample size, but it is challenging to “reverse engineer” the supplied information in order to work with the raw data.

England

d %>% filter(region =="England") %>% ggplot(aes(x=date,y=positive,ymin= lower,ymax=upper,col=variant)) + facet_wrap(~region) + geom_line() + geom_errorbar() + ylab("Percent positive") + xlab("Date")

London

d %>% filter(region =="London") %>% ggplot(aes(x=date,y=positive,ymin= lower,ymax=upper,col=variant)) + facet_wrap(~region) + geom_line() + geom_errorbar() + ylab("Percent positive") + xlab("Date")

North West

d %>% filter(region =="NorthWest") %>% ggplot(aes(x=date,y=positive,ymin= lower,ymax=upper,col=variant)) + facet_wrap(~region) + geom_line() + geom_errorbar() + ylab("Percent positive") + xlab("Date")

North East

d %>% filter(region =="NorthEast") %>% ggplot(aes(x=date,y=positive,ymin= lower,ymax=upper,col=variant)) + facet_wrap(~region) + geom_line() + geom_errorbar() + ylab("Percent positive") + xlab("Date")

East Midlands

d %>% filter(region =="EastMid") %>% ggplot(aes(x=date,y=positive,ymin= lower,ymax=upper,col=variant)) + facet_wrap(~region) + geom_line() + geom_errorbar() + ylab("Percent positive") + xlab("Date")

North East

d %>% filter(region =="NorthEast") %>% ggplot(aes(x=date,y=positive,ymin= lower,ymax=upper,col=variant)) + facet_wrap(~region) + geom_line() + geom_errorbar() + ylab("Percent positive") + xlab("Date")

East of England

d %>% filter(region =="EastEngland") %>% ggplot(aes(x=date,y=positive,ymin= lower,ymax=upper,col=variant)) + facet_wrap(~region) + geom_line() + geom_errorbar() + ylab("Percent positive") + xlab("Date")

South East

d %>% filter(region =="SouthEast") %>% ggplot(aes(x=date,y=positive,ymin= lower,ymax=upper,col=variant)) + facet_wrap(~region) + geom_line() + geom_errorbar() + ylab("Percent positive") + xlab("Date")

South West

d %>% filter(region =="SouthWest") %>% ggplot(aes(x=date,y=positive,ymin= lower,ymax=upper,col=variant)) + facet_wrap(~region) + geom_line() + geom_errorbar() + ylab("Percent positive") + xlab("Date")

Ratio of new variant to old variant

The basis of the analysis presented to SAGE was consistent increases in the ratio of positivity of the new variant over other variants. However this can arise through two different mechanisms If the old variant declines in posotivity while the new variant increases slightly or remains the same the ratio between the two will clearly increase. This could be an artefact of testing.

d[,-c(5,6)] %>% pivot_wider(names_from = variant, values_from = positive) %>% mutate(ratio=new/other) %>%
  ggplot(aes(x=date,y=ratio)) + facet_wrap(~region) + geom_line()

Data

aqm::dt(d)