6.-Case-Study-1

Case Study 1 ECO374 Install and load required R packages if (!require( "quantmod" )) install.packages( "quantmod" ) if (!require( "ggplot2" )) install.packages( "ggplot2" ) if (!require( "stats" )) install.packages( "stats" ) if (!require( "tsDyn" )) install.packages( "tsDyn" ) if (!require( "forecast" )) install.packages( "forecast" ) if (!require( "urca" )) install.packages( "urca" ) library(quantmod) # functions: getSymbols library(ggplot2) # functions: ggplot library(stats) # functions: arima library(tsDyn) # functions: SETAR library(forecast) # functions: auto.arima, nnetar library(urca) # functions: ur.kpss 1. Data Data: iShares Core S&P Total U.S. Stock Market ETF ( Source ) ITOT <- getSymbols( "ITOT" , src= "yahoo" , return.class= "xts" , auto.assign= F) ITOT <- window(ITOT, start= as.Date( "2022-11-01" ), end= as.Date( "2023-09-01" )) ITOT.c <- ITOT$ITOT.Close # extract close price seed <- 2345 Plot data ggplot(ITOT.c, aes( x= index(ITOT.c), y= ITOT.Close)) + geom_line( color= "springgreen4" ) + labs( x= "" , y= "" , title= "Core S&P Total U.S. Stock Market, Close" ) + theme_minimal() + theme( plot.title = element_text( size= 10 )) + scale_x_date( date_breaks= "1 months" , date_labels = "%Y-%m" ) 85 90 95 100 2022-11 2022-12 2023-01 2023-02 2023-03 2023-04 2023-05 2023-06 2023-07 2023-08 2023-09 Core S&P Total U.S. Stock Market, Close 1

Difference data and plot D_ITOT.c <- na.omit(diff(ITOT.c, lag= 1 , differences= 1 )) ggplot(D_ITOT.c, aes( x= index(D_ITOT.c), y= ITOT.Close)) + geom_line( color= "darkblue" ) + labs( x= "" , y= "" , title= "Differenced Core S&P Total U.S. Stock Market, Close" ) + theme_minimal() + theme( plot.title = element_text( size= 10 )) + scale_x_date( date_breaks= "3 months" , date_labels = "%Y-%m" ) -2.5 0.0 2.5 5.0 2023-01 2023-04 2023-07 Differenced Core S&P Total U.S. Stock Market, Close 2. Stationarity (unit root) test ur.test <- ur.kpss(ITOT.c) summary(ur.test) ## ## ####################### ## # KPSS Unit Root Test # ## ####################### ## ## Test is of type: mu with 4 lags. ## ## Value of test-statistic is: 3.4622 ## ## Critical value for a significance level of: ## 10pct 5pct 2.5pct 1pct ## critical values 0.347 0.463 0.574 0.739 We reject at 5% level the null hypothesis that the data is stationary. Let’s test the differenced data. ur.test.d <- ur.kpss(D_ITOT.c) summary(ur.test.d) ## ## ####################### ## # KPSS Unit Root Test # ## ####################### ## 2

-0.15 -0.05 0.05 Lag Partial ACF 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 4. Model Selection Best-fitting ARMA model on the full data set auto.arima(ITOT.c) ## Series: ITOT.c ## ARIMA(3,1,1) ## ## Coefficients: ## ar1 ar2 ar3 ma1 ## 0.9245 -0.1008 0.0900 -0.9403 ## s.e. 0.1163 0.0944 0.0735 0.0926 ## ## sigma^2 = 0.8584: log likelihood = -278.6 ## AIC=567.19 AICc=567.49 BIC=583.91 Best-fitting ARMA model on the differenced full data set auto.arima(D_ITOT.c) ## Series: D_ITOT.c ## ARIMA(3,0,1) with zero mean ## ## Coefficients: ## ar1 ar2 ar3 ma1 ## 0.9245 -0.1008 0.0900 -0.9403 ## s.e. 0.1162 0.0944 0.0735 0.0926 ## ## sigma^2 = 0.8583: log likelihood = -278.6 ## AIC=567.19 AICc=567.49 BIC=583.91 4

Time-series validation MSE for Specified Models data <- ITOT.c D_data <- D_ITOT.c # Loop over different model specifications for (m in 1 : 6 ) { TT <- length(data) T1 <- floor( 0.2 *TT) # start at 20% of the sample size step <- 20 # forecast data horizon for MSE MSE.t <- matrix( 0 , nrow= TT-T1+ 1 , ncol= 1 ) # initialize MAE.t <- MSE.t MAPE.t <- MSE.t tseq <- seq( from= T1, to= TT, by= step) tseq <- tseq[-length(tseq)] for (j in tseq) { # auto.arima model if (m== 1 ) {fcst <- forecast(arima(data[ 1 :j -1 ], order= c( 3 , 1 , 1 )), h= step) yhat <- as.numeric(fcst[[ 4 ]])} # ARMA(2,2) on differenced data (based on ACF and PACF) if (m== 2 ) {fcst <- forecast(arima(data[ 1 :j -1 ], order= c( 2 , 1 , 2 )), h= step) # the fcst$mean forecast is stored in the 4th element of the list fcst yhat <- as.numeric(fcst[[ 4 ]])} # ARMA(2,2) on differenced data with one seasonal AR lag if (m== 3 ) {fcst <- forecast(arima(data[ 1 :j -1 ], order= c( 2 , 1 , 2 ), seasonal= c( 1 , 1 , 0 )), h= step) yhat <- as.numeric(fcst[[ 4 ]])} # SETAR model with a threshold of 0 if (m== 4 ) {fcst <- predict(setar(D_data[ 1 :j -1 ], mL= 1 , mH= 1 , th= 0 ), n.ahead= step) yhat <- as.numeric(fcst) yhat <- cumsum(yhat) + as.numeric(last(data[ 1 :j -1 ]))} # cumulate forecast differences # LSTAR model if (m== 5 ) {fcst <- predict(lstar(D_data[ 1 :j -1 ], m= 1 , d= 1 , mL= 1 , mH= 1 , trace= FALSE), n.ahead= step) yhat <- as.numeric(fcst) yhat <- cumsum(yhat) + as.numeric(last(data[ 1 :j -1 ]))} # cumulate forecast differences # NNAR with parameters selected in file 5. NNAR Application if (m== 6 ) {set.seed(seed) fcst <- forecast(nnetar(data[ 1 :j -1 ], p= 5 , P= 0 , size= 4 ), h= step) # the fcst$mean forecast is stored in the 16th element of the list fcst yhat <- as.numeric(fcst[[ 16 ]][ 1 :step])} js <- j+step -1 MSE.t[(j-T1+ 1 ):(js-T1+ 1 )] <- (as.numeric(data[j:js])-yhat)ˆ 2 MAE.t[(j-T1+ 1 ):(js-T1+ 1 )] <- abs(as.numeric(data[j:js])-yhat) MAPE.t[(j-T1+ 1 ):(js-T1+ 1 )] <- 100 *abs((as.numeric(data[j:js])-yhat)/yhat) } if (m<= 3 ) print(fcst$method) if (m== 4 ) print( "SETAR" ) if (m== 5 ) print( "LSTAR" ) 5