Waste Water Monitoring and COVID-19

NCDHHS has been participating in waste-water surveillance for SARS-CoV-2. Unfortunately, there is some delay in the data (posted weekly and what is posted is generally a week old or more).

I just want to explore if there is any predictive power. First, I’ll pull the data down and plot it for Greensboro, NC.

library(data.table)

dat <- fread("https://raw.githubusercontent.com/conedatascience/covid-data/master/data/timeseries/waste-water.csv")

o <- dat[grepl(pattern = "Greens", wwtp_name)]

o[,date_n:=as.numeric(date_new)]
o[,log_copies := log10(sars_cov2_normalized)]
o <- o[!is.na(log_copies)]

plot(log_copies~date_new, o, type = "l", adj = 0, 
         xlab = '', main = "SARS-CoV-2 RNA Copies - Greensboro NC")

Now I’m going to get into dangerous territory and fit a Bayesian spline to these data and then predict out to look at the trend.

library(mgcv)
fit <- bam(log_copies ~ s(date_n, k = 7, bs = "cs"), data = o)
plot(fit)

Ok, now let’s do that prediction:

pred_matrix <- data.frame(date = seq.Date(min(o$date_new), 
$                                                                                    length.out = 365, by = "day"))
pred_matrix<span class="katex"><span class="katex-mathml"><math xmlns="http://www.w3.org/1998/Math/MathML"><semantics><mrow><mi>d</mi><mi>a</mi><mi>t</mi><msub><mi>e</mi><mi>n</mi></msub><mo>&lt;</mo><mo>−</mo><mi>a</mi><mi>s</mi><mi mathvariant="normal">.</mi><mi>n</mi><mi>u</mi><mi>m</mi><mi>e</mi><mi>r</mi><mi>i</mi><mi>c</mi><mo stretchy="false">(</mo><mi>p</mi><mi>r</mi><mi>e</mi><msub><mi>d</mi><mi>m</mi></msub><mi>a</mi><mi>t</mi><mi>r</mi><mi>i</mi><mi>x</mi></mrow><annotation encoding="application/x-tex">date_n &lt;- as.numeric(pred_matrix</annotation></semantics></math></span><span class="katex-html" aria-hidden="true"><span class="base"><span class="strut" style="height:0.8444em;vertical-align:-0.15em;"></span><span class="mord mathnormal">d</span><span class="mord mathnormal">a</span><span class="mord mathnormal">t</span><span class="mord"><span class="mord mathnormal">e</span><span class="msupsub"><span class="vlist-t vlist-t2"><span class="vlist-r"><span class="vlist" style="height:0.1514em;"><span style="top:-2.55em;margin-left:0em;margin-right:0.05em;"><span class="pstrut" style="height:2.7em;"></span><span class="sizing reset-size6 size3 mtight"><span class="mord mathnormal mtight">n</span></span></span></span><span class="vlist-s">​</span></span><span class="vlist-r"><span class="vlist" style="height:0.15em;"><span></span></span></span></span></span></span><span class="mspace" style="margin-right:0.2778em;"></span><span class="mrel">&lt;</span><span class="mspace" style="margin-right:0.2778em;"></span></span><span class="base"><span class="strut" style="height:1em;vertical-align:-0.25em;"></span><span class="mord">−</span><span class="mord mathnormal">a</span><span class="mord mathnormal">s</span><span class="mord">.</span><span class="mord mathnormal">n</span><span class="mord mathnormal">u</span><span class="mord mathnormal">m</span><span class="mord mathnormal" style="margin-right:0.02778em;">er</span><span class="mord mathnormal">i</span><span class="mord mathnormal">c</span><span class="mopen">(</span><span class="mord mathnormal">p</span><span class="mord mathnormal">re</span><span class="mord"><span class="mord mathnormal">d</span><span class="msupsub"><span class="vlist-t vlist-t2"><span class="vlist-r"><span class="vlist" style="height:0.1514em;"><span style="top:-2.55em;margin-left:0em;margin-right:0.05em;"><span class="pstrut" style="height:2.7em;"></span><span class="sizing reset-size6 size3 mtight"><span class="mord mathnormal mtight">m</span></span></span></span><span class="vlist-s">​</span></span><span class="vlist-r"><span class="vlist" style="height:0.15em;"><span></span></span></span></span></span></span><span class="mord mathnormal">a</span><span class="mord mathnormal">t</span><span class="mord mathnormal" style="margin-right:0.02778em;">r</span><span class="mord mathnormal">i</span><span class="mord mathnormal">x</span></span></span></span>date)

pred_matrix$pred <- predict(fit, newdata = pred_matrix)
$
plot(log_copies~date_new, o, type = "l", 
         xlim = c(min(o$date_new), Sys.Date()+14), 
$         xlab = '', main = "SARS-CoV-2 RNA Copies - Greensboro NC")
lines(pred_matrix<span class="katex"><span class="katex-mathml"><math xmlns="http://www.w3.org/1998/Math/MathML"><semantics><mrow><mi>d</mi><mi>a</mi><mi>t</mi><mi>e</mi><mo separator="true">,</mo><mi>p</mi><mi>r</mi><mi>e</mi><msub><mi>d</mi><mi>m</mi></msub><mi>a</mi><mi>t</mi><mi>r</mi><mi>i</mi><mi>x</mi></mrow><annotation encoding="application/x-tex">date, pred_matrix</annotation></semantics></math></span><span class="katex-html" aria-hidden="true"><span class="base"><span class="strut" style="height:0.8889em;vertical-align:-0.1944em;"></span><span class="mord mathnormal">d</span><span class="mord mathnormal">a</span><span class="mord mathnormal">t</span><span class="mord mathnormal">e</span><span class="mpunct">,</span><span class="mspace" style="margin-right:0.1667em;"></span><span class="mord mathnormal">p</span><span class="mord mathnormal">re</span><span class="mord"><span class="mord mathnormal">d</span><span class="msupsub"><span class="vlist-t vlist-t2"><span class="vlist-r"><span class="vlist" style="height:0.1514em;"><span style="top:-2.55em;margin-left:0em;margin-right:0.05em;"><span class="pstrut" style="height:2.7em;"></span><span class="sizing reset-size6 size3 mtight"><span class="mord mathnormal mtight">m</span></span></span></span><span class="vlist-s">​</span></span><span class="vlist-r"><span class="vlist" style="height:0.15em;"><span></span></span></span></span></span></span><span class="mord mathnormal">a</span><span class="mord mathnormal">t</span><span class="mord mathnormal" style="margin-right:0.02778em;">r</span><span class="mord mathnormal">i</span><span class="mord mathnormal">x</span></span></span></span>pred, col = "red")

So it appears that there will be an increasing amount of RNA in the wastewater in Greensboro.

guilford_cases <- nccovid::get_covid_state(select_county = "Guilford",
                                                                                     reporting_adj = TRUE)
setDT(guilford_cases)

For fun (because of the reporting delay) I will plot the rolling average cases on this same plot. We can see that the cases did in fact increase, but much more rapidly than our projection would have suggested.

guilford_cases <- guilford_cases[date>=min(o$date_new)]
$
plot(log_copies~date_new, o, type = "l", 
         xlim = c(min(o$date_new), Sys.Date()+14), 
$         xlab = '', main = "SARS-CoV-2 RNA Copies - Greensboro NC")
lines(pred_matrix<span class="katex"><span class="katex-mathml"><math xmlns="http://www.w3.org/1998/Math/MathML"><semantics><mrow><mi>d</mi><mi>a</mi><mi>t</mi><mi>e</mi><mo separator="true">,</mo><mi>p</mi><mi>r</mi><mi>e</mi><msub><mi>d</mi><mi>m</mi></msub><mi>a</mi><mi>t</mi><mi>r</mi><mi>i</mi><mi>x</mi></mrow><annotation encoding="application/x-tex">date, pred_matrix</annotation></semantics></math></span><span class="katex-html" aria-hidden="true"><span class="base"><span class="strut" style="height:0.8889em;vertical-align:-0.1944em;"></span><span class="mord mathnormal">d</span><span class="mord mathnormal">a</span><span class="mord mathnormal">t</span><span class="mord mathnormal">e</span><span class="mpunct">,</span><span class="mspace" style="margin-right:0.1667em;"></span><span class="mord mathnormal">p</span><span class="mord mathnormal">re</span><span class="mord"><span class="mord mathnormal">d</span><span class="msupsub"><span class="vlist-t vlist-t2"><span class="vlist-r"><span class="vlist" style="height:0.1514em;"><span style="top:-2.55em;margin-left:0em;margin-right:0.05em;"><span class="pstrut" style="height:2.7em;"></span><span class="sizing reset-size6 size3 mtight"><span class="mord mathnormal mtight">m</span></span></span></span><span class="vlist-s">​</span></span><span class="vlist-r"><span class="vlist" style="height:0.15em;"><span></span></span></span></span></span></span><span class="mord mathnormal">a</span><span class="mord mathnormal">t</span><span class="mord mathnormal" style="margin-right:0.02778em;">r</span><span class="mord mathnormal">i</span><span class="mord mathnormal">x</span></span></span></span>pred, col = "red")
par(new = TRUE)
plot(cases_daily_roll_sum~date, guilford_cases, xlab = "", ylab = "",
         xlim = c(min(o$date_new), Sys.Date()+14),axes = FALSE)
$```

![](./unnamed-chunk-5-1.png)

In this next section I was curious if there was a strong
cross-correlation with a particular lag. In theory it would be nice if
we could say that we see RNA copies increasing and that gives us an
alert some period before we see cases. This way health systems could
prepare.

``` r
cor_list <- list()
for(i in 1:30){
    d <- copy(o)[,lag_cases:=shift(x = cases_new_cens_per10k, 
                                                                 i, 
                                                                 type = "lead")][!is.na(lag_cases)]
    cor_list[[i]] <- with(d, cor(lag_cases,log_copies, 
                                                             method = "spearman"))
}

overall_cor <- do.call(rbind, cor_list)
plot(1:30, overall_cor, main = "Analysis of Lags Between RNA Copies and Cases",
         ylab = "Spearman Correlation", xlab = "Lag Number")
abline(h = 0, lty ="dashed")

For this analysis it seems that there isn’t any large warnings…with the highest correlation being a 1 day lead. However there could be a rough 1-4 day advanced warning. Nothing too long term warning as what others have suggested.

@online{dewitt2021,
  author = {Michael E. DeWitt},
  title = {Waste Water Monitoring and COVID-19},
  date = {2021-11-22},
  url = {https://michaeldewittjr.com/blog/2021-11-22-waste-water-monitoring-and-covid-19/},
  langid = {en}
}
Copy