---
title: "16 Economic Decisions"
format:
  html:
    self-contained: TRUE
---

In this assignment, we'll move beyond asking whether a model is *accurate*. Instead, we'll think about **prediction as an economic decision problem**. A lender must weigh the costs of approving risky borrowers against the costs of turning away reliable borrowers, meaning the optimal decision rule depends on the economic environment and the tradeoffs the lender faces.

Here's the plan for today:

- Fit a random forest model
- Evaluate confusion matrices at different thresholds
- Assign economic costs to different types of mistakes
- Design a profit-maximizing lending rule

```{r, echo = F, message = F, warning = F}
# Run this to get started:
library(tidyverse)
library(randomForest)

# You may need to change the file path (this one is for macs)
mortgage <- read_csv("~/Downloads/county_06065.csv") %>%
  filter(
    business_or_commercial_purpose == 2,
    total_units == 1,
    derived_dwelling_category == "Single Family (1-4 Units):Site-Built",
    action_taken %in% c(1, 2, 3),
    income > 0,
    income < 600,
    loan_amount < 1500000
  ) %>%
  mutate(
    approved = if_else(action_taken %in% c(1, 2), 1, 0),
    loan_purpose = recode(
      loan_purpose,
      `1`  = "Home purchase",
      `2`  = "Home improvement",
      `31` = "Refinance",
      `32` = "Cash-out refinance",
      `4`  = "Other"
    ),
    loan_type = recode(
      loan_type,
      `1` = "Conventional",
      `2` = "FHA",
      `3` = "VA",
      `4` = "USDA/FSA"
    ),
    debt_to_income_ratio = case_when(
      debt_to_income_ratio == "<20%"     ~ 15,
      debt_to_income_ratio == "20%-<30%" ~ 25,
      debt_to_income_ratio == "30%-<36%" ~ 33,
      debt_to_income_ratio == "50%-60%"  ~ 55,
      debt_to_income_ratio == ">60%"     ~ 65,
      debt_to_income_ratio %in% as.character(36:49) ~ 
        as.numeric(debt_to_income_ratio)
    ),
    loan_amount = loan_amount / 1000,
    property_value = as.numeric(property_value) / 1000,
    loan_to_value_ratio = as.numeric(loan_to_value_ratio),
    bad_credit = if_else(`denial_reason-1` == 3, 1, 0),
    loan_type = fct_relevel(factor(loan_type), "Conventional"),
    loan_purpose = fct_relevel(factor(loan_purpose), "Home purchase"),
    conforming_loan_limit = fct_relevel(factor(conforming_loan_limit), "C")
  ) %>%
  select(approved, income, debt_to_income_ratio, loan_amount,
    loan_type, loan_purpose, loan_to_value_ratio,
    conforming_loan_limit, property_value, bad_credit
  ) %>%
  drop_na() %>%
  distinct() %>%
  filter(
    property_value < 2000,
    loan_to_value_ratio <= 100
  )
```

## Part 1: Fit a Random Forest

```{r}
# Question #1: Write the code necessary to split `mortgage` into
# a training set (80%) and a test set (20%).

set.seed(1234)

mortgage <- mortgage %>% 
  mutate(train = sample(________))

mortgage_train <- mortgage %>% filter(________)
mortgage_test <- mortgage %>% filter(________)

# Now we'll fit the random forest, averaging over 500 trees and
# trying 3 random predictors at each node in each tree.

mortgage_rf <- randomForest(
  factor(approved) ~ .,
  data = mortgage_train,
  ntree = 500,
  mtry = 3
)

# Add Random Forest predictions to the mortgage_test data:
mortgage_predictions <- mortgage_test %>%
  mutate(
    prediction = predict(
      mortgage_rf,
      newdata = mortgage_test,
      type = "prob"
    )[, 2]
  )

# Question #2: What is the accuracy of these predictions? What do you need
# to do before being able to assess this?

mortgage_predictions %>% 
  ________
```

## Part 2: Confusion Matrices

Use this `confusion()` helper:

```{r}
confusion <- function(data, threshold) {
  data %>%
    mutate(
      classifier = if_else(prediction >= threshold, 1, 0)
    ) %>%
    drop_na(classifier) %>%
    summarise(
      TP = sum(approved == 1 & classifier == 1),
      TN = sum(approved == 0 & classifier == 0),
      FP = sum(approved == 0 & classifier == 1),
      FN = sum(approved == 1 & classifier == 0)
    ) %>%
    mutate(
      accuracy = (TP + TN) / (TP + TN + FN + FP),
      threshold = threshold
    )
}

# Question #3: Use `confusion` to evaluate the model at a few different
# thresholds. What threshold maximizes the accuracy of the model?

map(
  .x = seq(0, 1, by = .1),
  .f = ________
) %>%
  bind_rows() %>%
  arrange(desc(accuracy))

# Question #4: Define TP, TN, FP, and FN:
# TP: (good/bad) applicants are (approved/denied)
# TN: (good/bad) applicants are (approved/denied)
# FP: (good/bad) applicants are (approved/denied)
# FN: (good/bad) applicants are (approved/denied)
```

**Question #5:** Suppose the lending company is losing too much money on people who are defaulting. This is a problem with having too many (FP/FN). The solution is to (raise/lower) the threshold.

**Question #6:** Suppose the lending company is losing too much business by denying too many applications. This is a problem with having too many (FP/FN). The solution is to (raise/lower) the threshold.

## Part 3: Economic Costs of Mistakes

Not all mistakes are equally costly.

**Question 7:** Suppose your company's current threshold is 0.6, and your company wants to grow the business by reducing the threshold to 0.55. By doing so, you estimate you'll have 69 fewer false negatives, but 73 more false positives.

  - If a false positive costs the same amount as a false negative, will your company raise profits by reducing the threshold?
  - If a false positive costs double the amount as a false negative, will your company raise profits by reducing the threshold?
  - If a false negative costs double the amount as a false positive, will your company raise profits by reducing the threshold?

```{r}
# Question 8: fill in the blanks below to write a `cost` function
# that takes data with predictions, a threshold, a cost for a false
# positive, and a cost for a false negative, and then returns the
# total cost.

cost <- function(data, threshold, fp_cost, fn_cost) {
  data %>%
    mutate(
      classifier = if_else(prediction >= threshold, 1, 0)
    ) %>%
    drop_na(classifier) %>%
    summarise(
      FP = sum(approved == 0 & classifier == 1),
      FN = sum(approved == 1 & classifier == 0)
    ) %>%
    mutate(
      total_cost = ________ + ________,
      threshold = threshold
    )
}

# Test the function:
cost(mortgage_predictions, threshold = 0.6, fp_cost = 400, fn_cost = 50)

# Question 9: If a false positive costs $400K and a false
# negative costs $50K, find the profit maximizing 
# (cost-minimizing) threshold.

map(
  .x = seq(0, 1, by = .01),
  .f = ________
) %>%
  bind_rows() %>%
  ggplot(aes(x = threshold, y = total_cost)) +
  geom_line()
```

## Part 4: Designing a Lending Policy

Different lenders face different incentives: a conservative lender may care much more about defaults while a growth-focused lender may care more about approving additional borrowers.

**Question 10:** Hold the cost of a false positive steady at \$100K and find the cost minimizing threshold for every possible cost of a false negative between \$0 and \$500K. Plot the cost of a false negative on the x-axis and your recommended threshold on the y-axis. As the cost of a false negative increases, your recommended threshold should (increase/decrease) because __________.

```{r}
map(
  .x = seq(0, 500, by = 10),
  .f = function(fn) {
    map(
      .x = seq(0, 1, by = .01),
      .f = ________
      ) %>%
      bind_rows() %>%
      arrange(________) %>%
      slice(________) %>%
      mutate(fn_cost = fn)
  }
) %>%
  bind_rows() %>%
  ggplot(aes(x = fn_cost, y = threshold)) +
  geom_line()
```

## Part 5: Split by Loan Type

So far, we've treated all borrowers as if they belong to the same lending market. But in reality, different types of loans attract different borrowers and create different incentives for lenders. 

There's a variable in our data set `loan_type`, which takes on "Conventional", "FHA", and "VA" with plenty of observations in each category:

```{r}
mortgage %>%
  count(loan_type)
```

Let's fit separate random forests for each of these three loan types. Then find the accuracy-maximizing threshold for each market. 

This represents our best guess at how current lenders are weighing their economic decisions with respect to each of these groups of borrowers. Let's explore: how do the accuracy-maximizing thresholds differ across lending environments?

```{r}
# Question 11: Take conventional loans, fit a random forest,
# and find the threshold which maximizes accuracy. If there are
# ties (many thresholds maximize accuracy), take the average
# of those thresholds.

mortgage_train_conventional <- mortgage %>% filter(loan_type == "Conventional", train == 1)
mortgage_test_conventional <- mortgage %>% filter(loan_type == "Conventional", train == 0)

mortgage_rf_conventional <- randomForest(
  factor(approved) ~ .,
  data = mortgage_train_conventional,
  ntree = 500,
  mtry = 3
)

mortgage_predictions_conventional <- mortgage_test_conventional %>%
  mutate(
    prediction = predict(
      mortgage_rf_conventional,
      newdata = mortgage_test_conventional,
      type = "prob"
    )[, 2]
  )

map(
  .x = ________,
  .f = ________
    ) %>%
  bind_rows() %>%
  slice_max(accuracy) %>%
  summarize(mean(threshold))

# conventional: best accuracy = ____
```

```{r}
# Question 12: Take FHA loans, fit a random forest,
# and find the threshold which maximizes accuracy for this market.


```

```{r}
# Question 13: Take VA loans, fit a random forest,
# and find the threshold which maximizes accuracy for this market.


```

Here's some more information about each of these loan types:

- Conventional: these loans are typically backed by private lenders and often go to borrowers with stronger financial profiles.
- FHA (Federal Housing Administration): these loans are government-insured and designed to expand access to homeownership, especially for borrowers with lower income, lower credit scores, or smaller down payments.
- VA (Department of Veterans Affairs): these loans are designed for veterans and military families and are government-backed. Borrowers often qualify for low or even zero down payments.

**Question 14:** Given this information, do the differences in thresholds make sense because of differences in the typical borrower, or differences in the incentives that lenders face? Explain.