# Agenda

0. Course Announcements
1. Weighted models
2. Bagged models
3. Boosting
5. Group work

# Midterm 3/17

## Brief recap of course so far {.smaller}

- Linear regression (e.g. `lprice ~ .`), assumptions of model, interpretation.
- $K$-NN (e.g., `province ~ .`), multi-class supervised classification. Hyperparameter $k$.
- Naive Bayes (e.g., `province ~ .`), multi-class supervised classification.
- Logistic regression (e.g., `province=="Oregon" ~ .`), binary supervised classification. Elastic net. 
- Feature engineering (logarithms, center/scaling, Box Cox, tidytext, etc.).
- Feature selection (correlation, linear / logistic coefficients, frequent words, frequent words by class, etc.).

## Practice

- Practice midterm out.
- You will go over it on 10 Mar.
- It is based on the 5 homeworks.
- It is based on the prior slide.
  - Little to no computatational linguistics
  - I'm regarding `tidytext` as extension, not core, content.

## Modality Update

- Reminder for me if we haven't set modality.

# First Model Due 3/10

##  Publish

- Each group should create:

1. An annotated `.*md` file, and 
2. The .rds/.pickle/.parquet file that it generates, that
3. Contains *only* the features you want in the model.

- Under version control, on GitHub.

##  Constraints

- I will run:

1. The specified $K$NN or Naive Bayes model,
2. With: `province ~ .` (or the whole data frame in `scikit`)
3. With repeated 5-fold cross validation
4. With the same index for partitioning training and test sets for every group.
5. On whatever is turned in before class.
6. Bragging rights for highest Kappa

## Context

- The "final exam" is that during the last class you will present your model results as though you are speaking to the
managers of a large winery.
- It should be presented from a Quarto presentation on GitHub or perhaps e.g. RPubs.
- You must present via the in-room "teaching machine" computer, not your own physical device, to ensure that you are comfortable distributing your findings.

## Link up?

- After lecture

# Weigted Penalty


## Libraries Setup
```{r libs}
sh <- suppressPackageStartupMessages
sh(library(tidyverse))
sh(library(caret))
sh(library(tidytext))
sh(library(SnowballC))
sh(library(rpart)) # New?
sh(library(randomForest)) # New?
sh(library(doParallel)) # New?
sh(library(gbm)) # New?
data(stop_words)
sh(library(thematic))
theme_set(theme_dark())
thematic_rmd(bg = "#111", fg = "#eee", accent = "#eee")
```

## Dataframe

```{r rds}
wine <- readRDS(gzcon(url("https://cd-public.github.io/D505/dat/pinot.rds")))
names(wine)[names(wine) == 'id'] = 'id'
```

## Wine Words

```{r setup}
wine_words <- function(df, j, stem){ 
  words <- df %>%
    unnest_tokens(word, description) %>%
    anti_join(stop_words) %>% 
    filter(!(word %in% c("wine","pinot","vineyard")))
  
  if(stem){
    words <- words %>% mutate(word = wordStem(word))
  }
  
  words %>% count(id, word) %>%  group_by(id) %>%  mutate(exists = (n>0)) %>% 
    ungroup %>% group_by(word) %>%  mutate(total = sum(n)) %>% filter(total > j) %>% 
    pivot_wider(id_cols = id, names_from = word, values_from = exists, values_fill = list(exists=0)) %>% 
    right_join(select(df,id,province)) %>% select(-id) %>% mutate(across(-province, ~replace_na(.x, F)))
}
```

## Split It

```{r splits}
wino <- wine_words(wine, 1000, T)
wine_index <- createDataPartition(wino$province, p = 0.80, list = FALSE)
train <- wino[ wine_index, ]
test <- wino[-wine_index, ]
```

## Quick Training

```{r baseline}
control = trainControl(method = "cv", number = 5)
fit <- train(province ~ .,
             data = train, 
             trControl = control,
             method = "multinom",
             maxit = 5) # speed it up - default 100
```

## Matrix

```{r basetrix}
pred <- factor(predict(fit, newdata = test))
confusionMatrix(pred,factor(test$province))
```

## Create some weights

```{r weight_train}
weight_train <- train %>% 
  mutate(weights=if_else(province=="California",1,20))
```

## Add weight to model

