---
title: "Session 5 R practice"
author: "Dr. Richard M. Crowley"
date: "ACCT 420, Session 5"
output:
  html_document:
    theme: spacelab
    highlight: default
    toc: true
    toc_float:
      collapsed: false
    self_contained: false
---

```{r, include=FALSE}
tutorial::go_interactive()
```

## Logistic models and ROC

To run your code, click *run*.  It will let you know if your code is correct or not, and will offer hints on what to fix if needed.  If you are stuck, you can see the solution by clicking *Solution*.

### Exercise 1: Running a logit regression

This is a continuation of Session_4's exercises.

```{r ex="create_b", type="pre-exercise-code"}
library(dplyr) # loads dplyr for data manipulation
df <- data.frame(tic=rep("WMT",194),
                 fyearq=c(1970,1970,1970,1970,1971,1971,1971,1971,1972,1972,1972,1972,1973,1973,1973,1973,1974,1974,1974,1974,1975,1975,1975,1975,1976,1976,1976,1976,1977,1977,1977,1977,1978,1978,1978,1978,1979,1979,1979,1979,1980,1980,1980,1980,1981,1981,1981,1981,1982,1982,1982,1982,1983,1983,1983,1983,1984,1984,1984,1984,1985,1985,1985,1985,1986,1986,1986,1986,1987,1987,1987,1987,1988,1988,1988,1988,1989,1989,1989,1989,1990,1990,1990,1990,1991,1991,1991,1991,1992,1992,1992,1992,1993,1993,1993,1993,1994,1994,1994,1994,1995,1995,1995,1995,1996,1996,1996,1996,1997,1997,1997,1997,1998,1998,1998,1998,1999,1999,1999,1999,2000,2000,2000,2000,2001,2001,2001,2001,2002,2002,2002,2002,2003,2003,2003,2003,2004,2004,2004,2004,2005,2005,2005,2005,2006,2006,2006,2006,2007,2007,2007,2007,2008,2008,2008,2008,2009,2009,2009,2009,2010,2010,2010,2010,2011,2011,2011,2011,2012,2012,2012,2012,2013,2013,2013,2013,2014,2014,2014,2014,2015,2015,2015,2015,2016,2016,2016,2016,2017,2017,2017,2017,2018,2018),
                 fqtr=c(1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2),
                 revtq=c(7.267,9.939,11.47,15.61,12.758,18.207,19.205,27.844,21.011,29.918,32.683,41.277,32.737,37.655,42.098,55.071,46.355,56.177,59.462,74.215,64.65,78.852,86.108,110.721,93.971,115.186,121.875,147.775,122.655,152.381,172.637,230.783,167.274,204.085,221.982,306.957,238.569,291.685,300.747,417.175,314.575,372.598,401.842,554.184,434.251,533.653,634.476,842.617,665.229,788.705,827.767,1094.551,854.734,1098.942,1166.594,1546.639,1234.768,1508.533,1583.573,2073.983,1655.661,1934.358,2087.533,2773.936,2344.253,2770.276,2949.008,3845.557,3211.761,3732.237,4015.017,5000.238,4282.012,4845.133,4991.113,6530.734,5373.258,6046.41,6283.496,8107.484,6768.191,7543.508,7930.949,10358.898,9280.566,10339.898,10627.5,13638.797,11649.398,13028.398,13683.797,17122,13920.398,16236.5,16826.898,20360.5,17686.098,19942.297,20417.699,24447.797,20440,22723,22914,27550,22772,25587,25644,30856,25409,28386,28777,35386,29819,33521,33509,40785,35129,38913,40899,51868,43447,46588,46181,57079,48565,53187,53185,64735,52126,56781,55765,66905,57224,63231,63036,75190,65434,70516,69282,82900,70755,76697,75397,89252,79675,85430,84467,99078,86378,92827,91794,107289,94940,102342,98345,108747,94214,100876,99373,113622,99811,103726,101952,116360,104189,109366,110226,123169,113010,114065,113800,127776,114070,116830,115688,129706,114960,120125,119001,131565,114826,120229,117408,129667,115904,120319,118179,130936,117542,122968,123179,136267,122690,128028),
                 recession=c(1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
df <- df %>% mutate(revtq_yoy = (revtq - lag(revtq, 4)) / lag(revtq, 4),
                    recession_lag = lag(recession),
                    revtq_down = factor(ifelse(revtq_yoy<0,1,0), levels=c(0,1)),
                    revtq_yoy_lag = lag(revtq_yoy),
                    date = fyearq + (fqtr-1)/4)

```

```{r ex="create_b", type="sample-code"}
# The dataframe below contains historical revenue for Walmart since 1970
# All data is quarterly
# The file uses Compustat's nomenclature:
#     - revenue is revtq
#     - ticker is tic
#     - fyearq is year
#     - fqtr is quarter
#     - recession is an indicator for US recessions
#     - revtq_yoy is year over year revenue growth
#     - revtq_down is an indicator equal to 1 if revtq_yoy is negative, else 0
#     - revtq_yoy_lag is the lag of revtq_yoy
df[1:5,]

# Calculate a logistic model of a decrease in year over year quarterly revenue
# on the previous quarter's year over year revenue growth, store it in mod1
mod1 <- glm( ~ , data=, family=)

# Print out a summary of the model using summary
summary(mod1)

#END
```

```{r ex="create_b", type="solution"}
# The dataframe below contains historical revenue for Walmart since 1970
# All data is quarterly
# The file uses Compustat's nomenclature:
#     - revenue is revtq
#     - ticker is tic
#     - fyearq is year
#     - fqtr is quarter
#     - recession is an indicator for US recessions
#     - revtq_yoy is year over year revenue growth
#     - revtq_down is an indicator equal to 1 if revtq_yoy is negative, else 0
#     - revtq_yoy_lag is the lag of revtq_yoy
df[1:5,]

# Calculate a logistic model of a decrease in year over year quarterly revenue
# on the previous quarter's year over year revenue growth, store it in mod1
mod1 <- glm(revtq_down ~ revtq_yoy_lag, data=df, family=binomial)

# Print out a summary of the model using summary
summary(mod1)

#END
```

```{r ex="create_b", type="sct"}
# Template based on https://www.rdocumentation.org/packages/testwhat/versions/4.1.1
# Check if something is explicitly typed

test_student_typed('revtq_down ~ revtq_yoy_lag',not_typed_msg='Make sure to regress `revtq_down` on `revtq_yoy_lag`.')
test_student_typed('data=df',not_typed_msg='Make sure to using the `df` data frame for the test.')
test_student_typed('family=binomial',not_typed_msg='Make sure to set family to be `binomial`, so as to run a logistic regression.')
test_expression_output("mod1", incorrect_msg="Your regression model isn't quite right.")
test_student_typed('summary(mod1)',not_typed_msg='Your model is correct, but did you remember to summarize it with `summary()`?')

# test_student_typed('x <- 2', not_typed_msg='')

# Check if function was used in input code
# test_function('c',incorrect_msg='')  

# Requires an object `x` to have the same value as the solution
# test_object("x",incorrect_msg = "",undefined_msg = "")  

# Requires an onject with the same value of `x` in the solution
# test_an_object("x",undefined_msg="")

# Checks if output of student's code contains given evaluated expression
# test_output_contains("x",incorrect_msg = "")

# Check if a vector of predefined objects are unchanged
# test_predefined_objects(c('x','y'),incorrect_msg="Don't onverwrite the predefined variables")

# Checks for a regex pattern in trhe output
# test_output_regex(pattern,fixed=F, times=1, incorrect_msg='')

# Can check an arbitrary expression across both solution and student code
#test_expression_output("typeof(company_name)", incorrect_msg="Did you store textual data in `company_name`?")

test_error()
success_msg("Awesome!")

# Other functions to note:
#     - test_or(a,b) -- checks if either test a or test b pass
#     - test_ggplot() -- can check if plots are correct
#     - test_function() -- can also check included parameters
#     - test_loop() -- checking for and while loops
#     - test_library_function('package', not_called_msg='',incorrect_msg='')
#     - test_if_else() -- checking if statements
#     - test_expression_error() -- can check if functions are properly defined
#     - test_operator('operator',), not_called_msg='',incorrect_msg='')
#     - test_function_definition() -- rigorously check defined function
#     - test_data_frame() -- check if dataframe [columns] are equivalent
#     - test_function_result, test_expression_result
```

