Time Series Modeling for Atmospheric CO2 Concentration(ppm), 1958–2019 | by Peyman Kor | Towards Data Science

In this post, I will go through the Time Series Modeling for historical CO2 Concentration (1958–2019) in R. The Seasonal ARIMA modeling will be used to build the model. The source code in the Rmarkdown format could be found in the author’s GitHub link here. Knowing that it has often been stated that the CO2 concentration should be attained below 460 ppm before the start of the second half of this century, specifically, this post seeks to answer this question:
If the current trend in Co2 Concentration continues (Business as usual) what is the chance to reach 460 ppm at the beginning of the second half of the century?
Ok, Let’s go start!
The first things to do is to import the required packages in this analysis (if you have not installed them, install these package in the R beforehand):
library(tidyverse)library(forecast)library(lubridate)library(car)library(scales)library(patchwork)library(kableExtra)
The data of monthly CO2 Concentration in (ppm) over the period of the “1960/3–2019/12” measured at Mauna Loa Observatory, Hawaii will be used in this analysis. The link for this data is available here:
https://www.esrl.noaa.gov/gmd/ccgg/trends/data.html
Now, to read this data in the R, couples of points must be considered:
The data has the comments, which is not our interest in analysis. Therefore, we show that with *comment.char = ‘#’ *,
The data has 7 columns yet some of them like the Year and Month label have not been written in the data, so while importing we assign the following column names (Year, Month, Time, Co2_con, Interpolated, Trend, Days).
The columns were separated using the white space, therefore the sep =” ’’ will be added to the code.
Since we are including the column names, the header = F could be included.
data <- read.delim('ftp://aftp.cmdl.noaa.gov/products/trends/co2/co2_mm_mlo.txt', comment.char = '#', header = F, sep = '', col.names = c('Year','Month','Time','Co2_Concentration','Interpolated','Trend','Days'))
Look on any NA values:
which(is.na(data))## integer(0)
Good, we have the complete measured data! However, when reading the data we see some -99.99 values! — be careful, as was mentioned in the comments these values are when the measurement was not available — so for these points (which are 7 out of 741 measurements), we use the Interpolated column:
data_cc <- data %>%     mutate(        Co2_Con = case_when(            Co2_Concentration == -99.99 ~ Interpolated,            TRUE ~ Co2_Concentration        )    )
Let’s have look on column types:
sapply(data_cc, class)##              Year             Month              Time Co2_Concentration ##         "integer"         "integer"         "numeric"         "numeric" ##      Interpolated             Trend              Days           Co2_Con ##         "numeric"         "numeric"         "integer"         "numeric"
We can see that column types are in an appropriate format, yet we can add the new column named Date which gives the date of measurement in the standard time-series format.
Here Lubridate package provides an easy method to convert our Year and Month column to date:
data_cc$Date <- ymd(paste0(data$Year, " ", data$Month, " ", "15"))
Also, we can see in the analysis we want to do, we do not need all columns, so we could select the required column needed in our analysis:
data_cc_sel <- data_cc %>%     select(Year, Month, Date, Co2_Con )
Also, we need to have a portion of our data, to test the model we develop based on the training data- So, Here, we consider the data for 2017, 2018 and 2019 as the test data, the rest is the training data.
data_cc_sel_test <- data_cc_sel %>%     filter(Year > 2016)data_cc_sel_train <- data_cc_sel %>%     filter(Year <= 2016)
Now, let’s visualize the data first,
ggplot(data_cc_sel,aes(Date, Co2_Con)) +    geom_line(color='blue') +    xlab("Year, Month") +    scale_x_date(date_labels = "%Y-%m", date_breaks = "5 year") +    theme(axis.text.x = element_text(face = "bold", color = "#993333",                            size = 12, angle = 45, hjust = 1)) +    ylab("CO2 Concentration (ppm)") +    #scale_x_continuous(breaks = trans_breaks(identity, identity, n = 10))    scale_y_continuous() +    theme(axis.text.y = element_text(face = "bold", color = "#993333",                            size = 10, hjust = 1),axis.title.y = element_text(size = 10))
Now, sometimes it is nice as well to plot all Total data set, training, and test next to each other using the “patchwork” package:
p1 <- ggplot(data_cc_sel,aes(Date, Co2_Con)) +    geom_line(color='blue') +    xlab("Year, Month") +    scale_x_date(date_labels = "%Y-%m", date_breaks = "5 year") +    theme(axis.text.x = element_text(face = "bold", color = "#993333",                            size = 12, angle = 45, hjust = 1)) +    ylab("CO2 Concentration (ppm)") +    #scale_x_continuous(breaks = trans_breaks(identity, identity, n = 10))    scale_y_continuous() +    theme(axis.text.y = element_text(face = "bold", color = "#993333",                            size = 10, hjust = 1),axis.title.y = element_text(size = 8))p2 <- ggplot(data_cc_sel_train,aes(Date, Co2_Con)) +    geom_line(color='blue') +    xlab("Year, Month") +    scale_x_date(date_labels = "%Y-%m", date_breaks = "5 year") +    theme(axis.text.x = element_text(face = "bold", color = "#993333",                            size = 12, angle = 45, hjust = 1)) +    ylab("CO2 Concentration (ppm)") +    #scale_x_continuous(breaks = trans_breaks(identity, identity, n = 10))    scale_y_continuous() +    theme(axis.text.y = element_text(face = "bold", color = "#993333",                            size = 10, hjust = 1), axis.title.y = element_text(size = 8))p3 <- ggplot(data_cc_sel_test,aes(Date, Co2_Con)) +    geom_line(color='blue') +    xlab("Year, Month") +    scale_x_date(date_labels = "%Y-%m", date_breaks = "1 year") +    theme(axis.text.x = element_text(face = "bold", color = "#993333",                            size = 12, angle = 45, hjust = 1)) +    ylab("CO2 Concentration (ppm)") +    #scale_x_continuous(breaks = trans_breaks(identity, identity, n = 10))    scale_y_continuous() +    theme(axis.text.y = element_text(face = "bold", color = "#993333",                            size = 10, hjust = 1), axis.title.y = element_text(size = 8))(p2 | p3 ) /      p1
In time series analysis, the first three things we need to know about the trends are:
Is the data stationary?
Answer: Not, we see the clear trend in the plot, so the properties of CO2 concentration depend on time (for example the mean of the data is time-dependent, sign of non -stationary).
Is there any seasonality in data?
Answer: Yes, we can definitely see the seasonality in the data. Now, knowing the non-stationary and seasonality of the data, it suggests using the seasonal differencing to model the data. To answer,
How are the Autocorrelation function and Partial Autocorrelation?
Here is the plot of ACF and PACF from the forecast package:
Co2_train <- ts(data_cc_sel_train$Co2_Con, start = c(1958,3), frequency = 12)Co2_train %>% ggtsdisplay()
Clearly, the data shows the need differencing (since ACF is not going down zero), now we make the ordinary differencing of the with the lag of 12:
Co2_train %>% diff(lag=12) %>% diff() %>% ggtsdisplay()
Now, it is better, we substantially removed the trend. We start the model with the d=D = 1 in the ARIMA(p,d,q)(P,D,Q)[12] (the reason we had differencing both seasonal and non-seasonal part in the above plot.)
Now, we must have some starting parameters for p,q,P,Q . So, let’s look at the above ACF and PACF:
In the seasonal lags, there is one significant spike in the ACF, suggesting a possible MA(1) term. so, the starting point is Q = 1
In the plots of the non-seasonal differenced data, there are three spikes at ACF plot, this may be suggestive of a seasonal MA(3) term, q=3.
Consequently, we start to withe the ARIMA(0,1,3)(3,1,1)[12] and make variations in the AR and MA terms. Here, while keeping the order constant (d,D), we use the AICs values to judge the quality of models. (minimize the AICs)
aicsvalue <- function(p,q,P,Q) {  fit <- Arima(Co2_train, order=c(p,1,q),seasonal=list(order=c(P,1,Q),period=12),                  lambda = "auto"              )  return(fit$aicc)}model_eva <- data.frame(Model_name=c("ARIMA(0,1,3)(3,1,1)[12]","ARIMA(0,1,1)(3,1,1)[12]","ARIMA(1,1,0)(1,1,0)[12]",                                     "ARIMA(1,1,2)(1,1,0)[12]","ARIMA(1,1,3)(0,1,1)[12]","ARIMA(1,1,1)(1,1,0)[12]",                                     "ARIMA(1,1,1)(1,1,0)[12]","ARIMA(1,1,0)(1,1,1)[12]","ARIMA(1,1,1)(0,1,1)[12]" ), AICc=c(aicsvalue(0,3,3,1),aicsvalue(0,1,3,1),aicsvalue(1,0,1,0),                                                            aicsvalue(1,2,1,0),aicsvalue(1,3,0,1),aicsvalue(1,1,1,0),                                                           aicsvalue(1,1,1,0),aicsvalue(1,0,1,1), aicsvalue(1,1,0,1)))
Based on the above analysis, the ARIMA(1, 1, 1)(0, 1, 1)[12] will be selected, but we need to check the residual to avoid any over and underfitting as well, to see the Ljung-Box test whether the residuals resembles white noise or not.
(fit_minaicc <- Arima(Co2_train, order=c(1,1,1),seasonal=list(order=c(0,1,1),period=12),                  lambda = "auto"              ))checkresiduals(fit_minaicc, lag=36)fit_minaicc$aicc
## ##  Ljung-Box test## ## data:  Residuals from ARIMA(2,0,1)(1,1,1)[12] with drift## Q* = 32.406, df = 30, p-value = 0.3489## ## Model df: 6.   Total lags used: 36
Now, we can see the residual sufficiently resembles the white noise also the p-value is high and the model passes the test for Ljong-Box test. (However it must be mentioned the some of the ACF are just reaching the boundary in the blue line, yet, I do not think it will affect the prediction substantially — sometimes it is difficult to have model pass all tests.)
However, still, this is not the end of model selection. Here, compare the performance of the model on the Test data. We seek to find the model which minimizes the RMSE.
Co2_test <- ts(data_cc_sel_test$Co2_Con, start = c(2017,1), frequency = 12)mm <- accuracy(forecast(fit_minaicc,h=35)$mean, Co2_test )
This section compares the RMSE values for the 9 models provided in the previous section.
rmse_eva <- function(p,d,q,P,D,Q) {  fit <- Arima(Co2_train, order=c(p,d,q),seasonal=list(order=c(P,D,Q),period=12),                  lambda = "auto", include.drift = T              )  mm <- accuracy(forecast(fit,h=35)$mean, Co2_test)  return(mm[2])}rmse_eva <- data.frame(Model_name=c("ARIMA(0,1,3)(3,1,1)[12]","ARIMA(0,1,1)(3,1,1)[12]","ARIMA(1,1,0)(1,1,0)[12]","ARIMA(1,1,2)(1,1,0)[12]","ARIMA(1,1,3)(0,1,1)[12]","ARIMA(1,1,1)(1,1,0)[12]","ARIMA(1,1,1)(1,1,0)[12]","ARIMA(1,1,0)(1,1,1)[12]","ARIMA(1,1,1)(0,1,1)[12]" ), RMSE=c(                        rmse_eva(0,1,3,3,1,1),rmse_eva(0,1,1,3,1,1),rmse_eva(1,1,0,1,1,0),                                                  rmse_eva(1,1,2,1,1,0),rmse_eva(1,1,3,0,1,1),rmse_eva(1,1,1,1,1,0),                                                  rmse_eva(1,1,1,1,1,0),rmse_eva(1,1,0,1,1,1),rmse_eva(1,1,1,0,1,1)))
The results show that the model ARIMA(1,1,1)(0,1,1)[12] does not has the minimum RMSE value, yet it is very close to the minimum, however, it was minimum in the AICc values. At the end, knowing that the model residuals follow the white noise, the model ARIMA(1,1,1)(0,1,1)[12] is selected to forecast the package due to it’s fewer parameters and simplicity while keeping the minimum AICs. (Note: If the criteria were set to the RMSE, that may lead us very complex model with many parameters)
Co2_train %>%  Arima(order=c(1,1,1),seasonal=list(order=c(0,1,1),period=12),                lambda = "auto"              ) %>%  forecast(h=400) %>%  autoplot() +    ylab("H02 sales (million scripts)") + xlab("Year") +  autolayer(Co2_test)
Let’s zoom in the model prediction and the test data to see the model performance visually:
prediction <- forecast(fit_minaicc,h=35) data_cc_sel_test$prediction <- prediction$meandata_test_pre_tidy <- gather(data_cc_sel_test, "type", "Co2", -Year,-Month,-Date)## Warning: attributes are not identical across measure variables;## they will be droppedggplot(data_test_pre_tidy,aes(Date, Co2,color=type)) +    geom_line() +    xlab("Year, Month") +    scale_x_date(date_labels = "%Y-%m", date_breaks = "1 year") +    theme(axis.text.x = element_text(face = "bold", color = "#993333",                            size = 12, angle = 45, hjust = 1)) +    ylab("CO2 Concentration (ppm)") +    #scale_x_continuous(breaks = trans_breaks(identity, identity, n = 10))    scale_y_continuous() +    theme(axis.text.y = element_text(face = "bold", color = "#993333",                            size = 10, hjust = 1), axis.title.y = element_text(size = 8))
Now, given the developed model the question we want to answer is:
Given the developed model, what is the chance of reaching 460 ppm in 2050? To answer this question, we first need to build the cumulative distribution of the CO2 Concentration in 2050 :
prediction1 <- forecast(fit_minaicc,h=396, level = c(80,90)) p10 <- prediction1$upper[396,2]p50 <- prediction1$mean[396]sd_calc <- (p10-p50)/1.28Co2_con_2050 <- rnorm(10^6,p50,sd_calc)cdf_co2_con_2050 <- ecdf(Co2_con_2050)cdf_co2_con_2050_data <- data.frame(Co2_con_2050)ggplot(cdf_co2_con_2050_data, aes(Co2_con_2050)) + stat_ecdf(geom = "step", color='blue') +  geom_vline(xintercept = 460, color='red') +  geom_hline(yintercept = cdf_co2_con_2050(460), color='red') +  theme(axis.text.x = element_text(face = "bold", color = "#993333",                            size = 12, angle = 0, hjust = 1)) +  scale_x_continuous(breaks=c(400,425,450, 460,475,500,525, 550), limits = c(425,525)) +  scale_y_continuous(breaks=c(seq(0,1,0.1)), limits = c(0,1)) +  ylab('Cumulative Distribution') +  xlab("Co2 Concentraion(ppm) at 2050")## Warning: Removed 238 rows containing non-finite values (stat_ecdf).
Now, having the cumulative distribution, we could ask this question:
What is the probability the CO2 concentration (ppm) will stay below 460 level by 2050?
cdf_co2_con_2050(460)## [1] 0.089823
As you can see, the answer is around 9%.