- Look closely:
  - Train over `train` dataframe
  - Provide weights from `weight_train` data frame
  - That way it won't train on weights!

```{r model weight}
fit <- train(province ~ .,
             data = train, 
             trControl = control,
             method = "multinom",
             maxit = 5,
             weights = weight_train$weights)
```

## Matrix

```{r weightrix}
pred <- factor(predict(fit, newdata = test))
confusionMatrix(pred,factor(test$province))
```



## Weighted Models

- Where do these weights come from?

```{r weights}
weight_train <- train %>% 
  mutate(weights=case_when(
    province=="Burgundy" ~ 3,
    province=="California" ~ 1,
    province=="Casablanca_Valley" ~ 37,
    province=="Marlborough" ~ 18.5,
    province=="New_York" ~ 37,
    province=="Oregon" ~ 1.4))
```

## Progressive overload

```{r good weights}
fit <- train(province ~ .,
             data = train, 
             trControl = control,
             method = "multinom",
             maxit = 5,
             weights = weight_train$weights)
```

## Matrix

```{r weightrix2}
pred <- factor(predict(fit, newdata = test))
confusionMatrix(pred,factor(test$province))
```

## Weight generation

:::: {.columns}

::: {.column width="50%"}

- Check wines per province.

```{r wine prov}
wine %>%
  group_by(province) %>%
  summarize(count = n())
```

:::


::: {.column width="50%"}

- Recall the weights:

```{.email}
...
"Burgundy"          ~ 3,
"California"        ~ 1,
"Casablanca_Valley" ~ 37,
"Marlborough"       ~ 18.5,
"New_York"          ~ 37,
"Oregon"            ~ 1.4
...
```

:::

::::

## Exercise

- Write a function to:
  - Find weights, given
  - A dataframe, and
  - A column name.



# Regularization

![](https://upload.wikimedia.org/wikipedia/commons/0/02/Regularization.svg)

## Penalty

- Regularization is often also called 'penalization' because it adds a *penalizing term* to the loss function.

$$
\min_{f}\sum_{i=1}^{n}V(f(x_{i}),y_{i})+\lambda R(f)
$$

- *De facto* application of Occam's Razor.
  - Assume simple is good.
  - Therefore punish coefficients (which complicate things)

## Penalties

- The amount of the penalty is fine-tuned using a constant lambda $\lambda$. 
- When $\lambda = 0$, no penalty is enforced. 
- The best lambda can be found by finding a value that minimizes prediction error after cross validating the model with different values.


## Lasso Regression

- Given $p$ features and $N$ observations. 
- $\beta$'s are coefficients.
- The $\lambda$ term is evaluated via absolute value $|\beta_j|$

$$
\sum_{i=1}^{n} \left( y_i - \beta_0 - \sum_{j=1}^{p} \beta_j x_{ij}    \right) ^ 2 + \lambda \sum_{j=1}^{p} |\beta_j|
$$

## LASSO

- Least Absolute Shrinkage and Selection Operator. 
- Shrinks the regression coefficients toward zero.
- Penalizing the regression model with a penalty term called **L1-norm**
  - The sum of the absolute coefficients.
  - I learned about L1 in a class called "Real Analysis"
  - Its the streetmap distance (roads and avenues)

## Lasso Regression

- Zeroes out some coefficients
  - With a minor contribution to the model, can't "resist" the penalty. 
- Lasso can be also seen as an alternative to the subset selection methods.
  - A form of variable selection.

## glmnet

- "Lasso and Elastic-Net Regularized Generalized Linear Models"
  - Elastic-Net on forthcoming slides!
- Use via
```{.r}
method = "glmnet", 
```
- It accepts an `alpha` value.
  - Set to `1` for LASSO
  - Set to non-one on latter slides!

## LASSO

- `tuneGrid` is I think, clunky, but we only use it here as a demo.
```{r lasso}
# we specify lamdba via a "tuneGrid"
lasso = expand.grid(alpha = 1, lambda = seq(0.001, 0.1, length = 10))
fit <- train(province ~., 
             data = train,
             method = "glmnet",
             trControl = control,
             tuneGrid = lasso)
```

## Inspect $\lambda$

```{r lasmbda}
fit$bestTune$lambda
```

## Confusion Matrix

```{r lastrix}
confusionMatrix(factor(predict(fit, newdata = test)), factor(test$province))
```

## Ridge Regression

- Given $p$ features and $N$ observations. 
- $\beta$'s are coefficients.
- The $\lambda$ term is evaluated via square $\beta_j^2$


$$
\sum_{i=1}^{n} \left( y_i - \beta_0 - \sum_{j=1}^{p} \beta_j x_{ij}    \right) ^ 2 + \lambda \sum_{j=1}^{p} \beta_j^2
$$

## Ridge

- Also Tikhonov regularization, named for Andrey Tikhonov
- Shrinks the regression coefficients toward zero.
- Penalizing the regression model with a penalty term called **L2-norm**
  - The sum of the sqared coefficients.
  - I *also* learned about L2 in  "Real Analysis"
  - Its the as-birds-fly distance (point-to-point)

## Ridge

- Set `alpha` (that is, $\alpha$) to 0.
```{r ridge}
# we specify lamdba via a "tuneGrid"
ridge = expand.grid(alpha = 0, lambda = seq(0.001, 0.1, length = 10))
fit <- train(province ~., 
             data = train,
             method = "glmnet",
             trControl = control,
             tuneGrid = ridge)
```

## Inspect $\lambda$

- Much higher than Lasso (0.012 vs 0.001)

```{r ridgda}
fit$bestTune$lambda
```

## Confusion Matrix

```{r ridgetrix}
confusionMatrix(factor(predict(fit, newdata = test)), factor(test$province))
```


## Elastic Net

- Given $p$ features and $N$ observations. 
- $\beta$'s are coefficients.
- Add both together and weight them comparatively via parameter $\alpha$
  - Lower case alpha.

$$
\sum_{i=1}^{n} \left( y_i - \beta_0 - \sum_{j=1}^{p} \beta_j x_{ij}  \right) ^ 2 + \alpha\lambda \sum_{j=1}^{p} |\beta_j|+(1-\alpha)\lambda \sum_{j=1}^{p} \beta_j^2
$$

## Deciding

- I only ever hear of LASSO or elastic net, which combines Lasso and Ridge:
  - Lasso better in a situation where some of the predictors have large coefficients, and the remaining predictors have very small coefficients.
  - Ridge regression better when many predictors with coefficients of roughly equal size.
  - Not too costly to just try them or tune along $\alpha$

## Elastic Net

- This is the fun one.
- Just don't say anything and you get elastic net.

```{r net}
fit <- train(province ~., 
             data = train,
             method = "glmnet",
             trControl = control)
             # tuneGrid = ridge)
```

## Inspect $\lambda$ and $\alpha$

- Much higher than Lasso (0.012 vs 0.001)

```{r alpha}
fit$bestTune
```

## Confusion Matrix

- In this case, doesn't seem better than Lasso by much at all!
  - But - it's automatic.
  - Let the computer think hard so you can spend time thinking about, say, features.

```{r netrix}
confusionMatrix(factor(predict(fit, newdata = test)), factor(test$province))
```

# Bagging, Boosting and Custom Ensembles

## 

[Understanding the Bias-Variance Tradeoff by Scott Fortman-Roe](Understanding the Bias-Variance Tradeoff)

```{=html}
<table>
    <tbody><tr>
        <th></th>
        <td>
            Low Variance
        </td>
        <td>
            High Variance
        </td>
    </tr>
    <tr>
        <td class="r90">
            Low Bias
        </td>
        <td>
            <div id="bullsEyeLBLV"><svg width="200" height="200" style="border: medium;"><circle class="ring" cx="100" cy="100" r="90.9090909090909" style="fill: white;"></circle><circle class="ring" cx="100" cy="100" r="62.5" style="fill: rgb(118, 179, 216);"></circle><circle class="ring" cx="100" cy="100" r="36.36363636363637" style="fill: white;"></circle><circle class="ring" cx="100" cy="100" r="13.333333333333334" style="fill: rgb(193, 47, 62);"></circle><circle class="arrow" cx="95.2417299219265" cy="98.78231506348611" r="2.5"></circle><circle class="arrow" cx="94.98877477792978" cy="98.35369950854978" r="2.5"></circle><circle class="arrow" cx="98.64499086445454" cy="90.1611985381718" r="2.5"></circle><circle class="arrow" cx="98.29842135491629" cy="103.46102989370513" r="2.5"></circle><circle class="arrow" cx="95.79393665077546" cy="100.68784532768193" r="2.5"></circle><circle class="arrow" cx="99.98795100308158" cy="101.81130596018545" r="2.5"></circle><circle class="arrow" cx="89.34113757239132" cy="96.3757227502656" r="2.5"></circle><circle class="arrow" cx="92.93663382940163" cy="93.85728904385391" r="2.5"></circle><circle class="arrow" cx="91.27400877365645" cy="92.74432495644449" r="2.5"></circle><circle class="arrow" cx="98.35171143651966" cy="90.25639751501993" r="2.5"></circle><circle class="arrow" cx="89.84479267773501" cy="89.80271518867866" r="2.5"></circle><circle class="arrow" cx="102.92811906669978" cy="102.31429122988574" r="2.5"></circle><circle class="arrow" cx="98.43292822053172" cy="94.33502755999424" r="2.5"></circle><circle class="arrow" cx="100.03977392090455" cy="88.32650985799843" r="2.5"></circle><circle class="arrow" cx="90.45638062240717" cy="91.38063914598084" r="2.5"></circle><circle class="arrow" cx="91.814500886036" cy="105.83526025811605" r="2.5"></circle><circle class="arrow" cx="93.48689316677351" cy="94.63423346645308" r="2.5"></circle><circle class="arrow" cx="93.2603587976381" cy="98.98875335330786" r="2.5"></circle><circle class="arrow" cx="96.46568926721694" cy="92.17361145704697" r="2.5"></circle><circle class="arrow" cx="91.90571922505733" cy="88.55473443715668" r="2.5"></circle><circle class="arrow" cx="103.20972223139" cy="96.86760959426755" r="2.5"></circle><circle class="arrow" cx="90.45135687581899" cy="102.46241789283684" r="2.5"></circle><circle class="arrow" cx="96.83775784414765" cy="109.14141342737429" r="2.5"></circle><circle class="arrow" cx="88.47009267490499" cy="102.33783592020343" r="2.5"></circle><circle class="arrow" cx="103.08969765418682" cy="99.25599334201341" r="2.5"></circle></svg></div>
        </td>
        <td>
            <div id="bullsEyeLBHV"><svg width="200" height="200" style="border: medium;"><circle class="ring" cx="100" cy="100" r="90.9090909090909" style="fill: white;"></circle><circle class="ring" cx="100" cy="100" r="62.5" style="fill: rgb(118, 179, 216);"></circle><circle class="ring" cx="100" cy="100" r="36.36363636363637" style="fill: white;"></circle><circle class="ring" cx="100" cy="100" r="13.333333333333334" style="fill: rgb(193, 47, 62);"></circle><circle class="arrow" cx="135.30208525468566" cy="109.53667975411805" r="2.5"></circle><circle class="arrow" cx="128.43144410223016" cy="73.55338417474053" r="2.5"></circle><circle class="arrow" cx="62.46329544014869" cy="115.09033226489368" r="2.5"></circle><circle class="arrow" cx="126.27343247249648" cy="66.14548779266283" r="2.5"></circle><circle class="arrow" cx="87.5311440807998" cy="96.79804569434428" r="2.5"></circle><circle class="arrow" cx="89.86553587619488" cy="73.31114567408036" r="2.5"></circle><circle class="arrow" cx="72.14224642068129" cy="71.56278538776868" r="2.5"></circle><circle class="arrow" cx="133.67943947732815" cy="99.4197165637036" r="2.5"></circle><circle class="arrow" cx="95.39079143636448" cy="118.7690125167322" r="2.5"></circle><circle class="arrow" cx="94.97114920044513" cy="89.90155532250407" r="2.5"></circle><circle class="arrow" cx="97.76397547830885" cy="104.44717591002323" r="2.5"></circle><circle class="arrow" cx="89.30844911697717" cy="85.24513430882038" r="2.5"></circle><circle class="arrow" cx="84.9656556483016" cy="110.46435847056802" r="2.5"></circle><circle class="arrow" cx="94.47025121828862" cy="111.22511714783076" r="2.5"></circle><circle class="arrow" cx="81.19000260405745" cy="87.45496868419164" r="2.5"></circle><circle class="arrow" cx="52.31412324140461" cy="109.70597207613788" r="2.5"></circle><circle class="arrow" cx="84.07493934147824" cy="121.38043888867571" r="2.5"></circle><circle class="arrow" cx="79.96730411760538" cy="96.32433545651551" r="2.5"></circle><circle class="arrow" cx="97.5698900562818" cy="104.32403135668825" r="2.5"></circle><circle class="arrow" cx="64.83727832847151" cy="102.24003307409187" r="2.5"></circle><circle class="arrow" cx="96.43564661227427" cy="111.54952202719106" r="2.5"></circle><circle class="arrow" cx="113.09578479104827" cy="118.67825786463287" r="2.5"></circle><circle class="arrow" cx="103.04118268265579" cy="107.66971927290987" r="2.5"></circle><circle class="arrow" cx="76.27875910415312" cy="128.31617509558063" r="2.5"></circle><circle class="arrow" cx="129.12754678814048" cy="95.5293181876095" r="2.5"></circle></svg></div>
        </td>
    </tr>
    <tr>
        <td class="r90">
            High Bias
        </td>
        <td>
            <div id="bullsEyeHBLV"><svg width="200" height="200" style="border: medium;"><circle class="ring" cx="100" cy="100" r="90.9090909090909" style="fill: white;"></circle><circle class="ring" cx="100" cy="100" r="62.5" style="fill: rgb(118, 179, 216);"></circle><circle class="ring" cx="100" cy="100" r="36.36363636363637" style="fill: white;"></circle><circle class="ring" cx="100" cy="100" r="13.333333333333334" style="fill: rgb(193, 47, 62);"></circle><circle class="arrow" cx="93.27374996049726" cy="42.328637258595556" r="2.5"></circle><circle class="arrow" cx="105.52581398889991" cy="44.93556686811315" r="2.5"></circle><circle class="arrow" cx="95.26101246647794" cy="46.7755302240622" r="2.5"></circle><circle class="arrow" cx="112.05060873387474" cy="52.86933183374843" r="2.5"></circle><circle class="arrow" cx="110.17742629325286" cy="57.67330743618805" r="2.5"></circle><circle class="arrow" cx="102.62633835599787" cy="47.63329341720682" r="2.5"></circle><circle class="arrow" cx="104.97396150323235" cy="53.86880949845978" r="2.5"></circle><circle class="arrow" cx="103.76256282114713" cy="48.3116835441338" r="2.5"></circle><circle class="arrow" cx="97.84406081280112" cy="48.05373982750756" r="2.5"></circle><circle class="arrow" cx="105.47413674536088" cy="60.8819662990806" r="2.5"></circle><circle class="arrow" cx="101.32433258243718" cy="50.42653499700785" r="2.5"></circle><circle class="arrow" cx="107.75895816267607" cy="53.5123837318865" r="2.5"></circle><circle class="arrow" cx="102.34151233023265" cy="43.22134477028904" r="2.5"></circle><circle class="arrow" cx="102.74836927714325" cy="48.99085752653546" r="2.5"></circle><circle class="arrow" cx="103.5514955929248" cy="50.700765047971295" r="2.5"></circle><circle class="arrow" cx="99.66489163788832" cy="52.960882058099266" r="2.5"></circle><circle class="arrow" cx="104.03334679960989" cy="50.56365067938392" r="2.5"></circle><circle class="arrow" cx="112.40294162147084" cy="51.05603578517508" r="2.5"></circle><circle class="arrow" cx="103.77185736249525" cy="48.69041724555987" r="2.5"></circle><circle class="arrow" cx="105.75923213844915" cy="52.16305294199713" r="2.5"></circle><circle class="arrow" cx="100.02620538056256" cy="45.76240834088125" r="2.5"></circle><circle class="arrow" cx="92.6900668670068" cy="49.1548990106344" r="2.5"></circle><circle class="arrow" cx="102.52276709795272" cy="54.66889873214721" r="2.5"></circle><circle class="arrow" cx="92.63240239912123" cy="54.816287121818064" r="2.5"></circle><circle class="arrow" cx="93.67433387840616" cy="44.1308081872826" r="2.5"></circle></svg></div>
        </td>
        <td>
            <div id="bullsEyeHBHV"><svg width="200" height="200" style="border: medium;"><circle class="ring" cx="100" cy="100" r="90.9090909090909" style="fill: white;"></circle><circle class="ring" cx="100" cy="100" r="62.5" style="fill: rgb(118, 179, 216);"></circle><circle class="ring" cx="100" cy="100" r="36.36363636363637" style="fill: white;"></circle><circle class="ring" cx="100" cy="100" r="13.333333333333334" style="fill: rgb(193, 47, 62);"></circle><circle class="arrow" cx="103.71226190486529" cy="35.245951954634805" r="2.5"></circle><circle class="arrow" cx="85.66758527040301" cy="67.2447331281883" r="2.5"></circle><circle class="arrow" cx="62.28568550397415" cy="32.140931024292215" r="2.5"></circle><circle class="arrow" cx="44.453050499204494" cy="27.594136705300244" r="2.5"></circle><circle class="arrow" cx="65.5267486415562" cy="34.97572973546029" r="2.5"></circle><circle class="arrow" cx="52.31696098385054" cy="63.901284157820186" r="2.5"></circle><circle class="arrow" cx="48.16744830325244" cy="18.83190221128146" r="2.5"></circle><circle class="arrow" cx="74.76574746979051" cy="45.429332524802895" r="2.5"></circle><circle class="arrow" cx="93.43125456438462" cy="10.626913149263643" r="2.5"></circle><circle class="arrow" cx="68.5906869780192" cy="46.07543950204163" r="2.5"></circle><circle class="arrow" cx="76.78805778650607" cy="37.09650785588681" r="2.5"></circle><circle class="arrow" cx="72.76655176927713" cy="50.971128326292146" r="2.5"></circle><circle class="arrow" cx="42.724353763919886" cy="61.927273912222816" r="2.5"></circle><circle class="arrow" cx="112.20625419743854" cy="39.15213297199204" r="2.5"></circle><circle class="arrow" cx="88.36900320964696" cy="38.854779509806455" r="2.5"></circle><circle class="arrow" cx="63.66053914630819" cy="56.46641986123598" r="2.5"></circle><circle class="arrow" cx="68.96191500872605" cy="43.16404842444755" r="2.5"></circle><circle class="arrow" cx="35.635519046608465" cy="28.74648178852344" r="2.5"></circle><circle class="arrow" cx="68.60182810836173" cy="59.740609767146466" r="2.5"></circle><circle class="arrow" cx="95.5153403974868" cy="25.547080430710736" r="2.5"></circle><circle class="arrow" cx="46.37075852226722" cy="19.62606830684345" r="2.5"></circle><circle class="arrow" cx="89.9950666768221" cy="50.71556277512999" r="2.5"></circle><circle class="arrow" cx="64.45958584171213" cy="42.52949470919935" r="2.5"></circle><circle class="arrow" cx="95.57718864645554" cy="4.197361489016814" r="2.5"></circle><circle class="arrow" cx="70.63354751617322" cy="32.127872854044625" r="2.5"></circle></svg></div>
        </td>
    </tr>
</tbody></table>
```

## Goals

The goal is to decrease the variance (bagging) or bias (boosting) in our models.

- Step 1: producing a distribution of simple ML models on subsets of the original data.
- Step 2: combine the distribution into one “aggregated” model.

## Framework

**Note:** Subtle difference between Bagging/Boosting and resampling.

- Re-sampling --> average coefficients from different subsamples to create one model
- Bagging/Boosting --> average the predictions from different models


## Bagging (subsets of data)

- "Bootstrap aggregating"
- Builds multiple models with bootstrap samples (combinations with repetitions) using a single algorithm. 
- The models’ predictions are combined with voting (for classification) or averaging (for numeric prediction). 
- Voting means the bagging model’s prediction is based on the majority of learners’ prediction for a class. 

## Bagging

![](https://upload.wikimedia.org/wikipedia/commons/c/c8/Ensemble_Bagging.svg)

## Treebag

- Treebag, or, generate trees and combine trees, taking different weights.

```{r bag}
fit <- train(province ~ .,
             data = train, 
             trControl = control,
             method = "treebag",
             maxit = 5) # speed it up - default 100
fit
```

## Confusion Matrix

```{r bagtrix }
pred <- predict(fit, newdata=test)
confusionMatrix(factor(pred),factor(test$province))
```




## Boosting {.smaller}

> A horse-racing gambler, hoping to maximize his winnings, decides to create a computer program that will accurately predict the winner of a horse race based on the usual information (number of races recently won by each horse, betting odds for each horse, etc.). To create such a program, he asks a highly successful expert gambler to explain his betting strategy. Not surprisingly, the expert is unable to articulate a grand set of rules for selecting a horse. On the other hand, when presented with the data for a specific set of races, the expert has no trouble coming up with a “rule of thumb” for that set of races (such as, “Bet on the horse that has recently won the most races” or “Bet on the horse with the most favored odds”). Although such a rule of thumb, by itself, is obviously very rough and inaccurate, it is not unreasonable to expect it to provide predictions that are at least a little bit better than random guessing. Furthermore, by repeatedly asking the expert’s opinion on different collections of races, the gambler is able to extract many rules of thumb.

## Boosting {.smaller}

> In order to use these rules of thumb to maximum advantage, there are two problems faced by the gambler:

> First, how should he choose the collections of races presented to the expert so as to extract rules of thumb from the expert that will be the most useful?

> Second, once he has collected many rules of thumb, how can they be combined into a single, highly accurate prediction rule?

> Boosting refers to a general and provably effective method of producing a very accurate prediction rule by combining rough and moderately inaccurate rules of thumb in a manner similar to that suggested above

[Read more](https://cseweb.ucsd.edu/~yfreund/papers/IntroToBoosting.pdf)

## Boosting

![](https://bradleyboehmke.github.io/HOML/images/boosted-trees-process.png)

[Credit](https://bradleyboehmke.github.io/HOML/gbm.html)

## Boosting

![](https://bradleyboehmke.github.io/HOML/images/boosted-trees-process.png)

[Credit](https://bradleyboehmke.github.io/HOML/gbm.html)

## GBM

- Generalized Boost Models are Caret compatible
  - XGBoost is more common but requires learning XGB
  - It uses different performance acceleration.
- This thing is *slow* so we modify the defaults:

```{r gbm_grid}
gbm_grid <- expand.grid(interaction.depth = c(1, 3), 
                        n.trees = c(5, 10), 
                        shrinkage = c(0.01, 0.1), 
                        n.minobsinnode = 10)
```

## Boost City

```{r boost }
fit <- train(province~., 
             data = train, 
             method="gbm",
             trControl=control,
             tuneGrid = gbm_grid,)
```

## Confusion Matrix

```{r boostrix}
pred <- predict(fit, newdata=test)
confusionMatrix(factor(pred),factor(test$province))
```

## Random Forest

- By far the most popular to my mind is random forest.
- Bagged tree with random feature selection.
- *It just works.*

```{r rf }
fit <- train(province ~ .,
             data = train, 
             trControl = control,
             method = "rf",
             maxit = 5) # speed it up - default 100
fit
```

## Confusion Matrix

```{r rftrix}
pred <- predict(fit, newdata=test)
confusionMatrix(factor(pred),factor(test$province))
```

## Model Comparison

```{r cluster}
# "doParallel"
cl <- makePSOCKcluster(3)
registerDoParallel(cl)
system.time({
  tb_fit <- train(province~., data = train, method="treebag", trControl=control,maxit = 5);
  bg_fit <- train(province~., data = train, method="gbm",trControl=control, tuneGrid = gbm_grid)
  rf_fit <- train(province~., data = train, method="rf", trControl=control,maxit = 5);
})
```

## doParallel

- I'd read more on doParallel
- [Here's the paper](https://cran.r-project.org/web/packages/doParallel/vignettes/gettingstartedParallel.pdf)
- I didn't dig into it too much but seems to run via docker.
- See if it's actually running on mulitple cores as follows:
```{r par}
getDoParWorkers()
```

## Results

- (You see why `rf` is popular - it works)

```{r stopcluster}
stopCluster(cl) # close multi-core cluster
rm(cl)

results <- resamples(list(Bagging=tb_fit, Boost=bg_fit, RForest=rf_fit))
summary(results)
```

## Takeaways

- Think critically, but often:
  - Use weights
  - Use LASSO or elastic net
  - Use random forest
