Animation of projected weekly cases - USA
Source:vignettes/VariantAnimation-USA.Rmd
VariantAnimation-USA.Rmd
suppressPackageStartupMessages({
library(covmuller)
library(COVID19)
library(tidyverse)
})
theme_set(CovmullerTheme())
Get variants data for USA
gisaid_metadata <- qs::qread("~/data/epicov/metadata_tsv_2024_04_11.qs")
gisaid_usa <- gisaid_metadata %>%
filter(Country == "USA") %>%
filter(Host == "Human")
# format metadata
gisaid_usa <- FormatGISAIDMetadata(gisaid_usa)
gisaid_usa <- gisaid_usa %>%
arrange(State, MonthYearCollected) %>%
filter(pangolin_lineage != "Unknown")
vocs <- GetVOCs()
custom_voc_mapping <- list(
`JN.1` = "JN.1",
`JN.1.*` = "JN.1",
`HV.1` = "HV.1",
`HV.1.*` = "HV.1",
`B.1` = "B.1",
`B.1.1.306` = "B.1",
`B.1.1.306.*` = "B.1",
`B.1.1.326` = "B.1",
`B.1.36.29` = "B.1",
`B.1.560` = "B.1",
`B.1.1` = "B.1",
`B.1.210` = "B.1",
`B.1.36.8` = "B.1",
`B.1.36` = "B.1",
`B.1.36.*` = "B.1"
)
gisaid_usa <- gisaid_usa %>% filter(pangolin_lineage != "None")
gisaid_usa <- CollapseLineageToVOCs(
variant_df = gisaid_usa,
vocs = vocs,
custom_voc_mapping = custom_voc_mapping,
summarize = FALSE
)
Get weekly cases for USA
GetCases <- function() {
data <- read.csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/cases_deaths/new_cases.csv")
confirmed <- data %>% select(date, United.States)
colnames(confirmed)[2] <- c("cases")
confirmed$MonthYear <- GetMonthYear(confirmed$date)
confirmed$WeekYear <- tsibble::yearweek(confirmed$date)
return(confirmed)
}
GetCasesLong <- function() {
data <- read.csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/cases_deaths/new_cases.csv")
confirmed <- data %>% select(date, United.States)
colnames(confirmed)[2] <- c("cases")
confirmed$MonthYear <- GetMonthYear(confirmed$date)
confirmed$WeekYear <- tsibble::yearweek(confirmed$date)
confirmed_subset_weekwise <- confirmed %>%
group_by(WeekYear) %>%
summarise(cases = mean(cases, na.rm = T)) %>%
arrange(WeekYear)
confirmed_subset_weekwise$cases <- ceiling(confirmed_subset_weekwise$cases)
confirmed_subset_dateweekwise_long_india <- confirmed_subset_weekwise %>%
rename(n = cases) %>%
rename(WeekYearCollected = WeekYear)
}
confirmed <- GetCases()
confirmed_subset_dateweekwise_long <- GetCasesLong()
gisaid_usa_weekwise <- SummarizeVariantsWeekwise(gisaid_usa)
Distribution of variants
state_month_counts <- SummarizeVariantsMonthwise(gisaid_usa)
state_month_counts$State <- "USA"
state_month_prevalence <- CountsToPrevalence(state_month_counts)
vocs <- GetVOCs()
state_month_prevalence <- CollapseLineageToVOCs(
variant_df = state_month_prevalence,
vocs = vocs,
custom_voc_mapping = custom_voc_mapping, summarize = FALSE
)
p5 <- StackedBarPlotPrevalence(state_month_prevalence)
p5
Project weekly cases to variant prevalence data from GISAID
voc_to_keep <- gisaid_usa_weekwise %>%
group_by(lineage_collapsed) %>%
summarise(n_sum = sum(n)) %>%
filter(n_sum > 50) %>%
pull(lineage_collapsed) %>%
unique()
gisaid_usa_weekwise <- gisaid_usa_weekwise %>% filter(lineage_collapsed %in% voc_to_keep)
usa_cases_pred_prob_sel_long <- FitMultinomWeekly(gisaid_usa_weekwise, confirmed_subset_dateweekwise_long)
the_anim <- PlotVariantPrevalenceAnimated(usa_cases_pred_prob_sel_long, title = "Estimated cases (weekly average) in USA by variant", caption = "**Source: gisaid.org and ourworldindata.org/coronavirus**<br>", date_breaks = "120 days")
gganimate::anim_save(filename = here::here("docs/articles/USA_animated.gif"), animation = the_anim)
Look at cases from 2022,
confirmed_subset_dateweekwise_long <- GetCasesLong() %>%
filter(WeekYearCollected >= tsibble::yearweek("2021 W35"))
gisaid_usa_subset <- gisaid_usa %>% filter(MonthYearCollected > "Oct 2021")
gisaid_usa_weekwise <- SummarizeVariantsWeekwise(gisaid_usa_subset)
voc_to_keep <- gisaid_usa_weekwise %>%
group_by(lineage_collapsed) %>%
summarise(n_sum = sum(n)) %>%
filter(n_sum > 50) %>%
pull(lineage_collapsed) %>%
unique()
gisaid_usa_weekwise <- gisaid_usa_weekwise %>% filter(lineage_collapsed %in% voc_to_keep)
usa_cases_pred_prob_sel_long <- FitMultinomWeekly(gisaid_usa_weekwise, confirmed_subset_dateweekwise_long)
the_anim <- PlotVariantPrevalenceAnimated(usa_cases_pred_prob_sel_long, title = "Estimated cases (weekly average) in USA by variant", caption = "**Source: gisaid.org and ourworldindata.org/coronavirus**<br>", date_breaks = "120 days")
gganimate::anim_save(filename = here::here("docs/articles/USA_animated_2021.gif"), animation = the_anim)
Look at cases from 2023
confirmed_subset_dateweekwise_long <- GetCasesLong() %>%
filter(WeekYearCollected >= tsibble::yearweek("2022 W35"))
gisaid_usa_subset <- gisaid_usa %>% filter(MonthYearCollected > "October 2022")
gisaid_usa_weekwise <- SummarizeVariantsWeekwise(gisaid_usa_subset)
voc_to_keep <- gisaid_usa_weekwise %>%
group_by(lineage_collapsed) %>%
summarise(n_sum = sum(n)) %>%
filter(n_sum > 50) %>%
pull(lineage_collapsed) %>%
unique()
gisaid_usa_weekwise <- gisaid_usa_weekwise %>% filter(lineage_collapsed %in% voc_to_keep)
usa_cases_pred_prob_sel_long <- FitMultinomWeekly(gisaid_usa_weekwise, confirmed_subset_dateweekwise_long)
the_anim <- PlotVariantPrevalenceAnimated(usa_cases_pred_prob_sel_long, title = "Estimated cases (weekly average) in USA by variant", caption = "**Source: gisaid.org and ourworldindata.org/coronavirus**<br>", date_breaks = "90 days")
gganimate::anim_save(filename = here::here("docs/articles/USA_animated_2023.gif"), animation = the_anim)