R Notebook

library(fastDummies)
library(lubridate)
library(caret)
library(generics)

## Predicting "C", CSCO Adjusted Closing Prices

## Data from CSCO closing prices
cisco <- read.csv("CSCO.csv", header=TRUE)

## Format Date variable + Create Month Dummy
cisco$Date <- as.Date(cisco$Date, format = c('%m/%d/%Y'))
cisco$Month <- as.factor(month(cisco$Date))
cisco <- dummy_cols(cisco)

summary(cisco)

      Date                 Obs          Adj.Close         Volume              Month    
 Min.   :0020-03-16   Min.   :  1.0   Min.   :31.71   Min.   :  5720500   3      : 45  
 1st Qu.:0020-09-13   1st Qu.:126.8   1st Qu.:42.55   1st Qu.: 15471275   6      : 44  
 Median :0021-03-15   Median :252.5   Median :47.67   Median : 19027700   12     : 44  
 Mean   :0021-03-13   Mean   :252.5   Mean   :48.13   Mean   : 21539236   7      : 43  
 3rd Qu.:0021-09-13   3rd Qu.:378.2   3rd Qu.:54.76   3rd Qu.: 24357175   8      : 43  
 Max.   :0022-03-14   Max.   :504.0   Max.   :63.59   Max.   :106928300   10     : 43  
                                                                          (Other):242  
    Month_1           Month_2          Month_3           Month_4           Month_5       
 Min.   :0.00000   Min.   :0.0000   Min.   :0.00000   Min.   :0.00000   Min.   :0.00000  
 1st Qu.:0.00000   1st Qu.:0.0000   1st Qu.:0.00000   1st Qu.:0.00000   1st Qu.:0.00000  
 Median :0.00000   Median :0.0000   Median :0.00000   Median :0.00000   Median :0.00000  
 Mean   :0.07738   Mean   :0.0754   Mean   :0.08929   Mean   :0.08333   Mean   :0.07937  
 3rd Qu.:0.00000   3rd Qu.:0.0000   3rd Qu.:0.00000   3rd Qu.:0.00000   3rd Qu.:0.00000  
 Max.   :1.00000   Max.   :1.0000   Max.   :1.00000   Max.   :1.00000   Max.   :1.00000  
                                                                                         
    Month_6          Month_7           Month_8           Month_9           Month_10      
 Min.   :0.0000   Min.   :0.00000   Min.   :0.00000   Min.   :0.00000   Min.   :0.00000  
 1st Qu.:0.0000   1st Qu.:0.00000   1st Qu.:0.00000   1st Qu.:0.00000   1st Qu.:0.00000  
 Median :0.0000   Median :0.00000   Median :0.00000   Median :0.00000   Median :0.00000  
 Mean   :0.0873   Mean   :0.08532   Mean   :0.08532   Mean   :0.08333   Mean   :0.08532  
 3rd Qu.:0.0000   3rd Qu.:0.00000   3rd Qu.:0.00000   3rd Qu.:0.00000   3rd Qu.:0.00000  
 Max.   :1.0000   Max.   :1.00000   Max.   :1.00000   Max.   :1.00000   Max.   :1.00000  
                                                                                         
    Month_11          Month_12     
 Min.   :0.00000   Min.   :0.0000  
 1st Qu.:0.00000   1st Qu.:0.0000  
 Median :0.00000   Median :0.0000  
 Mean   :0.08135   Mean   :0.0873  
 3rd Qu.:0.00000   3rd Qu.:0.0000  
 Max.   :1.00000   Max.   :1.0000  
                                   

## First Regression Model
model <- lm(Adj.Close ~ Obs + Volume + Month_1 + Month_2 + Month_3 + Month_4 + Month_5 + Month_6 + Month_7 + Month_8 + Month_9 + Month_10 + Month_11, data= cisco[1:403,])

summary(model)

Call:
lm(formula = Adj.Close ~ Obs + Volume + Month_1 + Month_2 + Month_3 + 
    Month_4 + Month_5 + Month_6 + Month_7 + Month_8 + Month_9 + 
    Month_10 + Month_11, data = cisco[1:403, ])

Residuals:
    Min      1Q  Median      3Q     Max 
