STATS 250 Lab 07

# STATS 250 Lab 07
## Simulation-Based Hypothesis Testing
### Nick Seewald<br />nseewald@umich.edu
### Week of 10/12/2020

---

# Reminders 💡

Your tasks for the week running Friday 10/9 - Friday 10/16:

| Task | Due Date | Submission |
|:-----|:---------|:-----------|
| **MIDTERM EXAM** | Thursday 10/15, any 2-hr window| **GRADESCOPE** |
| Lab 7 | Sunday 10/18 11:59PM ET | Canvas |

Modified office hours schedule this week due to midterm

---
# Homework 5 Comments
We'll address many of these in the next few slides, but:
1. Hypotheses are about *parameters*, involve specific *numeric values*, and must include *context*.
1. The *p-value* is different from `$p$` (population proportion) is different from `$\hat{p}$` (sample proportion).
1. Be specific when you talk about "extreme" values (also note these are not outliers): include the observed value *and* the direction.
1. A p-value of 0.02 is small.

---
# Learning Objectives

.pull-left[
### Statistical Learning Objectives
1. Get experience with randomization under an independence model
1. Explore hypothesis testing and p-values
]
.pull-right[
### R Learning Objectives
1. Learn how to perform simulations under an independence model
]

---
class: center, middle
# Weekly Advice

"Negative self-talk will only limit you."

---
# Setup

Follow along! Page 66 of *ISRS*; slides on Canvas or https://nickseewald.com/250fa20-slides/

How rational and consistent is the behavior of the typical American college student? Let's explore whether college student consumers always consider an obvious fact: money not spent now can be spent later.

**QUESTION**: Does reminding students about this fact cause them to be thriftier?

---
# Study

150 students recruited, each given the following statement:

> Imagine that you have been saving some extra money on the side to make some purchases, and on your most recent visit to the video store you come across a special sale on a new video. This video is one with your favorite actor or actress, and is of your favorite genre. This particular video that you are considering is one you have been thinking about buying for a long time. It is available for a special sale price of $14.99. What would you do in this situation?

<p style="font-size:14pt">(lol remember buying movies?)</p>

---
# Study

150 students split into two groups and given two options:

.pull-right[
### Treatment
- (A) Buy this entertaining video
- (B) Not buy this entertaining video. Keep the $14.99 for other purchases.
]

*Notice the reminder in the treatment group!*
---
# Hypothesis Statements 🤔

Two perspectives:
1. **Skeptic:** The reminder isn't going to work
1. **Believer:** The reminder will work: students in the treatment group will not buy the DVD more often than students in the control.

--
## Poll: null and alternative hypotheses

--
- `$H_0: \ p_{\mathrm{treatment}} = p_{\mathrm{control}}$`
- `$H_A: \ p_{\mathrm{treatment}} > p_{\mathrm{control}}$`

where `$p_{\mathrm{group}}$` is the proportion of students who *do NOT buy* the DVD in that group.

???
Really need to emphasize the directionality of the hypothesis is motivated by the question. AND that p is proportion of not-buy!

---
# Study Data (line ~68)
Read in the data from the study stored in `dvd.csv`. How do we do this?

???
Have students type in chat!
--

```r
dvd <- read.csv("dvd.csv", stringsAsFactors = TRUE)
```

Let's see what the data look like

```r
head(dvd)
```

```
    group decision
1 control  buy DVD
2 control  buy DVD
3 control  buy DVD
4 control  buy DVD
5 control  buy DVD
6 control  buy DVD
```

---
# Tabulating the Data

Let's make a two-way frequency table to better see the study results. How do we do this?

???
Have students type in chat!!

```r
addmargins(
  table(dvd$group, dvd$decision)
)
```

```
           
            buy DVD not buy DVD Sum
  control        56          19  75
  treatment      41          34  75
  Sum            97          53 150
```

---
# Tabulating the Data
We want to know how many students in each group didn't buy the DVD. Let's make a table of *row proportions*. Fill in the table in the lab file. (Zoom poll)

|           | buy DVD | not buy DVD | Total |
|:----------|:-------:|:-----------:|:-----:|
| control   |  0.747  |    0.253    | 1.000 |
| treatment |  0.547  |    0.453    | 1.000 |
| Total     |  0.647  |    0.353    | 1.000 |

---
# Tabulating the Data

What's the **observed** difference in proportions of students who didn't buy the DVD, `$\hat{p}_{\mathrm{trmt}} - \hat{p}_{\mathrm{ctrl}}$`?

--
`$$0.453 - 0.253 = 0.200$$`

--
**Is this difference "statistically significant?"**

---
# Simulation

### Big Idea
- Assume treatment status is independent of buying decision (i.e., that `$H_0$` is true). 
- Simulate this study many times
- See if our observed difference in proportions is "weird". 
- If "weird", this is evidence against the null hypothesis.

### In Practice
- Randomly shuffle buying decisions among treatment & control groups
- `sample_two_groups()`

---
# Simulation: A Single Replicate

```r
set.seed(106) # we just picked this number, it's not special.
```

```r
shuffle1 <- sample_two_groups(dvd)
table(shuffle1)
```

```
           decision
group       buy DVD not buy DVD
  control        55          20
  treatment      42          33
```

```r
rt <- rowTable(shuffle1) # we wrote this function for you

*rt[2, 2] - rt[1, 2]
```

```
[1] 0.1733333
```

---
# The `replicate()` function

- Sounds similar to `rep()` but **quite different**
  - `rep()` is copy/paste
  - `replicate()` re-runs code
  
Watch this:

```r
*rep(sample(1:20, size = 5), 3)
 [1] 11 18 20  8  4 11 18 20  8  4 11 18 20  8  4
*replicate(3, sample(1:20, size = 5))
     [,1] [,2] [,3]
[1,]   17   18    7
[2,]   19    5    3
[3,]    2    6   20
[4,]   12    9   17
[5,]   13   20   16
```

---
# The `replicate()` function

.pull-left[
### `rep()`
<img src="https://media.tenor.com/images/a6c56514d4a9fe52c6d050336b337dd2/tenor.gif" width=400/>
]
--
.pull-right[
### `replicate()`
<img src="https://media.tenor.com/images/b258eb5eb732409b15f271deb6e1bfff/tenor.gif" width=400/>
]
---
# Simulation
This code runs 2 simulations. Modify it to run 1000.

```r
pHatDiffs <- replicate(2, {
  shuffle <- sample_two_groups(dvd)
  shuffle_table <- rowTable(shuffle)
  shuffle_table[2, 2] - shuffle_table[1, 2] # p-hat_treatment minus p-hat_control
})
```

```r
*pHatDiffs <- replicate(1000, {
  shuffle <- sample_two_groups(dvd)
  shuffle_table <- rowTable(shuffle)
  shuffle_table[2, 2] - shuffle_table[1, 2] # p-hat_treatment minus p-hat_control
})
```

---
# Simulation Results

```r
hist(pHatDiffs, main = "Histogram of simulated results",
     xlab = "Simulated difference in proportions (tx - ctrl)",
     cex.lab = 1.5) #just for slides
*abline(v = 0.2, lwd = 4)
```

---
# Simulation Results: Approximate p-value
The p-value is the proportion of simulated results *as extreme or more extreme* than our observed result.
What does "extreme" mean?

--
.pull-left[
**Extreme** means *provides more evidence for the alternative hypothesis*. What will that mean here? (Zoom poll)
]
--
.pull-right[
<img src="lab07-slides-sync_files/figure-html/histShaded-1.png" style="display: block; margin: auto;" />
]
---
# Simulation Results: Approximate p-value

Let's count the number of simulations that led to a difference in proportions of 20% or greater:

```r
sum(pHatDiffs >= 0.2)
```

```
[1] 1
```

--
So the estimated p-value is 1/1000 = 0.001 = 0.1%.

### Poll
- Is our observed data rare?
- Is our null hypothesis reasonable?
- Does the reminder about using money later reduce spending now?

---
class: inverse
# Lab Project ⌨️

.pull-left[
### Your tasks
- Complete the "Try It!" and "Dive Deeper" portions of the lab assignment by copy/pasting and modifying appropriate code from earlier in the document.
- Introduce yourself to your collaborators
- **Do not leave people behind.**
]

.pull-right[
### How to get help
- Ask your collaborators -- share your screen!
- Use the "Ask for Help" button to flag me down.
]

---