Skip to content

Instantly share code, notes, and snippets.

@grigory93
Last active March 30, 2020 23:49
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 grigory93/903df6826b16f672aa8d8f5073d11057 to your computer and use it in GitHub Desktop.
Save grigory93/903df6826b16f672aa8d8f5073d11057 to your computer and use it in GitHub Desktop.
COVID-19 Blog visualizations using R and ggplot2
library(ggplot2)
library(ggthemes)
library(scales)
incubation_data = data.frame(sname = factor(c("Minimum\n0%", "2.5%", "Median\n50%",
"Average", "97.5%", "Maximum\n100%"),
levels = c("Minimum\n0%", "2.5%", "Median\n50%",
"Average", "97.5%", "Maximum\n100%"),
ordered = TRUE),
svalue = c(0, 2.2, 5.1, 5.5, 11.5, 14),
stext = c("\n(Unknown)", "\n2.2 days", "\n5.1 days",
"\n5.5 days", "\n11.5 days", "\n14 days"))
few_palette = "Medium"
ggplot(incubation_data, aes(ymax = svalue, ymin = 0, xmax = 2, xmin = 1, fill = sname)) +
geom_rect(aes(ymax=14, ymin=0, xmax=2, xmin=1), fill ="#ece8bd") +
geom_rect() +
coord_polar(theta = "y",start=-pi/2) +
xlim(c(0, 2)) + ylim(c(0,28)) +
scale_fill_few(palette = few_palette) +
scale_color_few(palette = few_palette) +
geom_text(aes(x = 0, y = 0, label=stext, colour=sname), size=4, family="Palatino") +
facet_wrap(~sname, ncol = 3) +
guides(fill=FALSE, colour=FALSE) +
labs(title="COVID-19 Incubation Time",
subtitle = "Time before infected person becomes symptomatic (percentiles and mean) ",
caption = "Source: COVID-19 Incubation Period: An Update. Stephen G. Baum, MD reviewing Lauer SA et al. Ann Intern Med 2020 Mar 10\nhttps://www.jwatch.org/na51083/2020/03/13/covid-19-incubation-period-update",
x=NULL, y=NULL) +
theme_tufte(ticks = FALSE, base_size = 12, base_family = "Palatino") +
theme(axis.text = element_blank(),
plot.caption = element_text(face = "italic", size=6),
strip.text = element_text(size = 12))
severity_rates = c(0.81, 0.14, 0.05, 0.023)
spectrum_severity = data.frame(severity = c("Mild", "Severe disease", "Critical disease", "Case\nFatality rate*"),
percent = severity_rates,
percent_label = paste0(100 * severity_rates,"%"),
severity_label = c("\nno or mild pneumonia\n",
"with dyspnea, hypoxia,\nor >50 percent lung\ninvolvement on imaging\nwithin 24 to 48 hours",
"\nwith respiratoryfailure, shock,\nor multiorgan dysfunction",
"\nCFR: no deaths were reported\namong noncritical cases"))
spectrum_severity$severity = factor(spectrum_severity$severity,
levels = spectrum_severity$severity[order(-spectrum_severity$percent)],
ordered = TRUE)
ggplot(spectrum_severity, aes(severity, percent)) +
geom_bar(aes(fill=severity), stat = "identity") +
geom_text(aes(label=percent_label), family = "Palatino", nudge_y = 0.05) +
scale_y_continuous(labels = percent) +
scale_fill_few(palette = few_palette, name = "Severity",
labels = spectrum_severity$severity_label) +
annotate("text", 4, 0.4, family="Palatino", size=3,
label="* The proportion of severe\nor fatal infections\nmay vary by location.") +
labs(title="Spectrum of Illness Severity",
subtitle = "The spectrum of symptomatic infection from mild to critical plus case fatality rate (CFR)\nas reported by the Chinese CDC from 72,314 Cases",
x=NULL, y=NULL,
caption = "Source: Characteristics of and Important Lessons From the Coronavirus Disease 2019 (COVID-19) Outbreak in China:\nSummary of a Report of 72,314 Cases From the Chinese Center for Disease Control and Prevention. Wu Z, McGoogan JM. JAMA. 2020\nhttps://jamanetwork.com/journals/jama/fullarticle/2762130") +
theme_minimal(base_size = 14, base_family = "Palatino") +
theme(legend.position = "right",
legend.direction = "vertical",
axis.text.y = element_blank(),
plot.caption = element_text(face = "italic", size=6))
manifestation = data.frame(name =
factor(c("Fever", "Fatigue", "Dry cough", "Anorexia", "Myalgias", "Dyspnea", "Sputum production"),
levels = c("Fever", "Fatigue", "Dry cough", "Anorexia", "Myalgias", "Dyspnea", "Sputum production"),
ordered = TRUE),
percent = c(0.99, 0.7, 0.59, 0.4, 0.35, 0.31, 0.27))
manifestation$name = factor(manifestation$name,
levels = manifestation$name[order(-manifestation$percent)],
ordered = TRUE)
ggplot(manifestation) +
geom_bar(aes(name, percent, fill=name), stat="identity") +
scale_y_continuous(labels = percent) +
scale_fill_few(palette = few_palette, name = "Features") +
labs(title = "Clinical Manifestations",
subtitle = "Most common clinical features at the onset of illness",
caption = "Source: Clinical Characteristics of 138 Hospitalized Patients With 2019 Novel Coronavirus-Infected Pneumonia in Wuhan, China.\nWang D, Hu B, Hu C, Zhu F, Liu X, Zhang J, Wang B, Xiang H, Cheng Z, Xiong Y, Zhao Y, Li Y, Wang X, Peng Z. JAMA. 2020\nhttps://jamanetwork.com/journals/jama/fullarticle/2761044",
x=NULL, y=NULL) +
theme_minimal(base_size = 14, base_family = "Palatino") +
theme(legend.position = "none",
legend.direction = "vertical",
plot.caption = element_text(face = "italic", size=6))
infectivity = data.frame(period = factor(c("Minimum", "Median", "Maximum"),
levels = c("Minimum", "Median", "Maximum"), ordered = TRUE),
value = c(8, 20, 37))
ggplot(infectivity, aes(period, value)) +
geom_bar(stat = "identity", width = 0.03) +
geom_point(aes(size = value), shape = 8, color = "red") +
geom_point(aes(size = value/1.5), shape = 21, fill = "grey", color="red") +
geom_point(aes(size=value/4), shape = 16, color="indianred1") +
scale_size(range = c(2,8)) +
annotate("text", 1.7, 30, family="Palatino", size=3.5,
label="The interval during which an individual with\nCOVID-19 is infectious is uncertain.\nMost data informing this issue\nare from studies evaluating viral RNA\ndetection from respiratory and other specimens.\nHowever, detection of viral RNA does not\nnecessarily indicate the presence\nof infectious virus.") +
coord_flip() +
labs(title = "COVID-19 Period of Infectivity",
subtitle = "Duration of Viral RNA Shedding",
caption = "Source: Clinical course and risk factors for mortality of adult inpatients with COVID-19 in Wuhan, China: a retrospective cohort study.\nZhou F, Yu T, Du R, Fan G, Liu Y, Liu Z, Xiang J, Wang Y, Song B, Gu X, Guan L, Wei Y, Li H, Wu X, Xu J, Tu S, Zhang Y, Chen H, Cao B. Lancet. 2020\nhttps://www.thelancet.com/journals/lancet/article/PIIS0140-6736(20)30566-3",
x = NULL, y = "Days") +
theme_minimal(base_size = 16, base_family = "Palatino") +
theme(plot.caption = element_text(face = "italic", size=6),
legend.position = "none")
age_groups = c("≤9", "10-19", "20-29", "30-39", "40-49", "50-59", "60-69", "70-79",
"≥80")
cfr_china = data.frame(age = factor(age_groups, levels = age_groups, ordered = TRUE),
deaths = c(0,1,7,18,38,130,309,312,208),
cases = c(416,549,3619,7600,8571,10008,8583,3918,1408),
cfr = 0.01 * c(0,0.18,0.19,0.23,0.44,1.3,3.6,8.,14.8))
ggplot(cfr_china, aes(x=age, y=cfr, group=1)) +
geom_line() +
geom_hline(yintercept = 0.01 * 2.3, linetype="dashed", alpha=0.5) +
geom_bar(aes(width=cases/10000, fill=age), stat = "identity", position = "identity") +
geom_text(aes(label=paste0(cfr*100,"%")), family="Palatino", size=4, nudge_y = 0.04) +
geom_text(aes(label=paste0("(",deaths,"/",cases,")")), family="Palatino", size=4, nudge_y = 0.03) +
scale_y_continuous(labels = percent) +
scale_fill_tableau(palette = "Classic 10 Medium") +
labs(title = "COVID-19 Case Fatality Rate (CFR) by Age Groups",
subtitle = "Among 44,672 confirmed cases in China through February 11\nOverall CFR = 2.3% (dotted line)",
x = "Age Group", y = NULL,
caption = "Source: Characteristics of and Important Lessons From the Coronavirus Disease 2019 (COVID-19) Outbreak in China:\nSummary of a Report of 72314 Cases From the Chinese Center for Disease Control and Prevention. Wu Z, McGoogan JM. JAMA. 2020\nhttps://jamanetwork.com/journals/jama/fullarticle/2762130 and http://weekly.chinacdc.cn/en/article/id/e53946e2-c6c4-41e9-9a9b-fea8db1a8f51") +
theme_minimal(base_size = 14, base_family = "Palatino") +
theme(plot.caption = element_text(face = "italic", size=6),
legend.position = "none")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment