Class Review

]

# Week 13: .fancy[Class Review]

### <svg aria-hidden="true" role="img" viewBox="0 0 512 512" style="height:1em;width:1em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:white;overflow:visible;position:relative;"><path d="M243.4 2.6l-224 96c-14 6-21.8 21-18.7 35.8S16.8 160 32 160v8c0 13.3 10.7 24 24 24H456c13.3 0 24-10.7 24-24v-8c15.2 0 28.3-10.7 31.3-25.6s-4.8-29.9-18.7-35.8l-224-96c-8-3.4-17.2-3.4-25.2 0zM128 224H64V420.3c-.6 .3-1.2 .7-1.8 1.1l-48 32c-11.7 7.8-17 22.4-12.9 35.9S17.9 512 32 512H480c14.1 0 26.5-9.2 30.6-22.7s-1.1-28.1-12.9-35.9l-48-32c-.6-.4-1.2-.7-1.8-1.1V224H384V416H344V224H280V416H232V224H168V416H128V224zM256 64a32 32 0 1 1 0 64 32 32 0 1 1 0-64z"/></svg> EMSE 6035: Marketing Analytics for Design Decisions
### <svg aria-hidden="true" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:white;overflow:visible;position:relative;"><path d="M304 128a80 80 0 1 0 -160 0 80 80 0 1 0 160 0zM96 128a128 128 0 1 1 256 0A128 128 0 1 1 96 128zM49.3 464H398.7c-8.9-63.3-63.3-112-129-112H178.3c-65.7 0-120.1 48.7-129 112zM0 482.3C0 383.8 79.8 304 178.3 304h91.4C368.2 304 448 383.8 448 482.3c0 16.4-13.3 29.7-29.7 29.7H29.7C13.3 512 0 498.7 0 482.3z"/></svg> John Paul Helveston
### <svg aria-hidden="true" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:white;overflow:visible;position:relative;"><path d="M152 24c0-13.3-10.7-24-24-24s-24 10.7-24 24V64H64C28.7 64 0 92.7 0 128v16 48V448c0 35.3 28.7 64 64 64H384c35.3 0 64-28.7 64-64V192 144 128c0-35.3-28.7-64-64-64H344V24c0-13.3-10.7-24-24-24s-24 10.7-24 24V64H152V24zM48 192H400V448c0 8.8-7.2 16-16 16H64c-8.8 0-16-7.2-16-16V192z"/></svg> November 20, 2024

]

---

# .center[Analysis]

## 1. Clean data 
## 2. Modeling

- Simple logit
- Mixed logit
- One sub-group model

## 3. Analysis

- WTP for key features
- Market simulation
- Sensitivity analysis

]

# .center[Report]

## 1. Introduction
## 2. Survey Design
## 3. Data Analysis
## 4. Results (plots / text)
## 5. Recommendations

]

---

# Final Presentation

## - In class, 12/11 (6:10 - 8:40)

## - 10 minutes (strict)

## - Slides due on Blackboard by midnight on 12/10

---

# Week 13: .fancy[Class Review]

### 1. Exam Review

### BREAK

### 2. Sensitivity Analysis

---

# Week 13: .fancy[Class Review]

### 1. .orange[Exam Review]

### BREAK

### 2. Sensitivity Analysis

---

## .center[Things I'm covering]

- Data wrangling in R 
- Utility models 
- Maximum likelihood estimation
- Optimization
- Uncertainty 
- Design of experiment
- WTP 
- Market simulations
- Sub-group models
- Using R for all of the above<br>(e.g., estimating models with `logitr`)

]

## .center[Things I'm **not** covering]

- surveydown
- Mixed logit

]

---

# Data wrangling in R

---

# Steps to importing external data files

## 1. Create a path to the data

``` r
library(here)
*path_to_data <- here('data', 'data.csv')
path_to_data
```

```
#> [1] "/Users/jhelvy/gh/teaching/MADD/2024-Fall/class/13-class-review/data/data.csv"
```

## 2. Import the data

``` r
library(tidyverse)
*data <- read_csv(path_to_data)
```

---

# Steps to importing external data files

``` r
library(tidyverse)

data <- read_csv(here::here('data', 'data.csv'))
```

---

# .center[The main `dplyr` "verbs"]

<br>