### Exercise 2: Exploring model predictions

```{r ex="create_c", type="pre-exercise-code"}
library(dplyr) # loads dplyr for data manipulation
library(ggplot2)
df <- data.frame(tic=rep("WMT",194),
                 fyearq=c(1970,1970,1970,1970,1971,1971,1971,1971,1972,1972,1972,1972,1973,1973,1973,1973,1974,1974,1974,1974,1975,1975,1975,1975,1976,1976,1976,1976,1977,1977,1977,1977,1978,1978,1978,1978,1979,1979,1979,1979,1980,1980,1980,1980,1981,1981,1981,1981,1982,1982,1982,1982,1983,1983,1983,1983,1984,1984,1984,1984,1985,1985,1985,1985,1986,1986,1986,1986,1987,1987,1987,1987,1988,1988,1988,1988,1989,1989,1989,1989,1990,1990,1990,1990,1991,1991,1991,1991,1992,1992,1992,1992,1993,1993,1993,1993,1994,1994,1994,1994,1995,1995,1995,1995,1996,1996,1996,1996,1997,1997,1997,1997,1998,1998,1998,1998,1999,1999,1999,1999,2000,2000,2000,2000,2001,2001,2001,2001,2002,2002,2002,2002,2003,2003,2003,2003,2004,2004,2004,2004,2005,2005,2005,2005,2006,2006,2006,2006,2007,2007,2007,2007,2008,2008,2008,2008,2009,2009,2009,2009,2010,2010,2010,2010,2011,2011,2011,2011,2012,2012,2012,2012,2013,2013,2013,2013,2014,2014,2014,2014,2015,2015,2015,2015,2016,2016,2016,2016,2017,2017,2017,2017,2018,2018),
                 fqtr=c(1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2),
                 revtq=c(7.267,9.939,11.47,15.61,12.758,18.207,19.205,27.844,21.011,29.918,32.683,41.277,32.737,37.655,42.098,55.071,46.355,56.177,59.462,74.215,64.65,78.852,86.108,110.721,93.971,115.186,121.875,147.775,122.655,152.381,172.637,230.783,167.274,204.085,221.982,306.957,238.569,291.685,300.747,417.175,314.575,372.598,401.842,554.184,434.251,533.653,634.476,842.617,665.229,788.705,827.767,1094.551,854.734,1098.942,1166.594,1546.639,1234.768,1508.533,1583.573,2073.983,1655.661,1934.358,2087.533,2773.936,2344.253,2770.276,2949.008,3845.557,3211.761,3732.237,4015.017,5000.238,4282.012,4845.133,4991.113,6530.734,5373.258,6046.41,6283.496,8107.484,6768.191,7543.508,7930.949,10358.898,9280.566,10339.898,10627.5,13638.797,11649.398,13028.398,13683.797,17122,13920.398,16236.5,16826.898,20360.5,17686.098,19942.297,20417.699,24447.797,20440,22723,22914,27550,22772,25587,25644,30856,25409,28386,28777,35386,29819,33521,33509,40785,35129,38913,40899,51868,43447,46588,46181,57079,48565,53187,53185,64735,52126,56781,55765,66905,57224,63231,63036,75190,65434,70516,69282,82900,70755,76697,75397,89252,79675,85430,84467,99078,86378,92827,91794,107289,94940,102342,98345,108747,94214,100876,99373,113622,99811,103726,101952,116360,104189,109366,110226,123169,113010,114065,113800,127776,114070,116830,115688,129706,114960,120125,119001,131565,114826,120229,117408,129667,115904,120319,118179,130936,117542,122968,123179,136267,122690,128028),
                 recession=c(1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
df <- df %>% mutate(revtq_yoy = (revtq - lag(revtq, 4)) / lag(revtq, 4),
                    recession_lag = lag(recession),
                    revtq_down = ifelse(revtq_yoy<0,1,0),
                    revtq_yoy_lag = lag(revtq_yoy),
                    date = fyearq + (fqtr-1)/4)
mod1 <- glm(revtq_down ~ revtq_yoy_lag, data=df, family=binomial)
```