-5.0602 -1.3046 -0.1273  1.4521  5.5295 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)  3.404e+01  5.441e-01  62.554  < 2e-16 ***
Obs          4.868e-02  9.842e-04  49.457  < 2e-16 ***
Volume      -2.416e-08  1.153e-08  -2.095  0.03677 *  
Month_1     -4.060e-02  6.499e-01  -0.062  0.95023    
Month_2      4.656e-01  6.511e-01   0.715  0.47500    
Month_3      1.860e+00  5.825e-01   3.193  0.00152 ** 
Month_4      4.286e+00  5.460e-01   7.849 4.11e-14 ***
Month_5      4.819e+00  5.536e-01   8.706  < 2e-16 ***
Month_6      5.325e+00  5.418e-01   9.828  < 2e-16 ***
Month_7      4.960e+00  5.424e-01   9.146  < 2e-16 ***
Month_8      4.407e+00  5.448e-01   8.090 7.69e-15 ***
Month_9      1.422e+00  5.523e-01   2.574  0.01042 *  
Month_10    -1.728e+00  5.695e-01  -3.035  0.00257 ** 
Month_11    -3.077e+00  6.473e-01  -4.754 2.82e-06 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 2.068 on 389 degrees of freedom
Multiple R-squared:  0.9015,    Adjusted R-squared:  0.8982 
F-statistic: 273.8 on 13 and 389 DF,  p-value: < 2.2e-16

# Prediction using 80% for train, 20% for test
pred.train <- predict(model, cisco[1:403,], interval = 'prediction')

pred.test <- predict(model, cisco[404:504,], level = 0.95, interval = 'prediction')

pred <- as.data.frame(pred.test)

pred$Actual <- cisco$Adj.Close[404:504]

pred2 <- as.data.frame(pred.train)

pred2$Actual <- cisco$Adj.Close[1:403]

final.pred <- rbind(pred2, pred)

# Visualizing Prediction against Actual Closing Prices 

plot(cisco$Obs, cisco$Adj.Close, col= 'red', type = 'l', xlab= "Days", ylab= 'Adjusted Closing Price', main= "CSCO, Forecast vs. Actual: Model 1")
lines(cisco$Obs, final.pred$fit, col= 'green', lty=2)

lines(cisco$Obs, final.pred$lwr, lty=2,  col= 'gray')
lines(cisco$Obs, final.pred$upr, lty=2, col='gray')

## Same process for Model 2 (without Volume)
model2 <- lm(Adj.Close ~ Obs + Month_1 + Month_2 + Month_3 + Month_4 + Month_5 + Month_6 + Month_7 + Month_8 + Month_9 + Month_10 + Month_11, data= cisco[1:403,])

pred.train2 <- predict(model2, cisco[1:403,], interval = 'prediction')

pred.test2 <- predict(model2, cisco[404:504,], level = 0.95, interval = 'prediction')

pred3 <- as.data.frame(pred.test2)

pred3$Actual <- cisco$Adj.Close[404:504]

pred4 <- as.data.frame(pred.train2)

pred4$Actual <- cisco$Adj.Close[1:403]

final.pred2 <- rbind(pred4, pred3)

plot(cisco$Obs, cisco$Adj.Close, col= 'red', type = 'l', xlab= "Days", ylab= 'Adjusted Closing Price', main= "CSCO, Forecast vs. Actual: Model 2")
lines(cisco$Obs, final.pred2$fit, col= 'green', lty=2)

lines(cisco$Obs, final.pred2$lwr, lty=2,  col= 'gray')
lines(cisco$Obs, final.pred2$upr, lty=2, col='gray')

## Testing the accuracy of both models
mod1 <- train(Adj.Close ~ Obs + Volume + Month_1 + Month_2 + Month_3 + Month_4 + Month_5 + Month_6 + Month_7 + Month_8 + Month_9 + Month_10 + Month_11, data= cisco[1:403,], method = "lm")
mod2 <- train(Adj.Close ~ Obs + Month_1 + Month_2 + Month_3 + Month_4 + Month_5 + Month_6 + Month_7 + Month_8 + Month_9 + Month_10 + Month_11, data= cisco[1:403,], method = "lm")

list <- list(mod1 = mod1, mod2 = mod2)
accuracy <- resamples(list)
summary(accuracy)

Call:
summary.resamples(object = accuracy)

Models: mod1, mod2 
Number of resamples: 25 

MAE 
         Min.  1st Qu.   Median     Mean  3rd Qu.     Max. NA's
mod1 1.605485 1.680337 1.726161 1.729170 1.778863 1.891144    0
mod2 1.581941 1.667239 1.727389 1.724524 1.778190 1.871096    0

RMSE 
         Min.  1st Qu.   Median     Mean  3rd Qu.     Max. NA's
mod1 1.964998 2.060981 2.112976 2.146359 2.216938 2.379242    0
mod2 1.975027 2.112218 2.153536 2.157368 2.211069 2.329747    0

Rsquared 
          Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
mod1 0.8641401 0.8876401 0.8959600 0.8914946 0.9004141 0.9110341    0
mod2 0.8766728 0.8876267 0.8926772 0.8919774 0.8962724 0.9050617    0

## Using Model 1 to Predict next Month (Last 30 days)

final.pred$Date <- cisco$Date
final.pred[475:504,]

NA