How to plot a polynomial regression line on a time series in R?

Question

I have used time series in R for data analysis occasionally, but I am not familiar with plotting with functions like ARIMA.

The following question stems from a comment on the number of daily cases of COVID in the US following a cubic. Indeed it looks like that, and I wanted to simply run a cubic regression with the humble (and frivolous) intent of plotting a polynomial curve on the scatterplot. Being that it is a time series I don't think using the lm() function would work.

Here is the code:

options(repr.plot.width=14, repr.plot.height=10)
 
install.packages('RCurl')
require(repr) # Enables resizing of the plots.
require(RCurl)
require(foreign)
require(tidyverse) # To tip the df from long row of dates to cols (pivot_longer())

# Extracting the number of confirmed cummulative cases by country from the Johns Hopkins website:
 
x = getURL("https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_global.csv")
corona <- read.csv(textConnection(x))
 
corona = (read_csv(x)
          %>% pivot_longer(cols = -c(`Province/State`, `Country/Region`, Lat, Long),
                           names_to = "date",
                           values_to = "cases")
          %>% select(`Province/State`,`Country/Region`, date, cases)
          %>% mutate(date=as.Date(date,format="%m/%d/%y"))
          %>% drop_na(cases)
          %>% rename(country="Country/Region", provinces="Province/State")
)
 
cc <- (corona
       %>% filter(country %in% c("US"))
)
 
ccw <- (cc
        %>% pivot_wider(names_from="country",values_from="cases")
        %>% filter(US>5)
)

first.der<-diff(ccw$US, lag = 1, differences = 1)

plot(ccw$date[2:length(ccw$date)-1], first.der, 
     pch = 19, cex = 1.2,
     ylab='', 
     xlab='',
     main ='Daily COVID-19 cases in US',
     col="firebrick",
     axes=FALSE,
     cex.main=1.5)
abline(h=0)
abline(v=ccw$date[length(ccw$date)-1], col='gray90')
abline(h=first.der[length(ccw$date)-1], col='firebrick', lty=2, lwd=.5)

at1 <- seq(min(ccw$date), max(ccw$date), by=2);
axis.Date(1, at=at1, format="%b %d", las=2, cex.axis=0.7)
axis(side=2, seq(min(first.der),max(first.der),1000), 
     las=2, cex.axis=1)

Answer 1

For the intended polynomial regression we just regress on the index and it's polynomials. For the polynomials we conveniently use poly and plot the fitted values with lines . However, it appears that the cases rather follow a quartic curve than a cubic.

ccw$first.der <- c(NA, diff(ccw$US))  ## better add an NA and integrate in data frame
ccw$index <- 1:length(ccw$US)

fit3 <- lm(first.der ~ poly(index , 3, raw=TRUE), ccw)  ## cubic
fit4 <- lm(first.der ~ poly(index , 4, raw=TRUE), ccw)  ## quartic

plot(first.der, main="US covid-19", xaxt="n")
tck <- c(1, 50, 100, 150)
axis(1, tck, labels=FALSE)
mtext(ccw$date[tck], 1, 1, at=tck)
lines(fit3$fitted.values, col=3, lwd=2)
lines(fit4$fitted.values, col=2, lwd=2)
legend("topleft", c("cubic", "quartic"), lwd=2, col=3:2)

Answer 2

I wasn't able to download your data, so I included an example using the mtcars dataset. You can use poly() or I() to obtain a polynomial regression:

set.seed(123)

qubic_model <- lm(mpg ~ hp + I(hp^2) + I(hp^3), data = mtcars)
min_hp <- min(mtcars$hp)
max_hp <- max(mtcars$hp)
grid_hp <- seq(min_hp, max_hp, by = 0.1)
qubic_model_line <- predict(qubic_model, data.frame(hp = grid_hp, `I(hp^2)` = grid_hp^2, `I(hp^3)` = grid_hp^3))

plot(mtcars$hp, mtcars$mpg, col='red',main='mpg vs hp', xlab='hp', ylab = 'mpg', pch=16)
lines(grid_hp, qubic_model_line, col='green', lwd = 3, pch=18)
legend(80, 15, legend=c("Data", "Cubic fit"),
       col=c("red", "green"), pch=c(16,18), cex=0.8)

If you just want to include an illustration for a trend, you can just use the local polynomial regression, eg, the LOESS method used by ggplot2 .