```{r ex="create_c", type="sample-code"}
# The dataframe below contains historical revenue for Walmart since 1970
# All data is quarterly
# The file uses Compustat's nomenclature:
#     - revtq_yoy is year over year revenue growth
#     - revtq_down is an indicator equal to 1 if revtq_yoy is negative, else 0
#     - revtq_yoy_lag is the lag of revtq_yoy
#     - date is a fractional date
# mod1 from the last exercise is also loaded

# Use predict() to calculate the probability of decreasing year over year
# revenue for Walmart based on mod1
df$pred <- predict(mod1, df, type="response")

# Plot out the actual decreases and predicted decrease probabilities by year
# ggplot2 is already loaded
ggplot(data=df) + 
  geom_point(aes(y = , x = , color = "Actual")) + 
  geom_point(aes(y = , x = , color = "Predicted")) + 
  ylab("Decrease in revenue")


#END
```

```{r ex="create_c", type="solution"}
# The dataframe below contains historical revenue for Walmart since 1970
# All data is quarterly
# The file uses Compustat's nomenclature:
#     - revtq_yoy is year over year revenue growth
#     - revtq_down is an indicator equal to 1 if revtq_yoy is negative, else 0
#     - revtq_yoy_lag is the lag of revtq_yoy
#     - date is a fractional date
# mod1 from the last exercise is also loaded

# Use predict() to calculate the probability of decreasing year over year
# revenue for Walmart based on mod1
df$pred <- predict(mod1, df, type="response")

# Plot out the actual decreases and predicted decrease probabilities by date
# ggplot2 is already loaded
ggplot(data=df) + 
  geom_point(aes(y = revtq_down, x = date, color = "Actual")) + 
  geom_point(aes(y = pred, x = date, color = "Predicted")) + 
  ylab("Decrease in revenue")


#END
```

