Methods
This project will use time series forecasting.
The dependent variable is the stock estimate and the independent variables are time and the stock categories. The time series equation model in plot data visualization is the descriptive statistics and the visual analysis used by this project. The linear trend regression equation will be used. Lastly, the assumptions made for this analysis are 95% confidence interval, linear relationship between the dependent and independent varuables, and normally distributed visuals.
Install and load libraries
library("readxl")
library("ggpubr")
## Loading required package: ggplot2
library("tidyverse")
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library("gclus")
## Loading required package: cluster
library("ggplot2")
theme_set(theme_pubr())
Import data
SP500df <- read_excel("S&P500.xlsx")
Create a time series plot
plot(SP500df$Date, SP500df$Open, type = "l", col = 2, xlab = "Date",
ylab = "Price", main = "S&P500 Stocks")
lines(SP500df$Date, SP500df$High, type = "l", col = 3)
lines(SP500df$Date, SP500df$Low, type = "l", col = 4)
lines(SP500df$Date, SP500df$Close, type = "l", col = 5)
lines(SP500df$Date, SP500df$`Adj Close`, type = "l", col = 6)
legend("topleft", c("Open", "High", "Low", "Close", "Adj Close"), lty = 1,
col = 2:6)
Interpretation: The time series plot exhibits a positive linear trend pattern.
Plotting just the Highs and Lows for clarity
plot(SP500df$Date, SP500df$High, type = "l", col = 2, xlab = "Date",
ylab = "Price", main = "S&P500 Stocks")
lines(SP500df$Date, SP500df$Low, type = "l", col = 3)
legend("topleft", c("High", "Low"), lty = 1,
col = 2:3)
Creating time series equation models (linear trend regression)
Converting date to year
SP500df$Date <- as.numeric(format(SP500df$Date, "%Y"))
colnames(SP500df) <- c("Year", "Open", "High", "Low", "Close", "Adj Close",
"Volume") # Renaming columns
Prerequiste- Removing scientific notation
options(scipen = 999)
Open
model_open <- lm(SP500df$Open ~ Year, data = SP500df)
summary(model_open)
##
## Call:
## lm(formula = SP500df$Open ~ Year, data = SP500df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1044.13 -252.15 -34.22 214.83 1951.37
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -160967.195 4050.097 -39.74 <0.0000000000000002 ***
## Year 81.006 2.022 40.07 <0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 468.9 on 451 degrees of freedom
## Multiple R-squared: 0.7807, Adjusted R-squared: 0.7802
## F-statistic: 1606 on 1 and 451 DF, p-value: < 0.00000000000000022
Interpretation:
The linear trend equation is y = -160967.20 + 81.01*t
The R-squared shows the relationship between the independent and dependent variable is relatively strong, so the model is good.
The p-value is below the alpha of 0.05, meaning the model is significant.
High
model_high <- lm(SP500df$High ~ Year, data = SP500df)
summary(model_high)
##
## Call:
## lm(formula = SP500df$High ~ Year, data = SP500df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1001.25 -274.51 -37.06 219.34 1969.39
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -166471.402 4201.145 -39.62 <0.0000000000000002 ***
## Year 83.776 2.097 39.95 <0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 486.4 on 451 degrees of freedom
## Multiple R-squared: 0.7797, Adjusted R-squared: 0.7792
## F-statistic: 1596 on 1 and 451 DF, p-value: < 0.00000000000000022
Interpretation:
The linear trend equation is y = -166471.40 + 83.78*t
The R-squared shows the relationship between the independent and dependent variable is relatively strong, so the model is good.
The p-value is below the alpha of 0.05, meaning the model is significant.
Low
model_low <- lm(SP500df$Low ~ Year, data = SP500df)
summary(model_low)
##
## Call:
## lm(formula = SP500df$Low ~ Year, data = SP500df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1043.23 -230.34 -25.45 219.23 1914.20
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -154955.380 3884.299 -39.89 <0.0000000000000002 ***
## Year 77.982 1.939 40.22 <0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 449.7 on 451 degrees of freedom
## Multiple R-squared: 0.782, Adjusted R-squared: 0.7815
## F-statistic: 1618 on 1 and 451 DF, p-value: < 0.00000000000000022
Interpretation:
The linear trend equation is y = -161554.88 + 81.30*t
The R-squared shows the relationship between the independent and dependent variable is relatively strong, so the model is good.
The p-value is below the alpha of 0.05, meaning the model is significant.
Close
model_close <- lm(SP500df$Close ~ Year, data = SP500df)
summary(model_close)
##
## Call:
## lm(formula = SP500df$Close ~ Year, data = SP500df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1047.14 -257.67 -29.72 214.92 2008.31
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -161554.88 4046.80 -39.92 <0.0000000000000002 ***
## Year 81.30 2.02 40.25 <0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 468.5 on 451 degrees of freedom
## Multiple R-squared: 0.7822, Adjusted R-squared: 0.7818
## F-statistic: 1620 on 1 and 451 DF, p-value: < 0.00000000000000022
Interpretation:
The linear trend equation is y = -161554.88 + 81.30*t
The R-squared shows the relationship between the independent and dependent variable is relatively strong, so the model is good.
The p-value is below the alpha of 0.05, meaning the model is significant.
Adjusted Close
model_adj_close <- lm(SP500df$`Adj Close` ~ Year, data = SP500df)
summary(model_adj_close)
##
## Call:
## lm(formula = SP500df$`Adj Close` ~ Year, data = SP500df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1047.14 -257.67 -29.72 214.92 2008.31
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -161554.88 4046.80 -39.92 <0.0000000000000002 ***
## Year 81.30 2.02 40.25 <0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 468.5 on 451 degrees of freedom
## Multiple R-squared: 0.7822, Adjusted R-squared: 0.7818
## F-statistic: 1620 on 1 and 451 DF, p-value: < 0.00000000000000022
Interpretation:
The linear trend equation is y = -161554.88 + 81.30*t
The R-squared shows the relationship between the independent and dependent variable is relatively strong, so the model is good.
The p-value is below the alpha of 0.05, meaning the model is significant.
Calculating the mean absolute percentage error
Creating a dataframe for 1985-2022
new_data2 <- data.frame(Year = c(1985:2022))
Open
prediction_open <- data.frame(predict(model_open, newdata = new_data2))
colnames(prediction_open) <- "Open"
avgs_open <- aggregate(x = SP500df$Open, by = list(SP500df$Year), FUN = mean)
colnames(avgs_open) <- c("Year", "Open")
mean(abs((avgs_open$Open - prediction_open$Open)/avgs_open$Open)) * 100
## [1] 34.93284
Interpretation:
The MAPE for open is 34.93% this means it is relatively accurate.
High
prediction_high <- data.frame(predict(model_high, newdata = new_data2))
colnames(prediction_high) <- "High"
avgs_high <- aggregate(x = SP500df$High, by = list(SP500df$Year), FUN = mean)
colnames(avgs_high) <- c("Year", "High")
mean(abs((avgs_high$High - prediction_high$High)/avgs_high$High)) * 100
## [1] 35.25953
Interpretation:
The MAPE for high is 35.26% this means it is relatively accurate.
Low
prediction_low <- data.frame(predict(model_low, newdata = new_data2))
colnames(prediction_low) <- "Low"
avgs_low <- aggregate(x = SP500df$Low, by = list(SP500df$Year), FUN = mean)
colnames(avgs_low) <- c("Year", "Low")
mean(abs((avgs_low$Low - prediction_low$Low)/avgs_low$Low)) * 100
## [1] 34.52231
Interpretation:
The MAPE for low is 34.52% this means it is relatively accurate.
Close
prediction_close <- data.frame(predict(model_close, newdata = new_data2))
colnames(prediction_close) <- "Close"
avgs_close <- aggregate(x = SP500df$Close, by = list(SP500df$Year), FUN = mean)
colnames(avgs_close) <- c("Year", "Close")
mean(abs((avgs_close$Close - prediction_close$Close)/avgs_close$Close)) * 100
## [1] 34.78592
Interpretation:
The MAPE for close is 34.79% this means it is relatively accurate.
Adjusted Close
prediction_adj_close <- data.frame(predict(model_adj_close, newdata = new_data2))
colnames(prediction_adj_close) <- "Adj Close"
avgs_adj_close <- aggregate(x = SP500df$`Adj Close`, by = list(SP500df$Year), FUN = mean)
colnames(avgs_adj_close) <- c("Year", "Adj Close")
mean(abs((avgs_adj_close$`Adj Close` - prediction_adj_close$`Adj Close`)/avgs_adj_close$`Adj Close`)) * 100
## [1] 34.78592
Interpretation:
The MAPE for adjusted close is 34.79% this means it is relatively accurate.
Predicting 2023-2030
Creating a dataframe for 2023-2030
new_data <- data.frame(Year = c(2023:2030))
Open
Open_prediction_2023_to_2030 <- predict(model_open, newdata = new_data)
Open_prediction_2023_to_2030
## 1 2 3 4 5 6 7 8
## 2907.779 2988.785 3069.791 3150.797 3231.803 3312.809 3393.815 3474.821
High
High_prediction_2023_to_2030 <- predict(model_high, newdata = new_data)
High_prediction_2023_to_2030
## 1 2 3 4 5 6 7 8
## 3007.095 3090.871 3174.646 3258.422 3342.198 3425.974 3509.750 3593.526
Low
Low_prediction_2023_to_2030 <- predict(model_low, newdata = new_data)
Low_prediction_2023_to_2030
## 1 2 3 4 5 6 7 8
## 2801.766 2879.748 2957.729 3035.711 3113.693 3191.675 3269.656 3347.638
Close
Close_prediction_2023_to_2030 <- predict(model_close, newdata = new_data)
Close_prediction_2023_to_2030
## 1 2 3 4 5 6 7 8
## 2920.472 3001.775 3083.078 3164.381 3245.683 3326.986 3408.289 3489.591
Adjusted close
AdjClose_prediction_2023_to_2030 <- predict(model_adj_close, newdata = new_data)
AdjClose_prediction_2023_to_2030
## 1 2 3 4 5 6 7 8
## 2920.472 3001.775 3083.078 3164.381 3245.683 3326.986 3408.289 3489.591
Conclusion and Business Recommendations
We can see a major drop during the 2008 financial crisis and start of 2019 indicating that there has been a relative drop in the stock market
Despite having major highs and lows, this fund can be seen as a fairly safe investment because of relatively consistent growth across the years
The fund is subject to volatility, with periods of rapid growth and quick decline. This is generally caused by international events, economic status, etc. Thus long-term investments are ideal to ride out market cycles.
We can use the linear trend to make possible predictions for any natural disasters that may have an affect on the current stock trends.