---
title:
output:
  revealjs::revealjs_presentation:
    theme: white
    css: white-edits.css
    highlight: tango
    transition: slide
    self_contained: false
    reveal_plugins: ["chalkboard","search"]
    transitionSpead: fast
    mathjax: "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.1/MathJax.js?config=TeX-AMS_SVG"
    reveal_options:
      width: 1024
      height: 768
      minScale: 1.0
      maxScale: 1.0
      slideNumber: true
      controlsTutorial: true
      chalkboard:
        theme: whiteboard
        readOnly: false
---

## ACCT 420: Advanced linear regression {data-background="../Backgrounds/title.jpg" class="header no-toc-progress" data-state="no-toc-progress"}

<!-- "reveal_plugins:..." and "chalkboard:" are handled by prep.py -->
```{r helpers, echo=FALSE, warning=FALSE}
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)
  }
}
```


<h3 class="date"><br>Session 3</h3>
<h2 class="author"><br>Dr. Richard M. Crowley</h2>

<!-- Load in primary data set -->
```{r, include=FALSE}
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")
```

# Front matter {data-background="../Backgrounds/section.jpg" class="header"}

## Learning objectives {data-background="../Backgrounds/default.jpg" class="default"}

<div class="clearfix">
<div class="left">
<img src="../Course_Diagrams/Map-4.png">
</div>
<div class="right objectives">
- <b>Theory:</b>
    - Further understand stats treatments
        - Panel data
        - Time (seasonality)
- <b>Application:</b>
    - Using international data for our UOL problem
    - Predicting revenue quarterly and weekly
- <b>Methodology:</b>
    - Univariate
    - Linear regression (OLS)
    - Visualization
</div>
<div class="clearfix">

## Datacamp {data-background="../Backgrounds/default.jpg" class="default"}

> - Explore on your own
> - No specific required class this week

# Revisiting UOL with macro data {data-background="../Backgrounds/section.jpg" class="header"}

## Macro data sources {data-background="../Backgrounds/default.jpg" class="default"}

- For Singapore: <a href="https://data.gov.sg">Data.gov.sg</a>
    - Covers: Economy, education, environment, finance, health, infrastructure, society, technology, transport
- For real estate in Singapore: URA's REALIS system
    - Access through the library
- WRDS has some as well
- For US: <a href="https://data.gov">data.gov</a>, as well as many agency websites
    - Like <a href="https://www.bls.gov/data/">BLS</a> or the <a href="https://fred.stlouisfed.org/">Federal Reserve</a>

<img src="../Figures/WRDS.png" height="50px"> <img src="../Figures/dataSG.svg" height="50px"> <img src="../Figures/dataUS.png" height="50px">

## Loading macro data {data-background="../Backgrounds/default.jpg" class="default"}

- Singapore business expectations data (from <a href="https://data.gov.sg/dataset/business-expectations-for-the-services-sector?view_id=b412d801-9097-4e62-acae-899b9db28ca8&resource_id=4779dc47-673a-42a3-896f-7bfc90315c09">data.gov.sg</a>)

```{r, echo=F, 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
```

- At this point, we can merge with our accounting data

## What was in the macro data? {data-background="../Backgrounds/default.jpg" class="default"}

```{r, include=F}
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
```

## dplyr makes merging easy {data-background="../Backgrounds/reference.jpg" class="default"}

- For merging, use `package:dplyr`'s `*_join()` commands
    - `left_join()` for merging a dataset into another
    - `inner_join()` for keeping only matched observations
    - `outer_join()` for making all possible combinations
- For sorting, `package:dplyr`'s `arrange()` command is easy to use
    - For sorting in reverse, combine `arrange()` with `desc()`

## Merging example {data-background="../Backgrounds/default.jpg" class="default"}

> Merge in the finance sentiment data to our accounting data

```{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")])
```

# Predicting with macro data {data-background="../Backgrounds/section.jpg" class="header"}

## Building in macro data {data-background="../Backgrounds/case.jpg" class="default"}

- First try: Just add it in

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

> It isn't significant.  Why is this?

## Scaling matters {data-background="../Backgrounds/default.jpg" class="default"}

- All of our firm data is on the same terms as revenue: dollars within a given firm
- But `fin_sentiment` is a constant scale...
    - Need to scale this to fit the problem
         - The current scale would work for revenue growth

<div class="clearfix">
<div class="left">
```{r, warning=F, fig.height=4}
df_SG_macro %>%
  ggplot(aes(y=revt_lead,
             x=fin_sentiment)) + 
  geom_point()
```
</div>
<div class="right">
```{r, warning=F, fig.height=4}
df_SG_macro %>%
  ggplot(aes(y=revt_lead,
    x=scale(fin_sentiment) * revt)) + 
  geom_point()
```
</div>
</div>

## Scaled macro data {data-background="../Backgrounds/case.jpg" class="default"}

- Normalize and scale by revenue

```{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)
```

## Model comparisons {data-background="../Backgrounds/case.jpg" class="default"}

```{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)
```

> Adjusted $R^2$ and AIC are slightly better with macro data

## Model comparisons {data-background="../Backgrounds/case.jpg" class="default"}

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

> Macro model definitely fits better than the baseline model!

## Takeaway {data-background="../Backgrounds/reference.jpg" class="default"}

```{r, include=F, echo=F}
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)
```

1. Adding macro data can help explain some exogenous variation in a model
    - Exogenous meaning outside of the firms, in this case
2. Scaling is very important
    - Not scaling properly can suppress some effects from being visible

<div class="fragment">
> Interpretating the macro variable

- For every 1 S.D. increase in `fin_sentiment` (`r r_sd` points)
    - Revenue stickiness increases by ~`r r_rev`%
- Over the range of data (`r r_min` to `r r_max`)... 
    - Revenue stickiness ranges from `r rev_min`% to `r rev_max`%

## Scaling up our model, again {data-background="../Backgrounds/group.jpg" class="default"}

> Building a model requires careful thought!

- What macroeconomic data makes sense to add to our model?

> This is where having accounting and business knowledge comes in!

# Validation: Is it better? {data-background="../Backgrounds/section.jpg" class="header"}

## Validation {data-background="../Backgrounds/default.jpg" class="default"}

- Ideal:
    - Withhold the last year (or a few) of data when building the model
    - Check performance on *hold out sample*
    - This is *out of sample* testing
- Sometimes acceptable:
    - Withhold a random sample of data when building the model
    - Check performance on *hold out sample*

## Estimation {data-background="../Backgrounds/case.jpg" class="default"}

- As we never constructed a hold out sample, let's end by estimating UOL's *2018* year revenue
    - Announced in 2019

```{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
```

## Visualizing our prediction {data-background="../Backgrounds/case.jpg" class="default"}

```{r, fig.height=6, warning=F, message=F, echo=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)
```

## In Sample Accuracy {data-background="../Backgrounds/case.jpg" class="default"}

```{r, echo=F, include=F}
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
```

> Why is UOL the best for in sample?

<div class="fragment exclude">

> UOL is trained to minimize variation only in that context.  It is potentially overfitted, meaning it won't predict well *out of sample*.  Out of sample prediction is much more useful than in sample, however.

</div>

## Actual Accuracy {data-background="../Backgrounds/case.jpg" class="default"}

> UOL posted a \$2.40B in revenue in 2018.

```{r}
preds
```

> Why is the global model better?  Consider UOL's business model (<a href="https://3ljx2m1ndho3557gp169nffb-wpengine.netdna-ssl.com/wp-content/uploads/uol-reports/files/UOL-Annual-Report-2018.pdf">2018 annual report</a>)



# Session 3's application: Quarterly retail revenue {data-background="../Backgrounds/section.jpg" class="header"}

## The question {data-background="../Backgrounds/default.jpg" class="default"}

> How can we predict quarterly revenue for retail companies, leveraging our knowledge of such companies?

- In aggregate
- By Store
- By department

## More specifically... {data-background="../Backgrounds/default.jpg" class="default"}

- Consider time dimensions
    - What matters:
        - Last quarter?
        - Last year?
        - Other time frames?
    - Cyclicality

# Time and OLS {data-background="../Backgrounds/section.jpg" class="header"}

## Time matters a lot for retail {data-background="../Backgrounds/default.jpg" class="default"}

<ul class="gallery" data-interval="3" data-iterations="0">
<li><img src="../Figures/SG_GSS.jpg" alt="Great Singapore Sale"></li>
<li><img src="../Figures/SG_1111.jpg" alt="Double 11"></li>
<li><img src="../Figures/SG_black_friday.jpg" alt="Black Friday"></li>
<li><img src="../Figures/SG_xmas_2016.jpg" alt="Christmas"></li>
</ul>

## How to capture time effects? {data-background="../Backgrounds/default.jpg" class="default"}

<div class="clearfix">
<div class="left">
- Autoregression
    - Regress $y_t$ on earlier value(s) of itself
        - Last quarter, last year, etc.
- Controlling for time directly in the model
    - Essentially the same as fixed effects last week
</div>
<div class="right">
<img src="../Figures/calendar.png" width="400px">
</div>
</div>

# Quarterly revenue prediction {data-background="../Backgrounds/section.jpg" class="header"}

## The data {data-background="../Backgrounds/default.jpg" class="default"}

- From quarterly reports
- Two sets of firms:
    - US "Hypermarkets & Super Centers" (GICS: 30101040)
    - US "Multiline Retail" (GICS: 255030)
- Data from Compustat - Capital IQ > North America - Daily > Fundamentals Quarterly

<img src="../Figures/walmart.jpg" height="300px">

## Formalization {data-background="../Backgrounds/default.jpg" class="default"}

1. Question
    - How can we predict quarterly revenue for large retail companies?
2. Hypothesis (just the alternative ones)
    1. Current quarter revenue helps predict next quarter revenue
    2. 3 quarters ago revenue helps predict next quarter revenue (Year-over-year)
    3. Different quarters exhibit different patterns (seasonality)
    4. A long-run autoregressive model helps predict next quarter revenue
3. Prediction
    - Use OLS for all the above -- $t$-tests for coefficients
    - Hold out sample: 2015-2017

## Variable generation {data-background="../Backgrounds/coding.jpg" class="default"}

```{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
```

- Use mutate for variables using lags
- `ymd()` from `package:lubridate` is a handy way of converting any date listing year, then month, than day.
    - It also has `ydm()`, `mdy()`, `myd()`, `dmy()` and `dym()`
    - It can handle quarters, times, and date-times as well
    - <a href="https://rawgit.com/rstudio/cheatsheets/master/lubridate.pdf">Cheat sheet</a>


## Base R Date manipulation {data-background="../Backgrounds/coding.jpg" class="default"}

- `as.Date()` can take a date formatted as "YYYY/MM/DD" and convert to a proper date value
    - You can convert other date types using the `format=` argument
        - i.e., "DD.MM.YYYY" is format code "%d.%m.%Y"
        - <a href="https://www.rdocumentation.org/packages/base/versions/3.5.1/topics/strptime">Full list of date codes</a>
        
## Example output {data-background="../Backgrounds/coding.jpg" class="default"}

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

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

## Create 8 quarters (2 years) of lags {data-background="../Backgrounds/coding.jpg" class="default"}

```{r, message=F}
# Equivalent brute force code for this is in the appendix
# Custom function to generate a series of lags
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)))
}
# Generate lags "revtq_l#"
df <- multi_lag(df, 1:8, revtq, "_l")

# Generate changes "revtq_gr#"
df <- multi_lag(df, 1:8, revtq_gr)

# Generate year-over-year changes "revtq_yoy#"
df <- multi_lag(df, 1:8, revtq_yoy)

# Generate first differences "revtq_d#"
df <- multi_lag(df, 1:8, revtq_d)
```

- `paste0()`: creates a string vector by concatenating all inputs
- `paste()`: same as `paste0()`, but with spaces added in between
- `setNames()`: allows for storing a value and name simultaneously
- `mutate_at()`: is like mutate but with a list of functions

## Example output {data-background="../Backgrounds/coding.jpg" class="default"}

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

## Clean and split into training and testing {data-background="../Backgrounds/coding.jpg" class="default"}

```{r}
# Clean the data: Replace NaN, Inf, and -Inf with NA
df <- df %>%
  mutate_if(is.numeric, list(~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)
```

- Same cleaning function as last week:
    - Replaces all `NaN`, `Inf`, and `-Inf` with `NA`
- `year()` comes from `package:lubridate`

# Univariate stats {data-background="../Backgrounds/section.jpg" class="header"}

## Univariate stats {data-background="../Backgrounds/default.jpg" class="default"}

- To get a better grasp on the problem, looking at univariate stats can help
    - Summary stats (using `summary()`)
    - Correlations using `cor()`
    - Plots using your preferred package such as `package:ggplot2`

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

## ggplot2 for visualization {data-background="../Backgrounds/reference.jpg" class="default"}

```{r, include=F}
# 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, include=F}
# 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, include=F}
# 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)
}
```

- The next slides will use some custom functions using `package:ggplot2`
- `package:ggplot2` has an odd syntax:
    - It doesn't use pipes (`%>%`), but instead adds everything together (`+`)

```{r, eval=F}
library(ggplot2)  # or tidyverse -- it's part of tidyverse
df %>%
  ggplot(aes(y=var_for_y_axis, x=var_for_x_axis)) +
  geom_point()  # scatterplot
```

- `aes()` is for aesthetics -- how the chart is set up
- Other useful aesthetics:
    - `group=` to set groups to list in the legend.  Not needed if using the below though
    - `color=` to set color by some grouping variable.  Put `factor()` around the variable if you want discrete groups, otherwise it will do a color scale (light to dark)
    - `shape=` to set shapes for points -- <a href="https://cran.r-project.org/web/packages/ggplot2/vignettes/ggplot2-specs.html">see here for a list</a>

## ggplot2 for visualization {data-background="../Backgrounds/reference.jpg" class="default"}

```{r, eval=F}
library(ggplot2)  # or tidyverse -- it's part of tidyverse
df %>%
  ggplot(aes(y=var_for_y_axis, x=var_for_x_axis)) +
  geom_point()  # scatterplot
```

- `geom` stands for geometry -- any shapes, lines, etc. start with `geom`
- Other useful geoms:
    - `geom_line()`: makes a line chart
    - `geom_bar()`: makes a bar chart -- y is the height, x is the category
    - `geom_smooth(method="lm")`: Adds a linear regression into the chart
    - `geom_abline(slope=1)`: Adds a 45° line
- Add `xlab("Label text here")` to change the x-axis label
- Add `ylab("Label text here")` to change the y-axis label
- Add `ggtitle("Title text here")` to add a title
- Plenty more details in the <a href="https://github.com/rstudio/cheatsheets/blob/master/data-visualization-2.1.pdf">'Data Visualization Cheat Sheet'</a> on eLearn

## Plotting: Distribution of revenue {data-background="../Backgrounds/default.jpg" class="default"}

<div class="clearfix">
<div class="left">
1. Revenue
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_dist(train, "revtq")
```

2. Quarterly growth
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_dist(train, "revtq_gr")
```
</div>
<div class="right">
3. Year-over-year growth
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_dist(train, "revtq_yoy")
```

4. First difference
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_dist(train, "revtq_d")
```
</div>

## What do we learn from these graphs? {data-background="../Backgrounds/question.jpg" class="default"}

<div class="alignleft">

1. Revenue
    - $~$
2. Quarterly growth
    - $~$
3. Year-over-year growth
    - $~$
4. First difference
    - $~$
</div>

## What do we learn from these graphs? {data-background="../Backgrounds/answer.jpg" class="default exclude"}

1. Revenue
    - This is really skewed data -- a lot of small revenue quarters, but a significant amount of large revenue quarters in the tail
        - Potential fix: use `log(revtq)`?
2. Quarterly growth
    - Quarterly growth is reasonably close to normally distributed
        - Good for OLS
3. Year-over-year growth
    - Year over year growth is reasonably close to normally distributed
        - Good for OLS
4. First difference
    - Reasonably close to normally distributed, with really long tails
        - Good enough for OLS

## Plotting: Mean revenue by quarter {data-background="../Backgrounds/default.jpg" class="default"}

<div class="clearfix">
<div class="left">
1. Revenue
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_bar(train, "revtq")
```

2. Quarterly growth
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_bar(train, "revtq_gr")
```
</div>
<div class="right">
3. Year-over-year growth
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_bar(train, "revtq_yoy")
```

4. First difference
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_bar(train, "revtq_d")
```
</div>

## What do we learn from these graphs? {data-background="../Backgrounds/question.jpg" class="default"}

<div class="alignleft">

1. Revenue
    - $~$
2. Quarterly growth
    - $~$
3. Year-over-year growth
    - $~$
4. First difference
    - $~$
</div>

## What do we learn from these graphs? {data-background="../Backgrounds/answer.jpg" class="default exclude"}

1. Revenue
    - Revenue seems cyclical!
2. Quarterly growth
    - Definitely cyclical!
3. Year-over-year growth
    - Year over year difference is less cyclical -- more constant
4. First difference
    - Definitely cyclical!

## Plotting: Revenue vs lag by quarter {data-background="../Backgrounds/default.jpg" class="default"}

<div class="clearfix">
<div class="left">
1. Revenue
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_sct(train, "revtq", "revtq_l1")
```

2. Quarterly growth
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_sct(train, "revtq_gr", "revtq_gr1")
```
</div>
<div class="right">
3. Year-over-year growth
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_sct(train, "revtq_yoy", "revtq_yoy1")
```

4. First difference
```{r, echo=F, message=F, warning=F, fig.height=4}
plt_sct(train, "revtq_d", "revtq_d1")
```
</div>

## What do we learn from these graphs? {data-background="../Backgrounds/answer.jpg" class="default"}

1. Revenue
    - Revenue is really linear!  But each quarter has a distinct linear relation.
2. Quarterly growth
    - All over the place.  Each quarter appears to have a different pattern though.  Quarters will matter.
3. Year-over-year growth
    - Linear but noisy.
4. First difference
    - Again, all over the place.  Each quarter appears to have a different pattern though.  Quarters will matter.

## Correlation matrices {data-background="../Backgrounds/default.jpg" class="default"}

```{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")
```

> Retail revenue has really high autocorrelation!  Concern for multicolinearity.  Revenue growth is less autocorrelated and oscillates.

## Correlation matrices {data-background="../Backgrounds/default.jpg" class="default"}

```{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")
```

> Year over year change fixes the multicollinearity issue. First difference oscillates like quarter over quarter growth.

## R Practice {data-background="../Backgrounds/coding.jpg" class="default"}

- This practice will look at predicting Walmart's quarterly revenue using:
    - 1 lag
    - Cyclicality
- Practice using:
    - `lm()`
    - `package:ggplot2`
- Do the exercises in today's practice file
    - <a href="http://rmc.link/Slides/acct420v3/Session_3/Session_3_R.html">R Practice</a>
    - Short link: <a href="http://rmc.link/Slides/acct420v3/Session_3/Session_3_R.html">rmc.link/420r3</a>

# Forecasting {data-background="../Backgrounds/section.jpg" class="header"}

## 1 period models {data-background="../Backgrounds/default.jpg" class="default"}

<div class="alignleft">

1. 1 Quarter lag
    - We saw a very strong linear pattern here earlier
```{r}
mod1 <- lm(revtq ~ revtq_l1, data=train)
```

2. Quarter and year lag
    - Year-over-year seemed pretty constant
```{r}
mod2 <- lm(revtq ~ revtq_l1 + revtq_l4, data=train)
```

3. 2 years of lags
    - Other lags could also help us predict
```{r}
mod3 <- lm(revtq ~ revtq_l1 + revtq_l2 + revtq_l3 + revtq_l4 + 
             revtq_l5 + revtq_l6 + revtq_l7 + revtq_l8, data=train)
```

4. 2 years of lags, by observation quarter
    - Take into account cyclicality observed in bar charts
```{r}
mod4 <- lm(revtq ~ (revtq_l1 + revtq_l2 + revtq_l3 + revtq_l4 +
             revtq_l5 + revtq_l6 + revtq_l7 + revtq_l8):factor(qtr),
           data=train)
```
</div>

## Quarter lag {data-background="../Backgrounds/case.jpg" class="default"}

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

## Quarter and year lag {data-background="../Backgrounds/case.jpg" class="default"}

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

## 2 years of lags {data-background="../Backgrounds/case.jpg" class="default"}

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

## 2 years of lags, by observation quarter {data-background="../Backgrounds/case.jpg" class="default"}

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

## Testing out of sample {data-background="../Backgrounds/reference.jpg" class="default"}

- RMSE: Root mean square Error
- RMSE is very affected by outliers, and a bad choice for noisy data where you are OK with missing a few outliers here and there
    - Doubling error *quadruples* the penalty

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

- MAE: Mean absolute error
- MAE is measures average accuracy with no weighting
    - Doubling error *doubles* the penalty
```{r}
mae <- function(v1, v2) {
  mean(abs(v1-v2), na.rm=T)
}
```

> Both are commonly used for evaluating OLS out of sample

## Testing out of sample {data-background="../Backgrounds/case.jpg" class="default"}

```{r, echo=F, 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
```

<div class="clearfix fragment">
<div class="left">
1 quarter model
```{r, echo=F, 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")
```
</div>
<div class="right">
8 period model, by quarter
```{r, echo=F, 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")
```
</div>

## What about for revenue growth? {data-background="../Backgrounds/case.jpg" class="default"}

$revt_t=(1+growth_t)\times revt_{t-1}$

```{r, echo=F, 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)
```

<div class="clearfix fragment">
<div class="left">
1 quarter model
```{r, echo=F, 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")
```
</div>
<div class="right">
8 period model, by quarter
```{r, echo=F, 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")
```
</div>

## What about for YoY revenue growth? {data-background="../Backgrounds/case.jpg" class="default"}

$revt_t=(1+yoy\_growth_t)\times revt_{t-4}$

```{r, echo=F, 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)
```

<div class="clearfix fragment">
<div class="left">
1 quarter model
```{r, echo=F, 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")
```
</div>
<div class="right">
8 period model
```{r, echo=F, 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")
```
</div>

## What about for first difference? {data-background="../Backgrounds/case.jpg" class="default"}

$revt_t= change_t+ revt_{t-1}$

```{r, echo=F, 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)
```

<div class="clearfix fragment">
<div class="left">
1 quarter model
```{r, echo=F, 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")
```
</div>
<div class="right">
8 period model, by quarter
```{r, echo=F, 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")
```
</div>

## Takeaways {data-background="../Backgrounds/reference.jpg" class="default"}

1. The first difference model works a bit better than the revenue model at predicting next quarter revenue
    - It also doesn't suffer (as much) from multicollinearity
        - This is why time series analysis is often done on first differences
            - Or second differences (difference in differences)
2. The other models perform pretty well as well
3. Extra lags generally seems helpful when accounting for cyclicality
4. Regressing by quarter helps a bit, particularly with revenue growth

## What about for revenue growth? {data-background="../Backgrounds/case.jpg" class="default"}

Predicting quarter over quarter revenue growth itself

```{r, echo=F, 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)
```

<div class="clearfix fragment">
<div class="left">
1 quarter model
```{r, echo=F, 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")
```
</div>
<div class="right">
8 period model, by quarter
```{r, echo=F, 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")
```
</div>

## What about for YoY revenue growth? {data-background="../Backgrounds/case.jpg" class="default"}

Predicting YoY revenue growth itself
```{r, echo=F, 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)
```

<div class="clearfix fragment">
<div class="left">
1 quarter model
```{r, echo=F, 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")
```
</div>
<div class="right">
8 period model
```{r, echo=F, 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")
```
</div>

## What about for first difference? {data-background="../Backgrounds/case.jpg" class="default"}

Predicting first difference in revenue itself

```{r, echo=F, 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)
```

<div class="clearfix fragment">
<div class="left">
1 quarter model
```{r, echo=F, 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")
```
</div>
<div class="right">
8 period model, by quarter
```{r, echo=F, 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")
```
</div>

# Case: Advanced revenue prediction {data-background="../Backgrounds/case.jpg" class="default"}

## RS Metrics' approach {data-background="../Backgrounds/group.jpg" class="default"}

Read the press release: <a href="https://www.prweb.com/releases/2011/7/prweb8615796.htm">rmc.link/420class3</a>

- How does RS Metrics approach revenue prediction?
- What other creative ways might there be?


# End matter {data-background="../Backgrounds/ending.jpg" class="header"}

## For next week {data-background="../Backgrounds/ending.jpg" class="default"}

- For next week:
    - First individual assignment
        - Finish by next class 
        - Submit on eLearn
    - Datacamp
        - Practice a bit more to keep up to date
            - Using R more will make it more natural
- Survey on the class session at <a href="https://docs.google.com/forms/d/e/1FAIpQLSf4MWdAli5qGTnIk-rSr-sC7QwGGBEWnKmnlTT5vbbjf2KOdw/viewform?usp=sf_link">rmc.link/420survey3</a>

## Packages used for these slides {data-background="../Backgrounds/coding.jpg" class="default stack"}

- `package:kableExtra`
- `package:knitr`
- `package:lubridate`
- `package:magrittr`
- `package:revealjs`
- `package:tidyverse`

## Custom code {data-background="../Backgrounds/coding.jpg" class="default stack"}

<small style="width:100%">
```{r, eval=F}
# Brute force code for variable generation of quarterly data lags
df <- df %>%
  group_by(gvkey) %>%
  mutate(revtq_lag1=lag(revtq), revtq_lag2=lag(revtq, 2),
         revtq_lag3=lag(revtq, 3), revtq_lag4=lag(revtq, 4),
         revtq_lag5=lag(revtq, 5), revtq_lag6=lag(revtq, 6),
         revtq_lag7=lag(revtq, 7), revtq_lag8=lag(revtq, 8),
         revtq_lag9=lag(revtq, 9), revtq_gr=revtq / revtq_lag1 - 1,
         revtq_gr1=lag(revtq_gr), revtq_gr2=lag(revtq_gr, 2),
         revtq_gr3=lag(revtq_gr, 3), revtq_gr4=lag(revtq_gr, 4),
         revtq_gr5=lag(revtq_gr, 5), revtq_gr6=lag(revtq_gr, 6),
         revtq_gr7=lag(revtq_gr, 7), revtq_gr8=lag(revtq_gr, 8),
         revtq_yoy=revtq / revtq_lag4 - 1, revtq_yoy1=lag(revtq_yoy),
         revtq_yoy2=lag(revtq_yoy, 2), revtq_yoy3=lag(revtq_yoy, 3),
         revtq_yoy4=lag(revtq_yoy, 4), revtq_yoy5=lag(revtq_yoy, 5),
         revtq_yoy6=lag(revtq_yoy, 6), revtq_yoy7=lag(revtq_yoy, 7),
         revtq_yoy8=lag(revtq_yoy, 8), revtq_d=revtq - revtq_l1,
         revtq_d1=lag(revtq_d), revtq_d2=lag(revtq_d, 2),
         revtq_d3=lag(revtq_d, 3), revtq_d4=lag(revtq_d, 4),
         revtq_d5=lag(revtq_d, 5), revtq_d6=lag(revtq_d, 6),
         revtq_d7=lag(revtq_d, 7), revtq_d8=lag(revtq_d, 8)) %>%
  ungroup()
```

```{r, eval=F}
# Custom html table for small data frames
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, eval=F}

# Calculating Root Mean Squared Error (Slide 11.5)
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

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 only", "UOL 2018 Baseline", "UOL 2018 w/ macro", "UOL 2018 w/ world")
rmse
```


</small>

## Custom code {data-background="../Backgrounds/coding.jpg" class="default stack"}

<small style="width:100%">

```{r, eval=F}
# 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, eval=F}
# 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)
}
```

</small>

## Custom code {data-background="../Backgrounds/coding.jpg" class="default stack"}

<small style="width:100%">

```{r, eval=F}
# 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, eval=F}
# Calculating various in and out of sample statistics
models <- list(mod1,mod2,mod3,mod4)
model_names <- c("1 period", "1 and 4 period", "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
```

</small>

## NOTES {class="never"}

- Add in an example of external validation -- kick out 2 years of data, rerun, validate.  Not hard to add.
