knitr::opts_chunk$set( collapse = TRUE, comment = "#>" )
library(vacovdata) library(dplyr) library(ggplot2) library(ggthemes) library(latex2exp)
These are the raw positive test fractions, statewide, uncorrected for enrichment due to targeted testing (what we call $\hat{f}$ in our paper).
pltdata <- filter(vacovdata, date > as.Date('2020-03-15'), !is.na(fpos)) %>% select(date, fpos, npos=positiveIncrease, nneg=negativeIncrease) %>% mutate(flo = qbeta(0.025, npos+1, nneg+1), fhi = qbeta(0.975, npos+1, nneg+1)) ggplot(pltdata, aes(x=date)) + geom_point(aes(y=fpos), size=1.5) + geom_errorbar(aes(ymin=flo, ymax=fhi)) + ylab(TeX('$\\hat{f}$')) + theme_bw()
Note, however, that there are several days in May that saw dramatic increases in the number of tests performed.
pltdata <- mutate(pltdata, ntest = npos+nneg) ## Will use these May correlations below maydata <- filter(pltdata, date >= as.Date('2020-05-01')) maycor <- signif(cor(maydata$ntest, maydata$fpos, method='spearman'),2) ggplot(pltdata, aes(x=date, y=ntest)) + geom_line(size=1.2) + ylab('Number of tests') + theme_bw()
These excess tests, relative to the surrounding days, tend to be negative, producing
low outlier points in the plot of $\hat{f}$, particularly on May 1st, 15th, 20th,
and 24th. Overall for the month of May, the correlation between the number of
tests performed and the estimate of $\hat{f}$ (measured by the Spearman correlation
coefficient, $\rho_s$) is $\rho_s = r maycor
$. This high correlation suggests
that on the days with a surge in testing, a different selection procedure is being
used, resulting in a different enrichment factor.
Both the positive test fraction and the growth rates derived from it are quite noisy, so we use a 7-day sliding window to accumulate observations.
grpltdata <- select(vacovdata, date, pos=positive, tot=totalTestResults) %>% fitgr(7) %>% filter(date > as.Date('2020-03-23'), !is.na(kobs)) ggplot(grpltdata, aes(x=date)) + geom_point(aes(y=kobs, color='uncorrected'), size=1.5) + geom_smooth(aes(y=kobs, color='uncorrected'), se=FALSE) + geom_point(aes(y=kpop, color='corrected'), size=1.5) + geom_smooth(aes(y=kpop, color='corrected'), se=FALSE) + #coord_cartesian(ylim=c(-0.1,0.3)) + #xlim(as.Date(c('2020-04-01', '2020-05-30'))) + scale_color_solarized() + theme_bw()
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.