Covid-19 Analysis

Load data

Summary 2020-05-05

Today we had 408 new positive tests which is 12% percent of the total tests recorded in the last 24 hours. In Iowa there are 6332 people still sick with COVID-19 and 6% percent of those people are hospitalized. From the logisitc growth model, we predict that in 14 days, Iowa will have 17053 infected people.

View Data

So, it turns out to be very difficult to find past data in the State of Iowa since they re-publish everything daily. Here are the last 6 days of data if you are interested:

tail(clean)

Data Exploration

Positive Tests

Exponential Model

Run a linear model on the logarithm of the positive cases.

qplot(date, log(positive), data =clean) + geom_point() + geom_smooth()+
  stat_smooth(method = "lm", col = "red") 

For the model \(positive = e^{k date}\), \(k=\) 0.1249087. Estimated doubling time for positive cases is 5.5492285 days. Here is what that looks like on the original data.

Modified Exponential Model

By now there is strong evidence that the curve is flattening. We can create a new linear model that uses the more recent data to improve our model. Let’s look to see what happens if we only use data from later when we were doing more testing.

For the model \(positive = e^{k date}\), \(k=\) 0.0945819. Estimated doubling time for positive cases is 7.7553693 days. Here is what that looks like on the original data.

Deaths

Exponential Model

We will start the data when we have non-zero deaths.

For the model \(deaths = e^{k date}\), \(k=\) 4.8943337. Estimated time for deaths to double is 6.4972116 days.

Later Data

As above, let’s look at the same models, but only after we got serious about testing.

For the model \(deaths = e^{k date}\), \(k=\) 0.076684. Estimated time for deaths to double is 9.0390105 days.

Logistic Model

To try to fit a logistic model to the data, we want to fit a parabola to the rate of change, but the input variable is cases or deaths and not time. This is because the logistic model comes from the differential equation \(\displaystyle{\frac{dP}{dt}= kP(1-\frac{P}{M})}\). Note that this equation as a function of \(P\) is a parabola with zeroes at \(P=0\) and \(P=M\).

clean <- clean[-c(1,10),]
with(clean, plot(positive, New.Positive, pch=16, xlab = "Positive Counts", ylab = "Rate of Change of Positive", cex.lab = 1.3, col = "blue"))

Now, it doesn’t really look quadratic, but we are not going to let that stop us from mathematics. Next, we will fit a quadratic model to the data.

clean$P2 <- as.numeric(clean$positive)^2
quadratic <-lm(New.Positive ~ positive + P2-1, data = clean)
r <- quadratic$coefficients[2]*(-1)
M <- quadratic$coefficients[1]/r
Mprint <- format(M, scientific = FALSE)
predictedcounts <- with(clean,predict(quadratic,list(positive = positive, P2 = P2)))

Let’s plot the model:

with(clean, plot(positive, New.Positive, pch=16, xlab = "Positive Counts", ylab = "Rate of Change of Positive", cex.lab = 1.3, col = "blue"))
with(clean,lines(positive, predictedcounts, col = "darkgreen", lwd = 3))

IowaPercent <- M/IowaPop

So, we have a quadratic model that looks like \(\frac{dP}{dt}\) = 0.1063176\(P^2\) + -5.015821810^{-6}\(P\) = 5.015821810^{-6}\(P(1-P/\) 21196.45\()\). This is looking pretty good. In particular, because \(M=\) 21196.45, we can estimate that 0.0067184 of Iowa’s population will become infected. We would like to see what that looks like for the original data. When R performs logistic modeling, it usually has binomial data and thus expects numbers that are between zero and one. We will use our estimate of \(M\) to create postitive counts that are a percentage of \(M\).

non-integer #successes in a binomial glm!

Okay, that looks quite good. What will it predict for the next 14 days?

This predicts that in 14 days, Iowa will have 17053 infected people.

New Positives

For the model \(new positives = e^{k date}\), \(k=\) 0.0945819. Estimated time for new positives to double is 7.328543 days.

Alternative Modeling

This didn’t turn out well, but it is still here for historical perspective:

Positives Linear Model

First run a linear model on positive test results.

qplot(date, positive, data =clean) + geom_point() + geom_smooth()+
  stat_smooth(method = "lm", col = "red")

Deaths Linear Model

qplot(date, deaths, data =cdeaths, rm.na=TRUE) + geom_point() + geom_smooth()+
  stat_smooth(method = "lm", col = "red")

Ignoring unknown parameters: rm.na

model <- lm(deaths~date, data=cdeaths)
#model$coefficients