```{r ex="create_c", type="sct"}
# Template based on https://www.rdocumentation.org/packages/testwhat/versions/4.1.1
# Check if something is explicitly typed

test_student_typed('x = date',not_typed_msg='Make sure to regress `revtq_down` on `revtq_yoy_lag`.')
test_student_typed('y = revtq_down',not_typed_msg='Make sure to set `y = revtq_down` within `aes()` for the actual decrease in revenue series.')
test_student_typed('y = pred',not_typed_msg='Make sure to set `y = pred` within `aes()` for the predicted decrease in revenue series.')
test_student_typed('type = "response"',not_typed_msg='Make sure to set `type = "response"` when using `predict()`.')
test_expression_output("df$pred", incorrect_msg="Your predictions in `df$pred` don't seem quite right.")

# test_student_typed('x <- 2', not_typed_msg='')

# Check if function was used in input code
# test_function('c',incorrect_msg='')  

# Requires an object `x` to have the same value as the solution
# test_object("x",incorrect_msg = "",undefined_msg = "")  

# Requires an onject with the same value of `x` in the solution
# test_an_object("x",undefined_msg="")

# Checks if output of student's code contains given evaluated expression
# test_output_contains("x",incorrect_msg = "")

# Check if a vector of predefined objects are unchanged
# test_predefined_objects(c('x','y'),incorrect_msg="Don't onverwrite the predefined variables")

# Checks for a regex pattern in trhe output
# test_output_regex(pattern,fixed=F, times=1, incorrect_msg='')

# Can check an arbitrary expression across both solution and student code
#test_expression_output("typeof(company_name)", incorrect_msg="Did you store textual data in `company_name`?")

test_error()
success_msg("Awesome!")

# Other functions to note:
#     - test_or(a,b) -- checks if either test a or test b pass
#     - test_ggplot() -- can check if plots are correct
#     - test_function() -- can also check included parameters
#     - test_loop() -- checking for and while loops
#     - test_library_function('package', not_called_msg='',incorrect_msg='')
#     - test_if_else() -- checking if statements
#     - test_expression_error() -- can check if functions are properly defined
#     - test_operator('operator',), not_called_msg='',incorrect_msg='')
#     - test_function_definition() -- rigorously check defined function
#     - test_data_frame() -- check if dataframe [columns] are equivalent
#     - test_function_result, test_expression_result
```

### Exercise 3: ROC curve and AUC

Note: This isn't using the yardstick library directly, but instead implements a small subset of the functionality of it.

```{r ex="create_d", type="pre-exercise-code"}
library(dplyr) # loads dplyr for data manipulation
library(ggplot2)
df <- data.frame(tic=rep("WMT",194),
                 fyearq=c(1970,1970,1970,1970,1971,1971,1971,1971,1972,1972,1972,1972,1973,1973,1973,1973,1974,1974,1974,1974,1975,1975,1975,1975,1976,1976,1976,1976,1977,1977,1977,1977,1978,1978,1978,1978,1979,1979,1979,1979,1980,1980,1980,1980,1981,1981,1981,1981,1982,1982,1982,1982,1983,1983,1983,1983,1984,1984,1984,1984,1985,1985,1985,1985,1986,1986,1986,1986,1987,1987,1987,1987,1988,1988,1988,1988,1989,1989,1989,1989,1990,1990,1990,1990,1991,1991,1991,1991,1992,1992,1992,1992,1993,1993,1993,1993,1994,1994,1994,1994,1995,1995,1995,1995,1996,1996,1996,1996,1997,1997,1997,1997,1998,1998,1998,1998,1999,1999,1999,1999,2000,2000,2000,2000,2001,2001,2001,2001,2002,2002,2002,2002,2003,2003,2003,2003,2004,2004,2004,2004,2005,2005,2005,2005,2006,2006,2006,2006,2007,2007,2007,2007,2008,2008,2008,2008,2009,2009,2009,2009,2010,2010,2010,2010,2011,2011,2011,2011,2012,2012,2012,2012,2013,2013,2013,2013,2014,2014,2014,2014,2015,2015,2015,2015,2016,2016,2016,2016,2017,2017,2017,2017,2018,2018),
                 fqtr=c(1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2),
                 revtq=c(7.267,9.939,11.47,15.61,12.758,18.207,19.205,27.844,21.011,29.918,32.683,41.277,32.737,37.655,42.098,55.071,46.355,56.177,59.462,74.215,64.65,78.852,86.108,110.721,93.971,115.186,121.875,147.775,122.655,152.381,172.637,230.783,167.274,204.085,221.982,306.957,238.569,291.685,300.747,417.175,314.575,372.598,401.842,554.184,434.251,533.653,634.476,842.617,665.229,788.705,827.767,1094.551,854.734,1098.942,1166.594,1546.639,1234.768,1508.533,1583.573,2073.983,1655.661,1934.358,2087.533,2773.936,2344.253,2770.276,2949.008,3845.557,3211.761,3732.237,4015.017,5000.238,4282.012,4845.133,4991.113,6530.734,5373.258,6046.41,6283.496,8107.484,6768.191,7543.508,7930.949,10358.898,9280.566,10339.898,10627.5,13638.797,11649.398,13028.398,13683.797,17122,13920.398,16236.5,16826.898,20360.5,17686.098,19942.297,20417.699,24447.797,20440,22723,22914,27550,22772,25587,25644,30856,25409,28386,28777,35386,29819,33521,33509,40785,35129,38913,40899,51868,43447,46588,46181,57079,48565,53187,53185,64735,52126,56781,55765,66905,57224,63231,63036,75190,65434,70516,69282,82900,70755,76697,75397,89252,79675,85430,84467,99078,86378,92827,91794,107289,94940,102342,98345,108747,94214,100876,99373,113622,99811,103726,101952,116360,104189,109366,110226,123169,113010,114065,113800,127776,114070,116830,115688,129706,114960,120125,119001,131565,114826,120229,117408,129667,115904,120319,118179,130936,117542,122968,123179,136267,122690,128028),
                 recession=c(1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
df <- df %>% mutate(revtq_yoy = (revtq - lag(revtq, 4)) / lag(revtq, 4),
                    recession_lag = lag(recession),
                    revtq_down = ifelse(revtq_yoy<0,1,0),
                    revtq_yoy_lag = lag(revtq_yoy),
                    date = fyearq + (fqtr-1)/4)
mod1 <- glm(revtq_down ~ revtq_yoy_lag, data=df, family=binomial)
df$pred <- predict(mod1, df, type="response")

auroc <- function(score, bool) {
  n1 <- sum(!bool)
  n2 <- sum(bool)
  U  <- sum(rank(score)[!bool]) - n1 * (n1 + 1) / 2
  return(1 - U / n1 / n2)
}

df <- df %>% filter(!is.na(revtq_down), !is.na(pred))

roc_auc <- function(df, truth=NULL, estimate=NULL, event_level='first') {
  truth <- rlang::enquo(truth)
  estimate <- rlang::enquo(estimate)
  true_Y = df %>% select(revtq_down)
  probs = df %>% select(pred)
  auc = auroc(probs, true_Y)
  if (event_level=='first') {
    auc = 1-auc
  }
  data.frame(.metric=c("roc_auc"), .estimator=c("binary"), .estimate=c(auc))
}
```

