Skip to content

Instantly share code, notes, and snippets.

@seabbs
Last active September 30, 2021 16:20
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save seabbs/176b0c7f83eab1a7192a25b28bbd116a to your computer and use it in GitHub Desktop.
Save seabbs/176b0c7f83eab1a7192a25b28bbd116a to your computer and use it in GitHub Desktop.
Explores Covid-19 data truncation in England (i.e when data is updated in later releases) using an experimental model in EpiNow2. By default looks at test positive cases but this can be updated by changing the selected variable in line 27.
# Note: estimate_truncation is experimental so use this for exploratory purposes
# only and/or with a high level of interpretation
# Packages ----------------------------------------------------------------
# install packages
# install.packages(c("data.table", "purrr", "remotes", "EpiNow2"))
library(data.table)
library(purrr)
library(covidregionaldata)
library(EpiNow2)
# Set cores ---------------------------------------------------------------
options(mc.cores = 4)
# Download data -----------------------------------------------------------
end_date <- Sys.Date()
uk_df <- map(seq(end_date - 13, end_date, by = "day"),
~ suppressMessages(get_regional_data("uk",
nhsregions = TRUE,
release_date = .)))
# Convert to expected variables for modelling -----------------------------
process_df <- function(df) {
df <- data.table::as.data.table(df)
df <- df[region %in% "England"]
df <- df[, .(date, confirm = as.integer(cases_new))]
df <- df[!is.na(confirm)]
df <- df[date >= (Sys.Date() - 4 * 7)]
}
model_df <- map(uk_df, process_df)
# Look at the data and prune out obvious truncation -----------------------
map(model_df, tail)
# get rid of NA data
model_df <- map(model_df, ~ .[!is.na(confirm)])
# get rid of last value if always zero
model_df <- map(model_df, ~ .[date < max(date)])
# Fit truncation model ----------------------------------------------------
#see ?estimate_truncation for details
truncation <- estimate_truncation(model_df, max_truncation = 8)
# Evaluate truncation -----------------------------------------------------
plot(truncation)
@seabbs
Copy link
Author

seabbs commented Nov 19, 2020

truncation

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment