---
title: "Code for Session 3"
author: "Dr. Richard M. Crowley"
date: ""
output:
  html_notebook
---
 
Note that the directories used to store data are likely different on your computer, and such references will need to be changed before using any such code.

```{r helpers, warning=FALSE, message=F}
library(knitr)
library(kableExtra)
html_df <- function(text, cols=NULL, col1=FALSE, full=F) {
  if(!length(cols)) {
    cols=colnames(text)
  }
  if(!col1) {
    kable(text,"html", col.names = cols, align = c("l",rep('c',length(cols)-1))) %>%
      kable_styling(bootstrap_options = c("striped","hover"), full_width=full)
  } else {
    kable(text,"html", col.names = cols, align = c("l",rep('c',length(cols)-1))) %>%
      kable_styling(bootstrap_options = c("striped","hover"), full_width=full) %>%
      column_spec(1,bold=T)
  }
}
```

```{r}
library(tidyverse)
df <- read.csv("../../Data/Session_3-1.csv", stringsAsFactors=FALSE)
wmt <- filter(df, tic == "WMT")

# load in relevant data from Session 2
load("../../Data/Session_2_export.RData")
```

```{r, message=F, warning=F}
expectations <- read_csv("../../Data/general-business-expectations-by-detailed-services-industry-quarterly.csv") %>%
  mutate(year = as.numeric(substr(quarter, 1, 4))) %>%    # split out year
  mutate(quarter = as.numeric(substr(quarter, 7, 7))) %>% # split out quarter
  mutate(value = as.numeric(value))                       # Ensue value is numeric
```

```{r}
# extract out Q1, finance only
expectations_avg <- expectations %>%
  filter(quarter == 1,                               # Keep only the first quarter
         level_2 == "Financial & Insurance") %>%     # Keep only financial responses
  group_by(year) %>%                                 # Group data by year
  mutate(fin_sentiment=mean(value, na.rm=TRUE)) %>%  # Calculate average
  slice(1) %>%                                       # Take only 1 row per group
  ungroup()
```

```{r}
library(DT)
```

```{r, warning=F}
expectations %>%
  arrange(level_2, level_3, desc(year)) %>%  # sort the data
  select(year, quarter, level_2, level_3, value) %>%  # keep only these variables
  datatable(options = list(pageLength = 5), rownames=FALSE)  # display using DT
```

```{r}
# subset out our Singaporean data, since our macro data is Singapore-specific
df_SG <- df_clean %>% filter(fic == "SGP")

# Create year in df_SG (date is given by datadate as YYYYMMDD)
df_SG$year = round(df_SG$datadate / 10000, digits=0)

# Combine datasets
# Notice how it automatically figures out to join by "year"
df_SG_macro <- left_join(df_SG, expectations_avg[,c("year","fin_sentiment")])
```

```{r}
macro1 <- lm(revt_lead ~ revt + act + che + lct + dp + ebit + fin_sentiment,
             data=df_SG_macro)
library(broom)
tidy(macro1)
```

```{r, warning=F, fig.height=4}
df_SG_macro %>%
  ggplot(aes(y=revt_lead,
             x=fin_sentiment)) + 
  geom_point()
```

```{r, warning=F, fig.height=4}
df_SG_macro %>%
  ggplot(aes(y=revt_lead,
    x=scale(fin_sentiment) * revt)) + 
  geom_point()
```

```{r}
# Scale creates z-scores, but returns a matrix by default.  [,1] gives a vector
df_SG_macro$fin_sent_scaled <- scale(df_SG_macro$fin_sentiment)[,1]
macro3 <-
  lm(revt_lead ~ revt + act + che + lct + dp + ebit + fin_sent_scaled:revt,
     data=df_SG_macro)
tidy(macro3)
glance(macro3)
```

```{r}
baseline <-
  lm(revt_lead ~ revt + act + che + lct + dp + ebit,
     data=df_SG_macro[!is.na(df_SG_macro$fin_sentiment),])
glance(baseline)
glance(macro3)
```

```{r}
anova(baseline, macro3, test="Chisq")
```

```{r}
revenue_mean = mean(df_SG_macro$revt, na.rm=T)
r_sd <- round(sd(df_SG_macro$fin_sentiment, na.rm=T),1)
r_min <- min(df_SG_macro$fin_sentiment, na.rm=T)
r_max <- max(df_SG_macro$fin_sentiment, na.rm=T)
rev <- macro3$coefficients[["revt:fin_sent_scaled"]]
r_rev = round(100 *rev * r_sd / revenue_mean,1)
rev_min <- round((r_min * rev / revenue_mean)*100,1)
rev_max <- round((r_max * rev / revenue_mean)*100,1)
```

```{r}
p_uol <- predict(forecast2, uol[uol$fyear==2017,])
p_base <- predict(baseline,
  df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear==2017,])
p_macro <- predict(macro3,
  df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear==2017,])
p_world <- predict(forecast4,
  df_clean[df_clean$isin=="SG1S83002349" & df_clean$fyear==2017,])
preds <- c(p_uol, p_base, p_macro, p_world)
names(preds) <- c("UOL 2018 UOL", "UOL 2018 Base", "UOL 2018 Macro",
                  "UOL 2018 World")
preds
```

```{r, fig.height=6, warning=F, message=F}
library(plotly)
df_SG_macro$pred_base <- predict(baseline, df_SG_macro)
df_SG_macro$pred_macro <- predict(macro3, df_SG_macro)
df_clean$pred_world <- predict(forecast4, df_clean)
uol$pred_uol <- predict(forecast2, uol)
df_preds <- data.frame(preds=preds, fyear=c(2018,2018,2018,2018), model=c("UOL only", "Base", "Macro", "World"))
plot <- ggplot() + 
  geom_point(data=df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear < 2017,], aes(y=revt_lead,x=fyear, color="Actual")) +
  geom_line(data=df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear < 2017,], aes(y=revt_lead,x=fyear, color="Actual")) + 
  geom_point(data=uol[uol$fyear < 2017,], aes(y=pred_uol,x=fyear, color="UOL only")) +
  geom_line(data=uol[uol$fyear < 2017,], aes(y=pred_uol,x=fyear, color="UOL only")) +
  geom_point(data=df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear < 2017,], aes(y=pred_base,x=fyear, color="Base")) +
  geom_line(data=df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear < 2017,], aes(y=pred_base,x=fyear, color="Base")) +
  geom_point(data=df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear < 2017,], aes(y=pred_macro,x=fyear, color="Macro")) +
  geom_line(data=df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear < 2017,], aes(y=pred_macro,x=fyear, color="Macro")) + 
  geom_point(data=df_clean[df_clean$isin=="SG1S83002349" & df_clean$fyear < 2017,], aes(y=pred_world,x=fyear, color="World")) +
  geom_line(data=df_clean[df_clean$isin=="SG1S83002349" & df_clean$fyear < 2017,], aes(y=pred_world,x=fyear, color="World")) + 
  geom_point(data=df_preds, aes(y=preds, x=fyear, color=model), size=1.5, shape=18)
ggplotly(plot)
```

```{r}
actual_series <- df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear < 2017,]$revt_lead
uol_series <- uol[uol$fyear < 2017,]$pred_uol
base_series <- df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear < 2017,]$pred_base
macro_series <- df_SG_macro[df_SG_macro$isin=="SG1S83002349" & df_SG_macro$fyear < 2017,]$pred_macro
world_series <- df_clean[df_clean$isin=="SG1S83002349" & df_clean$fyear < 2017,]$pred_world
```

```{r}
# series vectors calculated here -- See appendix
rmse <- function(v1, v2) {
  sqrt(mean((v1 - v2)^2, na.rm=T))
}

rmse <- c(rmse(actual_series, uol_series), rmse(actual_series, base_series),
          rmse(actual_series, macro_series), rmse(actual_series, world_series))
names(rmse) <- c("UOL 2018 UOL", "UOL 2018 Base", "UOL 2018 Macro", "UOL 2018 World")
rmse
```

```{r}
preds
```

```{r, message=F, warning=F}
library(tidyverse)  # As always
library(plotly)  # interactive graphs
library(lubridate)  # import some sensible date functions

# Generate quarter over quarter growth "revtq_gr"
df <- df %>% group_by(gvkey) %>% mutate(revtq_gr=revtq / lag(revtq) - 1) %>% ungroup()

# Generate year-over-year growth "revtq_yoy"
df <- df %>% group_by(gvkey) %>% mutate(revtq_yoy=revtq / lag(revtq, 4) - 1) %>% ungroup()

# Generate first difference "revtq_d"
df <- df %>% group_by(gvkey) %>% mutate(revtq_d=revtq - lag(revtq)) %>% ungroup()

# Generate a proper date
# Date was YYMMDDs10: YYYY/MM/DD, can be converted from text to date easily
df$date <- ymd(df$datadate)  # From lubridate
df$qtr <- quarter(df$date)   # From lubridate
```

```{r}
html_df(head(df[,c("conm","date","revtq","revtq_gr", "revtq_yoy", "revtq_d")]))

head(df[,c("conm","date", "datadate")])
```

```{r}
# Make a copy of our data frame to compare later
df_purrr <- df
```

```{r, message=F}
# Approach #1: Advanced programming using quosures...
library(rlang)
multi_lag <- function(df, lags, var, postfix="") {
  var <- enquo(var)
  quosures <- map(lags, ~quo(lag(!!var, !!.x))) %>%
    set_names(paste0(quo_text(var), postfix, lags))
  return(ungroup(mutate(group_by(df, gvkey), !!!quosures)))
}
```

```{r, message=F}
# Approach #2: Mixing purrr with dplyr across()
library(purrr)
multi_lag_purrr <- function(df, lags, var, postfix="") {
  new_columns <- 
    map_dfc(lags, 
      function(x) df %>% 
        group_by(gvkey) %>%
        transmute(across(all_of(var),
                         .fns = list(~ lag(., x)),
                         .names = paste0('{col}', postfix, x) ) ) %>%
        ungroup() %>%
        select(-gvkey))
  cbind(df, new_columns)
}
```

```{r}
df <- multi_lag(df, 1:8, revtq, "_l")  # Generate lags "revtq_l#"
df <- multi_lag(df, 1:8, revtq_gr)     # Generate changes "revtq_gr#"
df <- multi_lag(df, 1:8, revtq_yoy)    # Generate year-over-year changes "revtq_yoy#"
df <- multi_lag(df, 1:8, revtq_d)      # Generate first differences "revtq_d#"
```

```{r}
df_purrr <- multi_lag_purrr(df_purrr, 1:8, 'revtq', "_l")  # Generate lags "revtq_l#"
df_purrr <- multi_lag_purrr(df_purrr, 1:8, 'revtq_gr')     # Generate changes "revtq_gr#"
df_purrr <- multi_lag_purrr(df_purrr, 1:8, 'revtq_yoy')    # Generate year-over-year changes "revtq_yoy#"
df_purrr <- multi_lag_purrr(df_purrr, 1:8, 'revtq_d')      # Generate first differences "revtq_d#"
```

```{r}
all(df==df_purrr, na.rm=T)
```

```{r}
html_df(head(df[,c("conm","date","revtq","revtq_l1", "revtq_l2", "revtq_l3", "revtq_l4")]))
```

```{r}
# Clean the data: Replace NaN, Inf, and -Inf with NA
df <- df %>%
  mutate(across(where(is.numeric), ~replace(., !is.finite(.), NA)))

# Split into training and testing data
# Training data: We'll use data released before 2015
train <- filter(df, year(date) < 2015)

# Testing data: We'll use data released 2015 through 2018
test <- filter(df, year(date) >= 2015)
```

```{r, message=F, warning=F}
summary(df[,c("revtq","revtq_gr","revtq_yoy", "revtq_d","qtr")])
```

```{r}
# These functions are a bit ugly, but can construct many charts quickly
# eval(parse(text=var)) is just a way to convert the string name to a variable reference
# Density plot for 1st to 99th percentile of data
plt_dist <- function(df,var) {
  df %>%
    filter(eval(parse(text=var)) < quantile(eval(parse(text=var)),0.99, na.rm=TRUE),
           eval(parse(text=var)) > quantile(eval(parse(text=var)),0.01, na.rm=TRUE)) %>%
    ggplot(aes(x=eval(parse(text=var)))) + 
    geom_density() + xlab(var)
}
```

```{r}
# Density plot for 1st to 99th percentile of both columns
plt_bar <- function(df,var) {
  df %>%
    filter(eval(parse(text=var)) < quantile(eval(parse(text=var)),0.99, na.rm=TRUE),
           eval(parse(text=var)) > quantile(eval(parse(text=var)),0.01, na.rm=TRUE)) %>%
    ggplot(aes(y=eval(parse(text=var)), x=qtr)) + 
    geom_bar(stat = "summary", fun.y = "mean") + xlab(var)
}
```

```{r}
# Scatter plot with lag for 1st to 99th percentile of data
plt_sct <- function(df,var1, var2) {
  df %>%
    filter(eval(parse(text=var1)) < quantile(eval(parse(text=var1)),0.99, na.rm=TRUE),
           eval(parse(text=var2)) < quantile(eval(parse(text=var2)),0.99, na.rm=TRUE),
           eval(parse(text=var1)) > quantile(eval(parse(text=var1)),0.01, na.rm=TRUE),
           eval(parse(text=var2)) > quantile(eval(parse(text=var2)),0.01, na.rm=TRUE)) %>%
    ggplot(aes(y=eval(parse(text=var1)), x=eval(parse(text=var2)), color=factor(qtr))) + 
    geom_point() + geom_smooth(method = "lm") + ylab(var1) + xlab(var2)
}
```

```{r, message=F, warning=F, fig.height=3}
plt_dist(train, "revtq")
```

```{r, message=F, warning=F, fig.height=3}
plt_dist(train, "revtq_gr")
```

```{r, message=F, warning=F, fig.height=3}
plt_dist(train, "revtq_yoy")
```

```{r, message=F, warning=F, fig.height=3}
plt_dist(train, "revtq_d")
```

```{r, message=F, warning=F, fig.height=3}
plt_bar(train, "revtq")
```

```{r, message=F, warning=F, fig.height=3}
plt_bar(train, "revtq_gr")
```

```{r, message=F, warning=F, fig.height=3}
plt_bar(train, "revtq_yoy")
```

```{r, message=F, warning=F, fig.height=3}
plt_bar(train, "revtq_d")
```

```{r, message=F, warning=F, fig.height=3}
plt_sct(train, "revtq", "revtq_l1")
```

```{r, message=F, warning=F, fig.height=3}
plt_sct(train, "revtq_gr", "revtq_gr1")
```

```{r, message=F, warning=F, fig.height=3}
plt_sct(train, "revtq_yoy", "revtq_yoy1")
```

```{r, message=F, warning=F, fig.height=3}
plt_sct(train, "revtq_d", "revtq_d1")
```

```{r}
cor(train[,c("revtq","revtq_l1","revtq_l2","revtq_l3", "revtq_l4")],
    use="complete.obs")
```

```{r}
cor(train[,c("revtq_gr","revtq_gr1","revtq_gr2","revtq_gr3", "revtq_gr4")],
    use="complete.obs")
```

```{r}
cor(train[,c("revtq_yoy","revtq_yoy1","revtq_yoy2","revtq_yoy3", "revtq_yoy4")],
    use="complete.obs")
```

```{r}
cor(train[,c("revtq_d","revtq_d1","revtq_d2","revtq_d3", "revtq_d4")],
    use="complete.obs")
```

```{r}
mod1 <- lm(revtq ~ revtq_l1, data=train)
```

```{r}
mod2 <- lm(revtq ~ revtq_l1 + revtq_l4, data=train)
```

```{r}
mod3 <- lm(revtq ~ revtq_l1 + revtq_l2 + revtq_l3 + revtq_l4 + revtq_l5 +
           revtq_l6 + revtq_l7 + revtq_l8, data=train)
```

```{r}
mod4 <- lm(revtq ~ (revtq_l1 + revtq_l2 + revtq_l3 + revtq_l4 + revtq_l5 +
                    revtq_l6 + revtq_l7 + revtq_l8):factor(qtr), data=train)
```

```{r}
summary(mod1)
```

```{r}
summary(mod2)
```

```{r}
summary(mod3)
```

```{r}
summary(mod4)
```

```{r}
rmse <- function(v1, v2) {
  sqrt(mean((v1 - v2)^2, na.rm=T))
}
```

```{r}
mae <- function(v1, v2) {
  mean(abs(v1-v2), na.rm=T)
}
```

```{r, warning=F, message=F}
models <- list(mod1,mod2,mod3,mod4)
model_names <- c("1 period", "1 and 4 periods", "8 periods", "8 periods w/ quarters")

df_test <- data.frame(adj_r_sq=sapply(models, function(x)summary(x)[["adj.r.squared"]]),
                      rmse_in=sapply(models, function(x)rmse(train$revtq, predict(x,train))),
                      mae_in=sapply(models, function(x)mae(train$revtq, predict(x,train))),
                      rmse_out=sapply(models, function(x)rmse(test$revtq, predict(x,test))),
                      mae_out=sapply(models, function(x)mae(test$revtq, predict(x,test))))
rownames(df_test) <- model_names
html_df(df_test)  # Custom function using knitr and kableExtra
```

```{r, warning=F, fig.height=4.5}
test %>%
  ggplot(aes(y=revtq,x=predict(mod1,test), color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue") + 
  xlab("Prediction: 1 period model")
```

```{r, warning=F, fig.height=4.5}
test %>%
  ggplot(aes(y=revtq,x=predict(mod4,test), color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue") + 
  xlab("Prediction: 8 period X quarter model")
```

```{r, warning=F, message=F}
# models
mod1g <- lm(revtq_gr ~ revtq_gr1, data=train)
mod2g <- lm(revtq_gr ~ revtq_gr1 + revtq_gr4, data=train)
mod3g <- lm(revtq_gr ~ revtq_gr1 + revtq_gr2 + revtq_gr3 + revtq_gr4 + revtq_gr5 + revtq_gr6 + revtq_gr7 + revtq_gr8, data=train)
mod4g <- lm(revtq_gr ~ (revtq_gr1 + revtq_gr2 + revtq_gr3 + revtq_gr4 + revtq_gr5 + revtq_gr6 + revtq_gr7 + revtq_gr8):factor(qtr), data=train)

models <- list(mod1g, mod2g, mod3g, mod4g)
model_names <- c("1 period", "1 and 4 periods", "8 periods", "8 periods w/ quarters")

df_test <- data.frame(adj_r_sq=sapply(models, function(x)summary(x)[["adj.r.squared"]]),
                      rmse_in=sapply(models, function(x)rmse(train$revtq, (1+predict(x,train))*train$revtq_l1)),
                      mae_in=sapply(models, function(x)mae(train$revtq, (1+predict(x,train))*train$revtq_l1)),
                      rmse_out=sapply(models, function(x)rmse(test$revtq, (1+predict(x,test))*test$revtq_l1)),
                      mae_out=sapply(models, function(x)mae(test$revtq, (1+predict(x,test))*test$revtq_l1)))
rownames(df_test) <- model_names
html_df(df_test)
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq,x=(1+predict(mod1g,test))*test$revtq_l1, color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue") + 
  xlab("Prediction: 1 period model")
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq,x=(1+predict(mod4g,test))*test$revtq_l1, color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue") + 
  xlab("Prediction: 8 period X quarter model")
```

```{r, warning=F, message=F}
# models
mod1y <- lm(revtq_yoy ~ revtq_yoy1, data=train)
mod2y <- lm(revtq_yoy ~ revtq_yoy1 + revtq_yoy4, data=train)
mod3y <- lm(revtq_yoy ~ revtq_yoy1 + revtq_yoy2 + revtq_yoy3 + revtq_yoy4 + revtq_yoy5 + revtq_yoy6 + revtq_yoy7 + revtq_yoy8, data=train)
mod4y <- lm(revtq_gr ~ (revtq_yoy1 + revtq_yoy2 + revtq_yoy3 + revtq_yoy4 + revtq_yoy5 + revtq_yoy6 + revtq_yoy7 + revtq_yoy8):factor(qtr), data=train)

models <- list(mod1y, mod2y, mod3y, mod4y)
model_names <- c("1 period", "1 and 4 periods", "8 periods", "8 periods w/ quarters")

df_test <- data.frame(adj_r_sq=sapply(models, function(x)summary(x)[["adj.r.squared"]]),
                      rmse_in=sapply(models, function(x)rmse(train$revtq, (1+predict(x,train))*train$revtq_l4)),
                      mae_in=sapply(models, function(x)mae(train$revtq, (1+predict(x,train))*train$revtq_l4)),
                      rmse_out=sapply(models, function(x)rmse(test$revtq, (1+predict(x,test))*test$revtq_l4)),
                      mae_out=sapply(models, function(x)mae(test$revtq, (1+predict(x,test))*test$revtq_l4)))
rownames(df_test) <- model_names
html_df(df_test)
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq,x=(1+predict(mod1y,test))*test$revtq_l4, color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue") + 
  xlab("Prediction: 1 period model")
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq,x=(1+predict(mod3y,test))*test$revtq_l4, color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue") + 
  xlab("Prediction: 8 period model")
```

```{r, warning=F, message=F}
# models
mod1d <- lm(revtq_d ~ revtq_d1, data=train)
mod2d <- lm(revtq_d ~ revtq_d1 + revtq_d4, data=train)
mod3d <- lm(revtq_d ~ revtq_d1 + revtq_d2 + revtq_d3 + revtq_d4 + revtq_d5 + revtq_d6 + revtq_d7 + revtq_d8, data=train)
mod4d <- lm(revtq_d ~ (revtq_d1 + revtq_d2 + revtq_d3 + revtq_d4 + revtq_d5 + revtq_d6 + revtq_d7 + revtq_d8):factor(qtr), data=train)

models <- list(mod1d, mod2d, mod3d, mod4d)
model_names <- c("1 period", "1 and 4 periods", "8 periods", "8 periods w/ quarters")

df_test <- data.frame(adj_r_sq=sapply(models, function(x)summary(x)[["adj.r.squared"]]),
                      rmse_in=sapply(models, function(x)rmse(train$revtq, predict(x,train)+train$revtq_l1)),
                      mae_in=sapply(models, function(x)mae(train$revtq, predict(x,train)+train$revtq_l1)),
                      rmse_out=sapply(models, function(x)rmse(test$revtq, predict(x,test)+test$revtq_l1)),
                      mae_out=sapply(models, function(x)mae(test$revtq, predict(x,test)+test$revtq_l1)))
rownames(df_test) <- model_names
html_df(df_test)
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq,x=predict(mod1d,test)+test$revtq_l1, color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue") + 
  xlab("Prediction: 1 period model")
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq,x=predict(mod4d,test)+test$revtq_l1, color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue") + 
  xlab("Prediction: 8 period X quarter model")
```

```{r, warning=F, message=F}
# models
mod1g <- lm(revtq_gr ~ revtq_gr1, data=train)
mod2g <- lm(revtq_gr ~ revtq_gr1 + revtq_gr4, data=train)
mod3g <- lm(revtq_gr ~ revtq_gr1 + revtq_gr2 + revtq_gr3 + revtq_gr4 + revtq_gr5 + revtq_gr6 + revtq_gr7 + revtq_gr8, data=train)
mod4g <- lm(revtq_gr ~ (revtq_gr1 + revtq_gr2 + revtq_gr3 + revtq_gr4 + revtq_gr5 + revtq_gr6 + revtq_gr7 + revtq_gr8):factor(qtr), data=train)

models <- list(mod1g, mod2g, mod3g, mod4g)
model_names <- c("1 period", "1 and 4 periods", "8 periods", "8 periods w/ quarters")

df_test <- data.frame(adj_r_sq=sapply(models, function(x)summary(x)[["adj.r.squared"]]),
                      rmse_in=sapply(models, function(x)rmse(train$revtq_gr, predict(x,train))),
                      mae_in=sapply(models, function(x)mae(train$revtq_gr, predict(x,train))),
                      rmse_out=sapply(models, function(x)rmse(test$revtq_gr, predict(x,test))),
                      mae_out=sapply(models, function(x)mae(test$revtq_gr, predict(x,test))))
rownames(df_test) <- model_names
html_df(df_test)
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq_gr,x=predict(mod1g,test), color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue growth") + 
  xlab("Prediction: 1 period model")
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq_gr,x=predict(mod4g,test), color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue growth") + 
  xlab("Prediction: 8 period X quarter model")
```

```{r, warning=F, message=F}
# models
mod1y <- lm(revtq_yoy ~ revtq_yoy1, data=train)
mod2y <- lm(revtq_yoy ~ revtq_yoy1 + revtq_yoy4, data=train)
mod3y <- lm(revtq_yoy ~ revtq_yoy1 + revtq_yoy2 + revtq_yoy3 + revtq_yoy4 + revtq_yoy5 + revtq_yoy6 + revtq_yoy7 + revtq_yoy8, data=train)
mod4y <- lm(revtq_gr ~ (revtq_yoy1 + revtq_yoy2 + revtq_yoy3 + revtq_yoy4 + revtq_yoy5 + revtq_yoy6 + revtq_yoy7 + revtq_yoy8):factor(qtr), data=train)

models <- list(mod1y, mod2y, mod3y, mod4y)
model_names <- c("1 period", "1 and 4 periods", "8 periods", "8 periods w/ quarters")

df_test <- data.frame(adj_r_sq=sapply(models, function(x)summary(x)[["adj.r.squared"]]),
                      rmse_in=sapply(models, function(x)rmse(train$revtq_yoy, predict(x,train))),
                      mae_in=sapply(models, function(x)mae(train$revtq_yoy, predict(x,train))),
                      rmse_out=sapply(models, function(x)rmse(test$revtq_yoy, predict(x,test))),
                      mae_out=sapply(models, function(x)mae(test$revtq_yoy, predict(x,test))))
rownames(df_test) <- model_names
html_df(df_test)
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq_yoy,x=predict(mod1y,test), color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual year over year revenue growth") + 
  xlab("Prediction: 1 period model")
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq_yoy,x=predict(mod3y,test), color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual year over year revenue growth") + 
  xlab("Prediction: 8 period model")
```

```{r, warning=F, message=F}
# models
mod1d <- lm(revtq_d ~ revtq_d1, data=train)
mod2d <- lm(revtq_d ~ revtq_d1 + revtq_d4, data=train)
mod3d <- lm(revtq_d ~ revtq_d1 + revtq_d2 + revtq_d3 + revtq_d4 + revtq_d5 + revtq_d6 + revtq_d7 + revtq_d8, data=train)
mod4d <- lm(revtq_d ~ (revtq_d1 + revtq_d2 + revtq_d3 + revtq_d4 + revtq_d5 + revtq_d6 + revtq_d7 + revtq_d8):factor(qtr), data=train)

models <- list(mod1d, mod2d, mod3d, mod4d)
model_names <- c("1 period", "1 and 4 periods", "8 periods", "8 periods w/ quarters")

df_test <- data.frame(adj_r_sq=sapply(models, function(x)summary(x)[["adj.r.squared"]]),
                      rmse_in=sapply(models, function(x)rmse(train$revtq_d, predict(x,train))),
                      mae_in=sapply(models, function(x)mae(train$revtq_d, predict(x,train))),
                      rmse_out=sapply(models, function(x)rmse(test$revtq_d, predict(x,test))),
                      mae_out=sapply(models, function(x)mae(test$revtq_d, predict(x,test))))
rownames(df_test) <- model_names
html_df(df_test)
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq_d,x=predict(mod1d,test), color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue first difference") + 
  xlab("Prediction: 1 period model")
```

```{r, warning=F, fig.height=5}
test %>%
  ggplot(aes(y=revtq_d,x=predict(mod4d,test), color=factor(qtr))) +
  geom_abline(slope=1) + geom_point() +
  ylab("Actual revenue first difference") + 
  xlab("Prediction: 8 period X quarter model")
```