"Verb"        | What it does
--------------|--------------------
`select()`    | Select columns by name
`filter()`    | Keep rows that match criteria
`arrange()`   | Sort rows based on column(s)
`mutate()`    | Create new columns

---

# Example data frame

``` r
beatles <- tibble(
    firstName   = c("John", "Paul", "Ringo", "George"),
    lastName    = c("Lennon", "McCartney", "Starr", "Harrison"),
    instrument  = c("guitar", "bass", "drums", "guitar"),
    yearOfBirth = c(1940, 1942, 1940, 1943),
    deceased    = c(TRUE, FALSE, FALSE, TRUE)
)

beatles
```

```
#> # A tibble: 4 × 5
#>   firstName lastName  instrument yearOfBirth deceased
#>   <chr>     <chr>     <chr>            <dbl> <lgl>   
#> 1 John      Lennon    guitar            1940 TRUE    
#> 2 Paul      McCartney bass              1942 FALSE   
#> 3 Ringo     Starr     drums             1940 FALSE   
#> 4 George    Harrison  guitar            1943 TRUE
```

---

# `filter()` and `select()`:

Get the **first & last name** of members born after 1941 & are still living

``` r
beatles %>% 
  filter(yearOfBirth > 1941, deceased == FALSE) %>% 
  select(firstName, lastName)
```

```
#> # A tibble: 1 × 2
#>   firstName lastName 
#>   <chr>     <chr>    
#> 1 Paul      McCartney
```

---

# Create new variables with `mutate()`

Use the `yearOfBirth` variable to compute the age of each band member

``` r
beatles %>%
    mutate(age = 2022 - yearOfBirth) %>%
    arrange(age)
```

```
#> # A tibble: 4 × 6
#>   firstName lastName  instrument yearOfBirth deceased   age
#>   <chr>     <chr>     <chr>            <dbl> <lgl>    <dbl>
#> 1 George    Harrison  guitar            1943 TRUE        79
#> 2 Paul      McCartney bass              1942 FALSE       80
#> 3 John      Lennon    guitar            1940 TRUE        82
#> 4 Ringo     Starr     drums             1940 FALSE       82
```

---

# .center[Handling if/else conditions]

### .center[`ifelse(<condition>, <if TRUE>, <else>)`]

``` r
beatles %>%
    mutate(playsGuitar = ifelse(instrument == "guitar", TRUE, FALSE))
```

```
#> # A tibble: 4 × 6
#>   firstName lastName  instrument yearOfBirth deceased playsGuitar
#>   <chr>     <chr>     <chr>            <dbl> <lgl>    <lgl>      
#> 1 John      Lennon    guitar            1940 TRUE     TRUE       
#> 2 Paul      McCartney bass              1942 FALSE    FALSE      
#> 3 Ringo     Starr     drums             1940 FALSE    FALSE      
#> 4 George    Harrison  guitar            1943 TRUE     TRUE
```

---

# Utility models

---

# Random utility model

<br>

## The utility for alternative `$j$` is
# `$$\tilde{u}_j = v_j + \tilde{\varepsilon}_j$$`

## `$v_j$` = Things we observe (non-random variables)
## `$\tilde{\varepsilon}_j$` = Things we _don't_ observe (random variable)

---

## **Logit model**: Assume that `$\tilde{\varepsilon}_j$` ~ [Gumbel Distribution](https://en.wikipedia.org/wiki/Gumbel_distribution)

## `$$\tilde{u}_j = v_j + \tilde{\varepsilon}_j$$`

]

## Probability of choosing alternative `$j$`:

# `$$P_j = \frac{e^{v_j}}{\sum_k{e^{v_k}}}$$`

]

---

#.center[Notation Convention]

## Continuous: `$x_j$`

## `$$u_j = \beta_1 x_{j}^{\mathrm{price}} + \dots$$`

```
#>   price
#> 1     1
#> 2     2
#> 3     3
```

]

## Discrete: `$\delta_j$`

## `$$u_j = \beta_1 \delta_{j}^{\mathrm{ford}} + \beta_2 \delta_{j}^{\mathrm{gm}} \dots$$`

```
#>   brand brand_BMW brand_Ford brand_GM
#> 1  Ford         0          1        0
#> 2    GM         0          0        1
#> 3   BMW         1          0        0
```

]

---

# .center[Dummy-coded variables]

Data frame with one variable: _brand_

