Time Series Analysis and Forecasting for A&E Attendances and Emergency Admission in England | by Ahmed Qassim | Towards Data Science

This project’s objective is to analyze and forecast real time series data. The reports and dataset were pulled out from the NHS England website that reports the number of Accident and Emergency Attendance and Emergency Admission to National health services and independent sector organizations in England.
Data period is starting from Aug-2010 till July-2018. As you will notice, I have focused and worked on the main column which is “Total Attendance” and planning to extend it to the other columns if any interest on the analysis was received. Here is a screenshot of the dataset:
Time series analysis is one of the important topics in data science. In this type of analysis, the data scientist works to predict the future as accurately as possible and this is called Forecasting. We can think of plenty of applications and ideas where time series analysis and forecasting can be beneficial for decision making. In my previous article (click here), I had discussed one of the applications in the healthcare sector. However, let us think of a few more applications in different sectors.
1) You can use time series analysis to predict or forecast number of hits and clicks on your website in the future by analyzing the historical events.
2) Forecast or predict the stock or gold price and trend.
3) Another application for the manufacturer to forecast the production and consumption rate. .. etc
I believe it is important for the data scientist to think of the potential values of the project and how it can be beneficial for the decision makers. This is what I personally do at the beginning of a project.
For this project, I believe by forecasting and predicting the monthly A&E (accident and emergency) attendance, many important decisions can be made easily. Either regarding the medical and non-medical stock purchasing or staff recruiting and their duty scheduling. In addition of a number of logistics preparations to host the attendees. Thus, will help to increase the quality of service and decrease the patient waiting time.
The Project:
I will use time series packages in R to analyze and forecast Total A&E Attendance NHS in England. Here is a summary of the main steps:
1. Loading libraries and dataset
2. Time Series Plotting and Analysis
3. Exploration
4. Decomposition
5. Mean & Naïve Methode Forecast
6. Forecast with Linear Regression
7. ARIMA model Forecast
8. References
Note: I am using R via Jupyter Notebook environment.
In this section, I will load the required libraries, dataset and then do some data wrangling:
library(dplyr)library(urca)library(forecast)library(dygraphs)require(ggplot2)
Loading the dataset:
df <- read.csv ( file= ".. A&E admissions.csv", header = TRUE, sep = "\t")
Change the header names, and make it more friendly to R. Now Total Attendance column will be represented as “TA” :
setnames ( df, old= c("Period","Total.Attendances), new=c("dateTime", "TA")
Check missing data in TA column:
summary(is.na(df$TA))> Mode   FALSE> logical      96
It appears that there are no missing data, great! Now, I will convert the “dateTime” column into date-time object with timezone specification using POSIX function:
to.POSIXct <- function(col) {## Function to create a POSIXct time series   ## Create a character vector from the numeric inputdateStr <- paste(as.character(col))## Return the POSIXct time series objectas.POSIXct( strptime(dateStr, "%d/%m/%Y"))}df$dateTime <- to.POSIXct(df$dateTime)class(df$dateTime)>'POSIXct' 'POSIXt'
Now, convert TA into a time series class:
TA.ts <- ts ( df[,'TA'] , frequency = 12,  start=c(2010,8), end= c(2018,7) )class(TA.ts)> 'ts'
Time series summary:
summary(TA.ts)> Min. 1st Qu.  Median    Mean 3rd Qu.    Max.> 1599364 1784570 1871972 1875892 1950438 2176022
Plot Monthly Total A&E Attendance in England
plot.ts(TA.ts, main = "Monthly Total A&E Attendance in England",           xlab = "Year", ylab = "TA")
Plot Quarterly and Yearly Total A&E Attendance in England:
TA.ts.qtr <- aggregate (TA.ts, nfrequency = 4)TA.ts.yr <- aggregate (TA.ts, nfrequency = 1)plot.ts(TA.ts.qtr, main = "Quarterly Total A&E Attendance in England", xlab = "Year", ylab = "TA")plot.ts(TA.ts.yr, main = " Yearly Total A&E Attendance in England", xlab = "Year", ylab = "TA")
Plot the histogram and boxplot to check TA distribution:
hist (TA.ts, breaks = 20, main = paste('Distribution of Total A&E Attendance in England'), xlab = "TA")
boxplot(TA.ts ~ cycle(TA.ts), xlab = "Month", ylab = "TA", main = "Monthly Total A&E Attendance in England - Boxplot")
We can notice the TA distribution and variation in the same month and among other months. May, July, then March respectively are the busiest months in the past 8 years.
Now, a close look to the total attendees in the past 8 years. This can be done by applying the moving average technique in order to smooth the trend signal. We will calculate the average of 6, 12, 24, and 36 months to control the trend smoothness.
par(mfrow = c(2,2))plot(TA.ts, col="gray", main = "Half Year Moving Average Smoothing")lines(ma(TA.ts, order = 6), col = "red", lwd=3)plot(TA.ts, col="gray", main = "1 Year Moving Average Smoothing")lines(ma(TA.ts, order = 12), col = "blue", lwd=3)plot(TA.ts, col="gray", main = "2 Year Moving Average Smoothing")lines(ma(TA.ts, order = 24), col = "green", lwd=3)plot(TA.ts, col="gray", main = "3 Year Moving Average Smoothing")lines(ma(TA.ts, order = 36), col = "yellow4", lwd=3)
We can see that the number of A&E attendees were increasing almost linearly among past years.
Next, let’s check the England population effect on the number of A&E attendance starting from 2010 to 2017. First, I have to collect a time series data for England Population. Luckily, I found the desired data in UK National Statistics website.
Eng.Pop <- read.csv(file= ".. /England Pop.csv", header = TRUE,  sep = ",")head(Eng.Pop)> Year Population> 2010 52642500> 2011 53107200> 2012 53493700> 2013 53865800> 2014 54316600> 2015 54786300
Create time series population data with a scale (1000)
pop.ts <- ts((Eng.Pop$Population)/1000, frequency = 1, start= 2010, end= 2017)
Plot population time series:
plot(pop.ts, main = "England Popuation", xlab = "Year", ylab = "Number of People in 1,000")
Now, let us remove the effect of England Population ascending from Yearly Total A&E Attendance data and then compare between the two curves:
par(mfrow = c(1,2))plot.ts((TA.ts.yr/pop.ts), lwd=2,col = "red", main = "Yearly Total A&E Attendance in England Adjusted by Population", xlab = "Year", ylab = "TA")plot.ts(TA.ts.yr, col = "blue", lwd=2, main = " Yearly Total A&E Attendance in England", xlab = "Year", ylab = "TA")
We can obviously notice that the increasing number of populations in England has a minimal effect on the yearly total number of A&E attendance between 2010 and 2017. There is almost a constant number of attendees between mid of both 2011 and 2014. Then curve jumps starting from mid-2014 till the end of 2015. Extra investigations and data are required to study why England started to receive a sudden high number of accidents and emergencies at the end of 2014.
In this step, we will decompose the time series data into three components: Trend, Seasonal and Remainder components. The remainder component has to be stationary (random noise). In other words, mean and variance have to be constant. In addition, Autocovariance function doesn’t depend on time.
I will use STL (Seasonal and Trend decomposition using Loess) decomposition for the logged Time series of TA:
autoplot( stl(log(TA.ts), s.window="periodic", robust=TRUE))
Now, we have to check and test the remainder data in order to make sure it is stationary. First, we will plot the autocorrelation function and partial autocorrelation function:
par(mfrow = c(1,2))Acf(TA_rem, main ="ACF for Remainder")Pacf(TA_rem, main ="PACF for Remainder")
There are no significant lags in ACF nor seasonal effect, which means that the autocovariance doesn’t depend on time. Let us check the constant mean and variance by plotting boxplot for the remainder:
boxplot(TA.ts_rem ~ cycle(TA.ts), xlab = "Month", ylab = "TA", main = "Boxplot of Total Attendance Remainder")
The mean and variance are constant (no significant variation). Furthermore, I will apply a Unit Root Test (KPSS test) to examine the signal. The null hypothesis of the KPSS test states that the data are stationary and we will look for any evidence to reject the null hypothesis.
TA.ts_rem %>% ur.kpss()  %>% summary()####################### # KPSS Unit Root Test # #######################> Test is of type: mu with 3 lags.> Value of test-statistic is: 0.0287  > Critical value for a significance level of:                 10pct  5pct 2.5pct  1pct> critical values 0.347 0.463  0.574 0.739
The test-statistics is less than the 10% critical value, indicating that the null hypothesis is passed and data is stationary.
Here we will apply some basic models to forecast the total number of A&E attendance for 12 months (starting from Aug-2018 to Jul-2019). The mean method is simply taking the average of all samples points. While Naïve and Naïve seasonal forecast is using the last period for next period forecast.
TA.fit.sa <- meanf(TA.ts, h = 12)TA.fit.na <- naive(TA.ts, h = 12)TA.fit.sna <- snaive(TA.ts, h = 12)plot.ts(TA.ts, main = "Monthly Total Attendance NHS in England", xlab = "Year", ylab = "TA", xlim = c(2010, 2019))lines(TA.fit.sa$mean, col = "blue")lines(TA.fit.na$mean, col = "green")lines(TA.fit.sna$mean, col = "red")legend("topleft",lty=1,col=c("blue","green", "red"), cex = 0.75, legend=c("Mean method","Naive method", "Seasonal naive method"))
First, will fit a time series linear regression model then using “forecast” package will predict the 12 months values (from Aug-2018 to Jul-2019) with 80 and 95 percent confidence intervals:
fit.lm_TA.ts <- tslm(TA.ts ~ trend+season)frcst.lm <- forecast(fit.lm_TA.ts, h = 12, level = c(80,95))plot.ts(TA.ts, main = "Monthly Total A&E Attendance in England", xlab = "Year", ylab = "TA", xlim = c(2010,2019))lis(frcst.lm$fitted, col = "b
The linear regressing model behaves pretty good as we visualized the fitted data (blue) against actual data (black). Next, let us evaluate the model by checking the residuals. Residuals mean and variance has to be constant with time as shown:
boxplot(residuals(fit.lm_TA.ts) ~ cycle(TA.ts), xlab = "Month", ylab = "TA", main = "Boxplot of Residuals")
Scatterplot between fitted and actual value:
df[,"TA.fitted"] <- as.numeric(fit.lm_TA.ts$fitted.values)plot(df$TA, df$TA.fitted, main = "Scatterplot between fitted & actual values", xlab = "Fitted Value", ylab = "Actual")abline(0, 1, col="blue")
Plotting and listing one-year forecast from Aug-2018 to Jul-2018:
plot.ts(TA.ts, main = "Monthly Total Attendance NHS in England", xlab = "Year", ylab = "TA", xlim = c(2010,2019))lines(frcst.lm$mean, col = "blue")
frcst.lm> Point          Forecast   Lo 80   Hi 80   Lo 95   Hi 95> Aug 2018        1990708 1932450 2048965 1901013 2080402> Sep 2018        1984479 1926222 2042736 1894784 2074174> Oct 2018        2045357 1987100 2103614 1955662 2135051> Nov 2018        1957509 1899252 2015766 1867814 2047204> Dec 2018        1997633 1939376 2055890 1907939 2087328> Jan 2019        1957718 1899461 2015975 1868023 2047413> Feb 2019        1860605 1802347 1918862 1770910 1950299> Mar 2019        2113073 2054816 2171330 2023378 2202768> Apr 2019        2022652 1964395 2080909 1932957 2112347> May 2019        2137346 2079089 2195603 2047651 2227040> Jun 2019        2073922 2015664 2132179 1984227 2163616> Jul 2019        2153840 2095583 2212097 2064145 2243535
ARIMA stands for Autoregressive Integrated Moving Average. It is another approach to time series forecasting. Indeed, it is the most widely used approach in time series forecasting.
In this section, we will do differencing transformation on the seasonal adjusted data in order to get the stationary signal. Then conduct some experiments to conclude the p,d,q parameters for Non-seasonal ARIMA model. Then, set P,D,Q values for the seasonal ARIMA model. Finally, will compare the results from seasonal ARIMA with Auto-ARIMA model. Here is a summary chart from Forecasting Principles and Practice book of a general process for forecasting using an ARIMA model
Remember that ARIMA(p ,d,q)(P,D,Q) model:
p = order of the autoregressive part for non-seasonal part
d = degree of first differencing involved for non-seasonal part
q = order of the moving average part for non-seasonal part
P = order of the autoregressive part for seasonal part
D = degree of first differencing involved for seasonal part
Q = order of the moving average part for seasonal part
First, we will decompose the data then re-constructed without the seasonal component — seasadj() function: Returns seasonally adjusted data:
TA.ts %>% stl(s.window='periodic') %>% seasadj() -> TA.ts_seasadjautoplot(TA.ts_seasadj, main= " Seasonal Adjusted Monthly A&E Attendance", lwt= 3)
ggtsdisplay(TA.ts_seasadj, main="Seasonal Adjusted Data with ACF and PACF plots")
Clearly, we can see that seasonal adjusted data is not stationary. Let us double check with KPSS unit root test:
TA.ts_seasadj %>% ur.kpss() %>% summary()####################### # KPSS Unit Root Test # #######################  > Test is of type: mu with 3 lags.  > Value of test-statistic is: 2.2591  > Critical value for a significance level of:                 10pct  5pct 2.5pct  1pct> critical values 0.347 0.463  0.574 0.739
The test statistics value is much higher than 1% of critical value. Which means that the signal is not stationary. To make it so, we will apply a useful transformation called differencing. “Differencing can help stabilize the mean of a time series by removing changes in the level of a time series, and therefore eliminating (or reducing) trend and seasonality”*.
TA.ts_seasadj %>% diff() -> TA.ts_diffggtsdisplay(TA.ts_diff, main="Differencing Seasonal Adjusted Data with ACF and PACF plots")
Some few significant lags in ACF plot and PACF will help us to determine p and q values for AR and MA. But in general, the signal looks stationary, let us confirm again with KPSS unit root test:
TA.ts_diff %>% ur.kpss() %>% summary()####################### # KPSS Unit Root Test # #######################> Test is of type: mu with 3 lags.> Value of test-statistic is: 0.0547> Critical value for a significance level of:                 10pct  5pct 2.5pct  1pct> critical values 0.347 0.463  0.574 0.739
test-statistics value is less than 10% critical value which means that the data is stationary. Which means that one Differencing Transformation is sufficient enough to get the stationary data. Let us evaluate and compare between several ARIMA models — ARIMA(0,1,2) , ARIMA(1,1,2) and ARIMA(1,1,1):
# ARIMA(0,1,2)summary(Arima (TA.ts_seasadj, order= c(0,1,2)))> Series: TA.ts_seasadj > ARIMA(0,1,2)> Coefficients:>          ma1      ma2>       -0.4453  -0.2117> s.e.   0.0999   0.0937> sigma^2 estimated as 1.459e+09:  log likelihood=-1136.32> AIC=2278.64   AICc=2278.9   BIC=2286.3> Training set error measures:>                 ME     RMSE      MAE       MPE     MAPE      MASE        ACF1> Training set 8044.3 37593.57 29865.46 0.3906696 1.586877 0.5389833 -0.05881525
—
# ARIMA(1,1,2)summary(Arima (TA.ts_seasadj, order= c(1,1,2)))> Series: TA.ts_seasadj > ARIMA(1,1,2)  > Coefficients:>          ar1      ma1      ma2>      -0.0782  -0.3745  -0.2516> s.e.   0.3092   0.2901   0.1742 > sigma^2 estimated as 1.474e+09:  log likelihood=-1136.29> AIC=2280.58   AICc=2281.02   BIC=2290.8 > Training set error measures:>                   ME     RMSE      MAE      MPE     MAPE      MASE       ACF1> Training set 7978.19 37581.15 29927.57 0.387108 1.589947 0.5401043 -0.0523739
—
# ARIMA(1,1,1)summary(Arima (TA.ts_seasadj, order= c(1,1,1)))> Series: TA.ts_seasadj > ARIMA(1,1,1)> Coefficients:>         ar1      ma1>       0.2644  -0.7487> s.e.  0.1427   0.0907> sigma^2 estimated as 1.477e+09:  log likelihood=-1136.91> AIC=2279.82   AICc=2280.08   BIC=2287.48> Training set error measures:>                    ME     RMSE      MAE       MPE     MAPE      MASE       ACF1> Training set 8057.644 37831.55 29899.12 0.3908637 1.589457 0.5395909 -0.019330
ARIMA(0,1,2) is the best because the square errors are much lower than coefficient values. In addition, it has the lowest AIC, BIC, and error measures values such as RMSE. Let us fit the chosen model, check the residuals and finally forecast for 12 months:
fit_TA.ts <- Arima (TA.ts_seasadj, order= c(0,1,2))checkresiduals(fit_TA.ts, lag = 10)> Ljung-Box test > data:  Residuals from ARIMA(0,1,2)> Q* = 7.0949, df = 8, p-value = 0.5264 > Model df: 2.   Total lags used: 10
The Residuals are almost normally distributed, slightly skewed. ACF shows no significant values except at lag 12. Ljung-Box test with significant p-values concludes that residuals are random (white noise).
Forecasting for 12 months, starting from Aug-2018 till Jul-2019:
frcst_TA.ts = forecast (fit_TA.ts, h=12)plot(frcst_TA.ts)
After many iterations, I had estimated the values of seasonal part (P,D,Q) as (1,1,1). Next, will fit, evaluate and forecast a seasonal ARIMA model:
fit.seas_TA.ts <- Arima (TA.ts, order= c(0,1,2), seasonal=c(1,1,1))summary(fit.seas_TA.ts)> Series: TA.ts > ARIMA(0,1,2)(1,1,1)[12]  > Coefficients:>           ma1      ma2     sar1     sma1>       -0.5537  -0.2862  -0.3102  -0.6428> s.e.   0.1050   0.1036   0.1416   0.1891 > sigma^2 estimated as 1.741e+09:  log likelihood=-1005.48> AIC=2020.96   AICc=2021.74   BIC=2033.06 > Training set error measures:>                    ME     RMSE      MAE       MPE     MAPE      MASE> Training set 3386.278 37856.27 28465.13 0.1337672 1.513877 0.5137116>                      ACF1> Training set -0.009264586
All square errors are much lower than the absolute value of coefficients. AIC and BIC are behaving better than non-seasonal ARIMA model (0,1,2). Again, we need to make sure that residuals are random and they are unstructured:
checkresiduals(fit.seas_TA.ts)> Ljung-Box test > data:  Residuals from ARIMA(0,1,2)(1,1,1)[12]> Q* = 23.202, df = 20, p-value = 0.279 > Model df: 4.   Total lags used: 24
Histogram distribution is skewed a little but still, model passes the Ljung-Box test. the p-value is significant and there are no significant lags in the ACF plot. Thus, we now have a seasonal ARIMA model that passes the checks and is ready for forecasting. Forecasts from the model for the next one year are shown below:
frcs.seas_TA.ts <- forecast (fit.seas_TA.ts, h=12)summary(frcs.seas_TA.ts)> Forecast method: ARIMA(0,1,2)(1,1,1)[12] > Model Information:> Series: TA.ts > ARIMA(0,1,2)(1,1,1)[12]  > Coefficients:>           ma1      ma2     sar1     sma1>       -0.5537  -0.2862  -0.3102  -0.6428> s.e.   0.1050   0.1036   0.1416   0.1891 > sigma^2 estimated as 1.741e+09:  log likelihood=-1005.48> AIC=2020.96   AICc=2021.74   BIC=2033.06 > Error measures:>                    ME     RMSE      MAE       MPE     MAPE      MASE> Training set 3386.278 37856.27 28465.13 0.1337672 1.513877 0.5137116>                      ACF1> Training set -0.009264586 > Forecasts:>          Point Forecast   Lo 80   Hi 80   Lo 95   Hi 95> Aug 2018        2021727 1968205 2075248 1939872 2103581> Sep 2018        2014485 1955875 2073094 1924849 2104121> Oct 2018        2070211 2010979 2129444 1979623 2160800> Nov 2018        1990520 1930671 2050369 1898988 2082052> Dec 2018        2024607 1964148 2085067 1932142 2117072> Jan 2019        1981844 1920780 2042907 1888455 2075233> Feb 2019        1880516 1818854 1942178 1786212 1974820> Mar 2019        2139569 2077315 2201824 2044359 2234780> Apr 2019        2036234 1973392 2099076 1940126 2132342> May 2019        2161701 2098278 2225124 2064703 2258698> Jun 2019        2092552 2028553 2156552 1994674 2190431> Jul 2019        2175445 2110872 2240018 2076689 2274200
Plot 12 months forecast of ARIMA(0,1,2) (1,1,1) [12]:
plot(frcs.seas_TA.ts)
On the other hand, We can just use auto.arima() to do most of the work. It will give the following result:
fit_TA = auto.arima(TA.ts, max.p=5, max.q=5,                   max.P=2 , max.Q=2, max.order=5, max.d=2, max.D=2,                    start.p=0, start.q=0, start.P=0, start.Q=0)frcst_TA = forecast(fit_TA, h=12)summary(frcst_TA)> Forecast method: ARIMA(1,0,0)(1,1,1)[12] with drift> Model Information:> Series: TA.ts > ARIMA(1,0,0)(1,1,1)[12] with drift> Coefficients:>          ar1     sar1     sma1      drift>       0.4134  -0.2152  -0.7774  2753.7605> s.e.  0.1001   0.1514   0.2567   225.8097> sigma^2 estimated as 1.667e+09:  log likelihood=-1016.63> AIC=2043.26   AICc=2044.03   BIC=2055.41> Error measures:>                     ME     RMSE      MAE        MPE     MAPE      MASE> Training set -1930.433 37268.02 28165.95 -0.1540752 1.507049 0.5083123>                    ACF1> Training set 0.01430932> Forecasts:>          Point Forecast   Lo 80   Hi 80   Lo 95   Hi 95> Aug 2018        2015362 1962792 2067932 1934963 2095761> Sep 2018        1997133 1940272 2053995 1910171 2084096> Oct 2018        2044986 1987423 2102549 1956951 2133021> Nov 2018        1958307 1900624 2015989 1870089 2046524> Dec 2018        1994969 1937266 2052671 1906720 2083217> Jan 2019        1949321 1891615 2007027 1861067 2037575> Feb 2019        1857882 1800176 1915589 1769627 1946137> Mar 2019        2115227 2057520 2172934 2026972 2203482> Apr 2019        2015541 1957834 2073247 1927286 2103795> May 2019        2131158 2073452 2188864 2042904 2219412> Jun 2019        2066159 2008456 2123863 1977909 2154410> Jul 2019        2147445 2089755 2205135 2059215 2235674
Plot the 12 months forecast of ARIMA (1,0,0) (1,1,1) [12]:
plot(frcst_TA)
In the end, let’s consolidate all the forecasting results from Seasonal Naive, Linear Regressing, ARIMA(0,1,2)(1,1,1) and Auto ARIMA(1,0,0)(1,1,1) in one data frame called summary.ts and then do line plotting:
summary.ts>    Seas.Naive	Linear.Reg	ARIMA	Auto.ARIMA> Aug-18	1924663	1990708	2021727	2015362> Sep-18	1925961	1984479	2014485	1997133> Oct-18	2044137	2045357	2070211	2044986> Nov-18	1976971	1957509	1990520	1958307> Dec-18	2003954	1997633	2024607	1994969> Jan-19	2000086	1957718	1981844	1949321> Feb-19	1820012	1860605	1880516	1857882> Mar-19	2049785	2113073	2139569	2115227> Apr-19	1978084	2022652	2036234	2015541> May-19	2161779	2137346	2161701	2131158> Jun-19	2091318	2073922	2092552	2066159> Jul-19	2176022	2153840	2175445	2147445
— — -
summary(summary.ts)>       Seas.Naive        Linear.Reg          ARIMA           Auto.ARIMA     > Min.   :1820012   Min.   :1860605   Min.   :1880516   Min.   :1857882  > 1st Qu.:1964219   1st Qu.:1977789   1st Qu.:2008494   1st Qu.:1985803  > Median :2002020   Median :2010143   Median :2030421   Median :2015451  > Mean   :2012731   Mean   :2024570   Mean   :2049118   Mean   :2024458  > 3rd Qu.:2060168   3rd Qu.:2083709   3rd Qu.:2104307   3rd Qu.:2078426  > Max.   :2176022   Max.   :2153840   Max.   :2175445   Max.   :2147445
Actually, I have read many articles to practice time series analysis. The most useful one, after all, was: Forecasting: principles and practice Book by Rob J Hyndman (Author), George Athanasopoulos (Author)
In addition, the course and certificate I had from Microsoft (Applied Machine Learning) were very beneficial as well. There were hands-on labs besides the valuable information about time series analysis.