```{r ex="create_d", type="sample-code"}
# df, including pred, is loaded

# Calculate ROC AUC ('auc') using yardstick's roc_auc()
AUC <- df %>% roc_auc(truth=, estimate=, event_level=)

# Display the AUC value -- this line is already done
AUC
#END
```

```{r ex="create_d", type="solution"}
# df, including pred, is loaded

# Calculate ROC AUC ('auc') using yardstick's roc_auc()
AUC <- df %>% roc_auc(truth=revtq_down, estimate=pred, event_level='second')

# Display the AUC value -- this line is already done
AUC
#END
```

```{r ex="create_d", type="sct"}
# Template based on https://www.rdocumentation.org/packages/testwhat/versions/4.1.1
# Check if something is explicitly typed

test_student_typed('second',not_typed_msg='Make sure to set event_level as \'second\'.')
test_student_typed('revtq_down',not_typed_msg='Make sure to set truth as `revtq_down`.')
test_student_typed('pred',not_typed_msg='Make sure to set estimate as `pred`.')
test_expression_output("AUC", incorrect_msg="Your AUC output isn't quite right.")

#test_student_typed('revtq_down ~ recession_lag',not_typed_msg='Make sure to regress `revtq_down` on `recession_lag`.')


# test_student_typed('x <- 2', not_typed_msg='')

# Check if function was used in input code
# test_function('c',incorrect_msg='')  

# Requires an object `x` to have the same value as the solution
# test_object("x",incorrect_msg = "",undefined_msg = "")  

# Requires an onject with the same value of `x` in the solution
# test_an_object("x",undefined_msg="")

# Checks if output of student's code contains given evaluated expression
# test_output_contains("x",incorrect_msg = "")

# Check if a vector of predefined objects are unchanged
# test_predefined_objects(c('x','y'),incorrect_msg="Don't onverwrite the predefined variables")

# Checks for a regex pattern in trhe output
# test_output_regex(pattern,fixed=F, times=1, incorrect_msg='')

# Can check an arbitrary expression across both solution and student code
#test_expression_output("typeof(company_name)", incorrect_msg="Did you store textual data in `company_name`?")

test_error()
success_msg("Awesome!")

# Other functions to note:
#     - test_or(a,b) -- checks if either test a or test b pass
#     - test_ggplot() -- can check if plots are correct
#     - test_function() -- can also check included parameters
#     - test_loop() -- checking for and while loops
#     - test_library_function('package', not_called_msg='',incorrect_msg='')
#     - test_if_else() -- checking if statements
#     - test_expression_error() -- can check if functions are properly defined
#     - test_operator('operator',), not_called_msg='',incorrect_msg='')
#     - test_function_definition() -- rigorously check defined function
#     - test_data_frame() -- check if dataframe [columns] are equivalent
#     - test_function_result, test_expression_result
```

