knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) library(season) library(MASS) # for mvrnorm library(survival) # for coxph library(ggplot2) library(dlnm) # for splines
season is a package to analyse seasonal data that I developed whilst working on studies in environmental epidemiology. Here I describe some of the key functions.
We will use the data on the daily number of deaths from cardiovascular disease (CVD) in people aged 75 and over in Los Angeles for the years 1987 to 2000.
Below we load the data and then use
ggplot2 to draw a boxplot of the daily death counts by month.
data(CVDdaily) ggplot(CVDdaily, aes(x=factor(month), y=cvd))+ geom_boxplot()+ ylab('Daily number of CVD deaths')+ xlab('Month')+ theme_bw()
There is a clear seasonal pattern, with more deaths in the winter months and fewer in the summer. There's also evidence of a greater variance in the winter months, which we would expect in a count process, as the variance is proportional to the mean.
It is also useful to plot the data over time as below. To help show the seasonal pattern, we create a vertical reference line for the first day of each year. The plot shows the seasonal peak happened in every winter, although the size of the peak varied between years.
years = 1987:2001 Januarys = as.numeric(as.Date(paste(years, '-01-01', sep=''), origin='1970-01-01')) ggplot(CVDdaily, aes(x=as.numeric(date), y=cvd))+ geom_line()+ scale_x_continuous(breaks=Januarys, labels=years)+ ylab('Daily number of CVD deaths')+ xlab('Time')+ theme_bw()+ theme(panel.grid.minor = element_blank())
Deaths increase in many countries around the world when the temperature is outside an optimal range, with the optimal range varying by climate. The plot below shows daily death counts against daily temperatures. Increases in deaths are apparent at both low and high temperatures, suggesting a non-linear association between temperature and cardiovascular deaths.
ggplot(CVDdaily, aes(x=tmpd, y=cvd))+ geom_point()+ ylab('Daily number of CVD deaths')+ xlab('Temperature (degrees F)')+ theme_bw()
We now examine the association between temperature and death using a case-crossover model. This model compares the number of deaths on case and control days, and only uses controls that are near the case day. By choosing control days near case days, the model controls for long-term trends and seasonal patterns. Below we use the default of cases and controls selected from the same 28 day (4 week) windows. The model is fitted using conditional logistic regression. The technical details are in our book Analysing Seasonal Health Data.
To model a non-linear effect for temperature, we first create a spline for temperture with knots at 60 and 75 degrees Fahrenheit, which essentially means we expect a change in the association around these temperatures.
Deaths due to temperature can occur days after exposure. For example, when a person has a heart attack on a hot day, is admitted to hospital alive, but dies in hospital some days later. To account for this we include a lag of 14 days. By using a lagged temperature we lose a few observations at the start of the data, because we do not have temperature data from the year 1986. We use the
[dlnm](https://cran.r-project.org/web/packages/dlnm/index.html) library to create the non-linear and lagged spline basis.
We include a categorical variable of day of the week, because there is evidence that deaths vary by day of the week.
The model takes a short while to run.
# make a spline basis that has a lag and is non-linear tmpd.basis = crossbasis(CVDdaily$tmpd, lag=14, # 14 day lag arglag=list(fun='ns', df=3), # 3 degrees of freedom for lag; ns = natural spline argvar=list(fun='ns', knots=c(60, 75))) # knots at 65 and 75 degrees # add the spline basis variables to the data CVDdaily = cbind(CVDdaily, tmpd.basis[1:nrow(CVDdaily), ]) # create the regression formula spline.names = colnames(tmpd.basis) formula = paste('cvd ~', paste(spline.names, collapse = ' + '), '+ Mon + Tue + Wed + Thu + Fri + Sat') model = casecross(as.formula(formula), data=CVDdaily) summary(model)
This is a large study with just under 230,000 deaths and over 5,000 case days. The coefficients are the log odds ratios. Here and elsewhere in this vignette, the estimates are quoted to many decimal places, but when presented in a paper we recommend using these guidelines.
We can see there are more deaths on Monday compared with the reference day of Sunday. The temperature estimates are hard to interpret and are best shown by reconstructing the nine spline estimates in a plot.
The display above does not give confidence intervals for the log odds ratios, but these can easily be created as follows (which gives 95% confidence intervals).
We use the coefficients and their variance--covariance matrix to reconstruct a three-dimensional plot by lag and temperature. We examine temperatures over the range 45 to 85 degrees Fahrenheit. The estimates are centred using a reference temperature of 70 degrees.
# extract the coefficients and variance--covariance matrix for the spline terms coef = coefficients(model$c.model) index = names(coef) %in% spline.names coef = coef[index] vcov = vcov(model$c.model)[index, index] for.plot = crosspred(basis=tmpd.basis, coef=coef, vcov=vcov, at=seq(45, 85, 1), model.link = 'log', cen=70) par(mai=c(0.2, 0, 0, 0)) # reduce plot margins plot(for.plot, xlab='Temperature (degrees F)', zlab='Odds ratio', ylab='Lag (days)')
The dominant feature is a large spike in deaths at high temperatures on the same day of exposure (lag day zero).
Another useful plot is the overall change in risk which summarises the results across all lags.
The plot shows the mean odds (solid line) and 95% confidence interval (shaded area).
We first put the estimates into a
data.frame so they can be used in
to.plot = data.frame(temperature = for.plot$predvar, mean = for.plot$allRRfit, lower = for.plot$allRRlow, upper = for.plot$allRRhigh) ggplot(data=to.plot, aes(x=temperature, y=mean, ymin=lower, ymax=upper))+ geom_hline(lty=2, yintercept = 1)+ # horizontal reference line at no change in odds geom_ribbon(alpha=0.3)+ geom_line()+ xlab('Temperature (degrees F)')+ ylab('Odds ratio')+ theme_bw()
The plot shows a U-shaped risk, with increased odds at low and high temperatures relative to the reference temperature of 70 degrees.
As shown in the second plot in this vignette, the seasonal pattern appeared to vary from year-to-year, with larger peaks in some years. This is a non-stationary seasonal pattern. We can model this pattern by splitting the time series into a trend, seasonal pattern(s) and residuals. Details on the method are available in this paper: Estimating trends and seasonality in coronary heart disease.
We use the monthly data rather than the daily data because we are primarily interested in seasonal patterns, and the daily data will take much longer to run.
We use the response variable of
adj as this is the adjusted monthly counts of CVD deaths which accounts for the differences in month lengths (e.g., 28 or 29 days in February and 31 in January).
This model takes a few minutes to run because it uses Markov chain Monte Carlo samples to estimate the model parameters.
set.seed(1234) # set the random seed to give repeatable results data(CVD) f = c(12) # a single twelve month cycle tau = c(10, 50) # achieved via trial-and-error; small tau -> less variability ns.season = nscosinor(data=CVD, response='adj', cycles=f, niters=2000, burnin=500, tau=tau, div=1000) summary(ns.season) plot(ns.season)
The estimated mean amplitude is 207, so on average there 207 extra deaths per month in the seasonal winter peak compared with the year-round average. The 95% confidence interval for the peak is from 182 to 232 monthly deaths.
The plot shows the long-term non-linear trend and non-stationary seasonal pattern. The seasonal peaks are higher in some years, including 1989 and 2000, which matches the above plot of the data.
The phase, or timing of the seasonal peak, in the results above is given in radians (on a scale of 0 to 2$\pi$). We can transform this to a more useful time scale by transforming the summary statistics.
cat('Mean phase = ', round(invyrfraction(0.6952055/(2*pi), type='monthly', text=F), 2), ' months.\n', sep='') cat('Lower 95% interval = ', round(invyrfraction(0.5732958/(2*pi), type='monthly', text=F), 2), ' months.\n', sep='') cat('Upper 95% interval = ', round(invyrfraction(0.8216251/(2*pi), type='monthly', text=F), 2), ' months.\n', sep='')
The estimated peak in deaths is in early February.
Another useful function is a test of non-linearity in time series using the third-order moment. This is the non-linear extension of the more familiar second-order tests of linearity, such as the autocorrelation function. Here we check for any remaining non-linearity in the time series of residuals from the non-stationary model of the seasonal pattern in monthly CVD deaths. We check up to a lag of 12 months.
set.seed(1234) # set the random seed to give repeatable results ntest.residuals = nonlintest(ns.season$residuals, n.lag=12, n.boot=500) ntest.residuals
There is evidence of remaining non-linearity in the residuals at lags of 2 to 4 months.
plot = plot(ntest.residuals, plot=FALSE) plot + scale_x_continuous(breaks = 0:12) + scale_y_continuous(breaks = 0:12) + theme_bw()+ xlab('Lag 1 (months)')+ ylab('Lag 2 (months)')+ theme(panel.grid.minor = element_blank())
The plot of the third order moment shows the lags with the strongest non-linear interactions at (0,2), (4,4) and (10,10).
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.