``` r
data <- data.frame(
    brand = c("Ford", "GM", "BMW"))

data
```

```
#>   brand
#> 1  Ford
#> 2    GM
#> 3   BMW
```

]

Add dummy columns for each brand

``` r
library(fastDummies)

dummy_cols(data, "brand")
```

```
#>   brand brand_BMW brand_Ford brand_GM
#> 1  Ford         0          1        0
#> 2    GM         0          0        1
#> 3   BMW         1          0        0
```

]

---

### Modeling _continuous_ variable

`$v_j = \beta_1 x^\mathrm{price}$`

]

``` r
model <- logitr(
    data   = data,
    choice = "choice",
    obsID  = "obsID",
    pars   = "price"
)
```

<br>

Coef. | Interpretation
------|------------------
β1 | how utility changes with increasing _price_

]

### Modeling _discrete_ variable

`$v_j = \beta_1 \delta_{j}^{\mathrm{ford}} + \beta_2 \delta_{j}^{\mathrm{gm}}$`

]

``` r
model <- logitr(
    data   = data,
    choice = "choice",
    obsID  = "obsID",
    pars   = c("brand_Ford", "brand_GM")
)
```

Coef. | Interpretation
------|------------------
β1 | utility for _Ford_ relative to _BMW_
β2 | utility for _GM_ relative to _BMW_

]

---

# .center[Estimating utility models]

<br>

## 1. Open `logitr-cars.Rproj`

## 2. Open `code/3.1-model-mnl.R`

]

---

# `mnl_dummy`

All discrete (dummy-code) variables

``` r
pars = c(
  "price_20", "price_25",
  "fuelEconomy_25", "fuelEconomy_30",
  "accelTime_7", "accelTime_8",
  "powertrain_Electric")
```

Reference Levels:

- Price: 15
- Fuel Economy: 20
- Accel. Time: 6
- Powertrain: "Gasoline"

]

# `mnl_linear`

All continuous (linear), except for `powertrain_Electric`

``` r
pars = c(
  'price', 'fuelEconomy', 'accelTime', 
  'powertrain_Electric')
```

Reference Levels:

- Powertrain: "Gasoline"

]

---

# Practice Question 1

Let's say our utility function is:

.font80[$$v_j = \beta_1 x_j^{\mathrm{price}} + \beta_2 x_j^{\mathrm{cacao}} + \beta_3 \delta_j^{\mathrm{hershey}} + \beta_4 \delta_j^{\mathrm{lindt}}$$]

And we estimate the following coefficients:

Parameter | Coefficient 
----------|-----------
`$\beta_1$` | -0.1
`$\beta_2$` | 0.1
`$\beta_3$` | -2.0
`$\beta_4$` | -0.1

]

What are the expected probabilities of choosing each of these bars using a logit model?

<table class="table table-hover table-condensed" style="color: black; width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;color: white !important;"> Attribute </th>
   <th style="text-align:left;color: white !important;"> Bar 1 </th>
   <th style="text-align:left;color: white !important;"> Bar 2 </th>
   <th style="text-align:left;color: white !important;"> Bar 3 </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;color: white !important;"> Price </td>
   <td style="text-align:left;color: white !important;"> $1.20 </td>
   <td style="text-align:left;color: white !important;"> $1.50 </td>
   <td style="text-align:left;color: white !important;"> $3.00 </td>
  </tr>
  <tr>
   <td style="text-align:left;color: white !important;"> % Cacao </td>
   <td style="text-align:left;color: white !important;"> 10% </td>
   <td style="text-align:left;color: white !important;"> 60% </td>
   <td style="text-align:left;color: white !important;"> 80% </td>
  </tr>
  <tr>
   <td style="text-align:left;color: white !important;"> Brand </td>
   <td style="text-align:left;color: white !important;"> Hershey </td>
   <td style="text-align:left;color: white !important;"> Lindt </td>
   <td style="text-align:left;color: white !important;"> Ghirardelli </td>
  </tr>
</tbody>
</table>

]

---

# Maximum likelihood estimation

---

background-color: #EEEDEE

# Maximum likelihood estimation

---

background-color: #EEEDEE

## .center[Computing the likelihood]

]

`$x$`: an observation

`$f(x)$`: probability of observing `$x$`

]

---

background-color: #EEEDEE

## .center[Computing the likelihood]

]

`$x$`: an observation

`$f(x)$`: probability of observing `$x$`

`$\mathcal{L}(\theta | x)$`: probability that `$\theta$` are the true parameters, given that observed `$x$`

`$\mathcal{L}(\theta | x) = f(x_1) f(x_2) \dots f(x_n)$`

Log-likelihood converts multiplication to summation:

`$\ln \mathcal{L}(\theta | x) = \ln f(x_1) + \ln f(x_2) \dots \ln f(x_n)$`

]

---

# Practice Question 2

**Observations** - Height of students (inches):

```
#>  [1] 65 69 66 67 68 72 68 69 63 70
```

a) Let's say we know that the height of students, `$\tilde{x}$`, in a classroom follows a normal distribution. A professor obtains the above height measurements students in her classroom. What is the log-likelihood that `$\tilde{x} \sim \mathcal{N} (68, 4)$`? In other words, compute `$\ln \mathcal{L} (\mu = 68, \sigma = 4)$`.

b) Compute the log-likelihood function using the same standard deviation `$(\sigma = 4)$` but with the following different values for the mean, `$\mu: 66, 67, 68, 69, 70$`. How do the results compare? Which value for `$\mu$` produces the highest log-likelihood?

---

# Optimization

---

background-color: #EEEDEE
class: center, middle

## Optimality conditions

]

]

---

background-color: #EEEDEE

---

# Uncertainty

---

background-color: #EEEDEE

---

background-color: #EEEDEE

## The _curvature_ of the log-likelihood function is<br>inversely related to the hessian

---

background-color: #EEEDEE
class: middle, center

## The _curvature_ of the log-likelihood function is<br>inversely related to the hessian

---

background-color: #EEEDEE
class: middle, center

### Usually report parameter uncertainty ("standard errors") with `$\sigma$` values

---

## .center[Two approaches for obtaining confidence interval]

## Using Standard Errors

1. Get coefficients, `beta`
2. Get covariance matrix, `covariance` 
3. `se <- sqrt(diag(covariance))`
4. `coef_ci <- c(beta - 2*se, beta + 2*se)`

## Using Simulated Draws

1. Get coefficients, `beta`
2. Get covariance matrix, `covariance`  
3. `draws <- as.data.frame(MASS::mvrnorm(10^5, beta, covariance))`
4. `coef_ci <- logitr::ci(draws, ci = 0.95)`

---

## In-class example

``` r
# 1. Get coefficients
beta <- c(
    price = -0.7, mpg = 0.1, elec = -4.0)

# 2. Get covariance matrix
hessian <- matrix(c(
    -6000,   50,   60,
       50, -700,   50,
       60,   50, -300),
    ncol = 3, byrow = TRUE)

covariance <- -1*solve(hessian)
```

]

## Model from `logitr`

``` r
beta <- coef(model)
covariance <- vcov(model)
```

]

---

# Practice Question 3

Suppose we estimate the following utility model describing preferences for cars:

$$
u_j = \alpha p_j + \beta_1 x_j^{mpg} + \beta_2 x_j^{elec} + \varepsilon_j
$$

Compute a 95% confidence interval around the coefficients using:

a) Standard errors 
b) Simulated draws

]

The estimated model produces the following results:

Parameter | Coefficient
----------|------------
`$\alpha$` | -0.7
`$\beta_1$` | 0.1
`$\beta_2$` | -0.4

Hessian:

$$
`\begin{bmatrix}
-6000 & 50 & 60
\\ 
50 & -700 & 50
\\
60 & 50 & -300
\end{bmatrix}`
$$

]

---

# Design of experiment

---

# .center[Wine Pairings Example]

meat | wine
-----|------
fish | white 
fish | red
steak | white 
steak | red

]

## Main Effects

1. **Fish** or **Steak**?
2. **Red** or **White** wine?

## Interaction Effects

1. **Red** or **White** wine _with **Steak**_?
2. **Red** or **White** wine _with **Fish**_?

]

---

## "D-optimal" designs maximize **main** effect information<br>but confound **interaction** effect information

## `$$D = \left( \frac{|\boldsymbol{I}(\boldsymbol{\beta})|}{n^p} \right)^{1/p}$$`

where `$p$` is the number of coefficients in the model and `$n$` is the total sample size

---

# WTP

---

## Willingness to Pay (WTP)

<br>

## `$$\tilde{u}_j = \alpha p_j + \boldsymbol{\beta} x_j + \tilde{\varepsilon_j}$$`

<br>

## `$$\boldsymbol{\omega} = \frac{\boldsymbol{\beta}}{-\alpha}$$`

---

# .center[Computing WTP with draws]

## `$$\hat{\boldsymbol{\omega}} = \frac{\hat{\boldsymbol{\beta}}}{-\hat{\alpha}}$$`

``` r
draws_other <- draws[,2:ncol(draws)]
draws_price <- draws[,1]
draws_wtp <- draws_other / (-1*draws_price)
head(draws_wtp)
```

```
#>            [,1]      [,2]
#> [1,] 0.15163378 -5.792115
#> [2,] 0.05229627 -5.787045
#> [3,] 0.19799856 -5.733336
#> [4,] 0.16430861 -5.896579
#> [5,] 0.14244970 -5.902599
#> [6,] 0.18188999 -5.603616
```

]

Mean WTP with confidence interval

``` r
logitr::ci(draws_wtp)
```

```
#>         mean       lower      upper
#> 1  0.1425029  0.03437082  0.2501002
#> 2 -5.7179075 -5.97984555 -5.4692005
```

]

---

## Willingness to Pay (WTP)

## "Preference Space"

## `$$\tilde{u}_j = \alpha p_j + \boldsymbol{\beta} x_j + \tilde{\varepsilon_j}$$`

]

## "WTP Space"

## `$$\boldsymbol{\omega} = \frac{\boldsymbol{\beta}}{-\alpha}$$`
## `$$\lambda = - \alpha$$`
## `$$\tilde{u}_j = \lambda (\boldsymbol{\omega} x_j - p_j) + \tilde{\varepsilon_j}$$`

]

---

# WTP space models have non-convex<br>log-likelihood functions!

<br>

# **Use multi-start loop with<br>random starting points**

---

# Market simulations

---

# .center[Simulate Market Shares]

## 1. Define a market, `$X$`

## 2. Compute shares:

## `$$\hat{P}_j = \frac{e^{\hat{\boldsymbol{\beta}}'\boldsymbol{X}_j}}{\sum_{k=1}^J e^{\hat{\boldsymbol{\beta}}'\boldsymbol{X}_k}}$$`

---

background-color: #EEEDEE

# .center[Simulate Market Shares]

---

background-color: #EEEDEE

# .center[Simulate Market Shares]

]

In R:

``` r
X %*% beta
```

]

---

# .center[Simulating Market Shares **with Uncertainty**]

Rely on the `predict()` function to compute shares with uncertainty.

Internally, it:

1. Takes draws of `$\boldsymbol{\beta}$`
2. Computes `$P_j$` for each draw 
3. Returns mean and confidence interval computed from draws

---

# Review the `logitr-cars` examples

---

# .fancy[Break]

---

# Week 13: .fancy[Class Review]

### 1. Exam Review

### BREAK

### 2. .orange[Sensitivity Analysis]

---

### .center[**Market share** sensitivity to price]

]

### .center[**Revenue** sensitivity to price]

<center>
<img src="images/rev_price_plot.png" width=100%>
</center>
`$$R = Q*P$$`

]

---

### .center[**Market share** sensitivity to price]

]

### .center[**Observations**]

- Solid line reflects _interpolation_ (attribute range in survey)
- Dashed line reflects _extrapolation_ (beyond attribute range in survey)
- Ribbon reflects _parameter uncertainty_

]

---

## .center[Market share sensitivity to all attributes]

---

### .center[Market share sensitivity to all attributes]

]

### .center[**Observations**]

- Middle point reflects baseline market share: 
    - **Price**: $25,000 
    - **Fuel Economy**: 100 mpg 
    - **0-60 mph Accel. time**: 6 sec
    
- Boundaries on each attribute should reflect max feasible attribute bounds

]

---

# .center[Sensitivity analyses]

<br>

## 1. Open `logitr-cars`

## 2. Open `code/9.1-compute-sensitivity.R`
## 3. Open `code/9.2-plot-sensitivity.R`

---

## Your Turn

### As a team:

- Read in and clean your final data. 
- Estimate a baseline model. 
- Set your baseline market simulation case. 
- Compute sensitivities to price and other attributes.

]]