### Exercise 4: Plotting a ROC curve

As the `autoplot()` method is unsupported here, code is given below to visualize the ROC curve for the model you have built.

```{r ex="create_e", type="pre-exercise-code"}
library(ggplot2)
df_ROC <- data.frame(FalsePositive=c(0, 0.00543478260869565, 0.0108695652173913, 0.0108695652173913, 0.0108695652173913, 0.016304347826087, 0.0217391304347826, 0.0217391304347826, 0.0271739130434783, 0.0326086956521739, 0.0380434782608696, 0.0434782608695652, 0.0489130434782609, 0.0543478260869565, 0.0543478260869565, 0.0597826086956522, 0.0597826086956522, 0.0652173913043478, 0.0706521739130435, 0.0760869565217391, 0.0815217391304348, 0.0869565217391304, 0.0923913043478261, 0.0978260869565217, 0.103260869565217, 0.108695652173913, 0.114130434782609, 0.119565217391304, 0.125, 0.130434782608696, 0.135869565217391, 0.141304347826087, 0.146739130434783, 0.152173913043478, 0.157608695652174, 0.16304347826087, 0.168478260869565, 0.173913043478261, 0.179347826086957, 0.184782608695652, 0.190217391304348, 0.195652173913043, 0.201086956521739, 0.206521739130435, 0.21195652173913, 0.217391304347826, 0.222826086956522, 0.228260869565217, 0.233695652173913, 0.239130434782609, 0.244565217391304, 0.25, 0.255434782608696, 0.260869565217391, 0.266304347826087, 0.271739130434783, 0.277173913043478, 0.282608695652174, 0.28804347826087, 0.293478260869565, 0.298913043478261, 0.304347826086957, 0.309782608695652, 0.315217391304348, 0.320652173913043, 0.326086956521739, 0.331521739130435, 0.33695652173913, 0.342391304347826, 0.347826086956522, 0.353260869565217, 0.358695652173913, 0.364130434782609, 0.369565217391304, 0.375, 0.380434782608696, 0.385869565217391, 0.391304347826087, 0.396739130434783, 0.402173913043478, 0.407608695652174, 0.41304347826087, 0.418478260869565, 0.423913043478261, 0.429347826086957, 0.434782608695652, 0.440217391304348, 0.445652173913043, 0.451086956521739, 0.456521739130435, 0.46195652173913, 0.467391304347826, 0.472826086956522, 0.478260869565217, 0.483695652173913, 0.489130434782609, 0.494565217391304, 0.5, 0.505434782608696, 0.510869565217391, 0.516304347826087, 0.521739130434783, 0.527173913043478, 0.532608695652174, 0.53804347826087, 0.543478260869565, 0.548913043478261, 0.554347826086957, 0.559782608695652, 0.565217391304348, 0.570652173913043, 0.576086956521739, 0.581521739130435, 0.58695652173913, 0.592391304347826, 0.597826086956522, 0.603260869565217, 0.608695652173913, 0.614130434782609, 0.619565217391304, 0.625, 0.630434782608696, 0.635869565217391, 0.641304347826087, 0.646739130434783, 0.652173913043478, 0.657608695652174, 0.66304347826087, 0.668478260869565, 0.673913043478261, 0.679347826086957, 0.684782608695652, 0.690217391304348, 0.695652173913043, 0.701086956521739, 0.706521739130435, 0.71195652173913, 0.717391304347826, 0.722826086956522, 0.728260869565217, 0.733695652173913, 0.739130434782609, 0.744565217391304, 0.75, 0.755434782608696, 0.760869565217391, 0.766304347826087, 0.771739130434783, 0.777173913043478, 1),
                     TruePositive=c(0, 0, 0, 0.2, 0.4, 0.4, 0.4, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.8, 0.8, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1))
```

```{r ex="create_e", type="sample-code"}
# Plot the ROC curve -- this code is done for you
ggplot(data=df_ROC, aes(x=FalsePositive, y=TruePositive)) +
  geom_line() +
  geom_abline(slope=1)

#END
```

```{r ex="create_e", type="solution"}
# Plot the ROC curve -- this code is done for you
ggplot(data=df_ROC, aes(x=FalsePositive, y=TruePositive)) +
  geom_line() +
  geom_abline(slope=1)

#END
```

```{r ex="create_e", type="sct"}
# Template based on https://www.rdocumentation.org/packages/testwhat/versions/4.1.1
# Check if something is explicitly typed

test_student_typed('data=df_ROC',not_typed_msg='Make sure to use `df_ROC` as the data frame.')
test_student_typed('x=FalsePositive',not_typed_msg='Make sure to put `FalsePositive` as the data plotted on the x-axis')
test_student_typed('y=FalsePositive',not_typed_msg='Make sure to put `TruePositive` as the data plotted on the y-axis')

# test_student_typed('x <- 2', not_typed_msg='')

# Check if function was used in input code
# test_function('c',incorrect_msg='')  

# Requires an object `x` to have the same value as the solution
# test_object("x",incorrect_msg = "",undefined_msg = "")  

# Requires an onject with the same value of `x` in the solution
# test_an_object("x",undefined_msg="")

# Checks if output of student's code contains given evaluated expression
# test_output_contains("x",incorrect_msg = "")

# Check if a vector of predefined objects are unchanged
# test_predefined_objects(c('x','y'),incorrect_msg="Don't onverwrite the predefined variables")

# Checks for a regex pattern in trhe output
# test_output_regex(pattern,fixed=F, times=1, incorrect_msg='')

# Can check an arbitrary expression across both solution and student code
#test_expression_output("typeof(company_name)", incorrect_msg="Did you store textual data in `company_name`?")

test_error()
success_msg("Awesome!")

# Other functions to note:
#     - test_or(a,b) -- checks if either test a or test b pass
#     - test_ggplot() -- can check if plots are correct
#     - test_function() -- can also check included parameters
#     - test_loop() -- checking for and while loops
#     - test_library_function('package', not_called_msg='',incorrect_msg='')
#     - test_if_else() -- checking if statements
#     - test_expression_error() -- can check if functions are properly defined
#     - test_operator('operator',), not_called_msg='',incorrect_msg='')
#     - test_function_definition() -- rigorously check defined function
#     - test_data_frame() -- check if dataframe [columns] are equivalent
#     - test_function_result, test_expression_result
```