Based on a simplistic model of curve fitting, we are able to derive a projection that coincides with what was reported, "Singapore could see Covid-19 cases hit 5,000 a day in two weeks"[https://www.straitstimes.com/singapore/health/singapore-could-see-5000-daily-covid-19-cases-by-mid-oct-but-most-will-have-no-or].
R Code for Curve fitting using Loess regression:
data<-read.csv("moving-7-day-average-covid-19-singapore-QueryResult.csv",header=T) ##get the data from https://data.world/.../covid-19-singapore/workspace/query...
head(data)
library(ggplot2)
data2<-data[1:60,1:2]
data2
data2_ts <- as.ts(data2)
p<-ggplot(as.data.frame(data2_ts),aes(x=date,y=daily_confirmed))+
geom_point()+
geom_smooth(method="loess")
model <- loess(daily_confirmed~date,as.data.frame(data2_ts), control=loess.control(surface="direct"))
newdf <- data.frame(date=seq(61,74,1))
predictions <- predict(model, newdata=seq(61,74,1), se=TRUE)
newdf$fit <- predictions$fit
newdf$upper <- predictions$fit + qt(0.975,predictions$df)*predictions$se
newdf$lower <- predictions$fit - qt(0.975,predictions$df)*predictions$se
head(newdf)
p +
geom_ribbon(data=newdf, aes(x=date, y=fit, ymax=upper, ymin=lower)) + #, fill="grey90"
geom_line(data=newdf, aes(x=date, y=fit), color='steelblue', lwd=1.2, lty=2)Reference:
I also tried fitting an exponential curve to the data points. This is a more aggressive model as you can see the projected number of daily confirmed cases gets close to 8000 in two weeks' time.
R code for Curve fitting using non-linear least squares:
library(easynls)
nlsfit<- nls(formula = daily_confirmed ~ exp(a+b*date), data = as.data.frame(data2_ts), start=list(a=25 ,b=0.05))
summary(nlsfit)
newdf <- data.frame(date=seq(61,74,1))
newdf
predictions <- predict(nlsfit, newdata=newdf, se.fit = TRUE)
predictions
newdf$fit<-predictions
head(newdf)
p +
geom_line(data=newdf, aes(x=date, y=fit), color='steelblue', lwd=1.2, lty=2) +
labs(x = "Historical data (in days)", y = "Number of daily confirmed cases")
Comments