04-Case-Study.rmd

---
title: 'Case Study: Friday the 13th Effect'
output:
  html_document: default
  word_document: default
  pdf_document: default
---

```{r setup}
library(fivethirtyeight)
library(tidyverse)
```

## Task

Reproduce this figure from fivethirtyeight's article [*Some People Are Too Superstitious To Have A Baby On Friday The 13th*](https://fivethirtyeight.com/features/some-people-are-too-superstitious-to-have-a-baby-on-friday-the-13th/):

## Data

In the `fivethiryeight` package there are two datasets containing birth data, but for now let's just work with one, `US_births_1994_2003`.  Note that since we have data from 1994-2003, our results may differ somewhat from the figure based on 1994-2014.

## Your Turn 1 

With your neighbour, brainstorm the steps needed to get the data in a form ready to make the plot.

```{r}
US_births_1994_2003

```

## Some overviews of the data

Whole time series:
```{r}
ggplot(US_births_1994_2003, aes(x = date, y = births)) +
  geom_line()
```
There is so much fluctuation it's really hard to see what is going on.

Let's try just looking at one year:
```{r}
US_births_1994_2003 %>%
  filter(year == 1994) %>%
  ggplot(mapping = aes(x = date, y = births)) +
    geom_line()
```
Strong weekly pattern accounts for most variation.

## Strategy

Use the figure as a guide for what the data should like to make the final plot.  We want to end up with something like:

---------------------------
 day_of_week   avg_diff_13 
------------- -------------
     Mon         -2.686    

    Tues         -1.378    

     Wed         -3.274    
     
     ...          ...
     
---------------------------     


## Your Turn 2

Extract just the 6th, 13th and 20th of each month:

```{r}
US_births_1994_2003 %>%
  select(-date) %>% 
  filter(date_of_month %in% c(6, 13, 20))

```

## Your Turn 3

Which arrangement is tidy?
Option 2 is tidy. 

**Option 1:**

-----------------------------------------------------
 year   month   date_of_month   day_of_week   births 
------ ------- --------------- ------------- --------
 1994     1           6            Thurs      11406  

 1994     1          13            Thurs      11212  

 1994     1          20            Thurs      11682  
-----------------------------------------------------

**Option 2:**

----------------------------------------------------
 year   month   day_of_week     6      13      20   
------ ------- ------------- ------- ------- -------
 1994     1        Thurs      11406   11212   11682 
----------------------------------------------------

(**Hint:** think about our next step *"Find the percent difference between the 13th and the average of the 6th and 12th"*. In which layout will this be easier using our tidy tools?)

## Your Turn 4

Tidy the filtered data to have the days in columns.

```{r}
US_births_1994_2003 %>%
  select(-date) %>% 
  filter(date_of_month %in% c(6, 13, 20)) %>% 
  pivot_wider(names_from = date_of_month, values_from = births)

```

## Your Turn 5

Now use `mutate()` to add columns for:

* The average of the births on the 6th and 20th
* The percentage difference between the number of births on the 13th and the average of the 6th and 20th

```{r}
US_births_1994_2003 %>%
  select(-date) %>% 
  filter(date_of_month %in% c(6, 13, 20)) %>%
  pivot_wider(names_from = date_of_month, values_from = births) %>% 
  mutate(
    avg_6_20 = (`6` + `20`)/2,
    diff_13 = (`13` - avg_6_20) / avg_6_20 * 100)

```

## A little additional exploring

Now that we have a percent difference between the 13th and the 6th and 20th of each month, it's probably worth exploring a little (at the very least to check that our calculations seem reasonable).

To make it a little easier let's assign our current data to a variable
```{r}
births_diff_13 <- US_births_1994_2003 %>%
  select(-date) %>% 
  filter(date_of_month %in% c(6, 13, 20)) %>%
  pivot_wider(names_from = date_of_month, values_from = births) %>%
  mutate(
    avg_6_20 = (`6` + `20`)/2,
    diff_13 = (`13` - avg_6_20) / avg_6_20 * 100
  )
```

Then take a look
```{r}
births_diff_13 %>% 
  ggplot(mapping = aes(day_of_week, diff_13)) +
    geom_point()
```

Looks like we are on the right path.  There's a big outlier one Monday
```{r}
births_diff_13 %>%
  filter(day_of_week == "Mon", diff_13 > 10)
```

Seems to be driven by a particularly low number of births on the 6th of Sep 1999. Maybe a holiday effect? Labour Day was of the 6th of Sep that year.

## Your Turn 6

Summarize each day of the week to have a mean of diff_13.

Then, recreate the fivethirtyeight plot.

```{r}
US_births_1994_2003 %>%
  select(-date) %>% 
  filter(date_of_month %in% c(6, 13, 20)) %>%
  pivot_wider(names_from = date_of_month, values_from = births) %>%
  mutate(
    avg_6_20 = (`6` + `20`)/2,
    diff_13 = (`13` - avg_6_20) / avg_6_20 * 100
  ) %>% 
  group_by(day_of_week) %>% 
  summarise(avg_diff_13 = mean(diff_13)) %>% 
  ggplot(aes(x = day_of_week, y = avg_diff_13)) +
    geom_bar(stat = "identity", fill = "pink", color = "deeppink")

## I did the border color just for fun
```

## Extra Challenges

* If you wanted to use the `US_births_2000_2014` data instead, what would you need to change in the pipeline?  How about using both `US_births_1994_2003` and `US_births_2000_2014`?
If I wanted to use the 2000-2014 data instead, I would call "US_births_2000_2014" in the first step (in Your Turn 1). If I wanted to use both data sets, I would combine them first using merge() or rbind().

* Try not removing the `date` column. At what point in the pipeline does it cause problems? Why?
Not removing the 'date' column causes problems very early on (in Your Turn 4). According to my new table (see below), in 1994, there were only 2 months for which the first day of the month fell on a Saturday: January and October. In January, for example, my new table shows how many babies were born on Saturday, January 1st but states "NA" for the rest of January's part of that column, because there is only one first day of January 1994. (The "1" column refers to the first day of each month). 

Then, I cannot compute the pivot_wider() function in Your Turn 5 because this function uses the days of the month as column labels.

```{r}
US_births_1994_2003 %>%
  select(-date) %>% 
  pivot_wider(names_from = date_of_month, values_from = births)

```
* Can you come up with an alternative way to investigate the Friday the 13th effect?  Try it out!
I can also visualize the data using a scatter plot or a violin plot (both are below).

``` {r}
US_births_1994_2003 %>%
  select(-date) %>% 
  filter(date_of_month %in% c(6, 13, 20)) %>%
  pivot_wider(names_from = date_of_month, values_from = births) %>%
  mutate(
    avg_6_20 = (`6` + `20`)/2,
    diff_13 = (`13` - avg_6_20) / avg_6_20 * 100
  ) %>% 
  group_by(day_of_week) %>% 
  summarise(avg_diff_13 = mean(diff_13)) %>% 
  ggplot(aes(x = day_of_week, y = avg_diff_13)) +
    geom_point(stat = "identity", color = "deeppink")
```

``` {r}
US_births_1994_2003 %>%
  select(-date) %>% 
  filter(date_of_month %in% c(6, 13, 20)) %>%
  pivot_wider(names_from = date_of_month, values_from = births) %>%
  mutate(
    avg_6_20 = (`6` + `20`)/2,
    diff_13 = (`13` - avg_6_20) / avg_6_20 * 100
  ) %>% 
  ggplot(aes(x = day_of_week, y = diff_13)) +
    geom_violin()
```

## Takeaways

The power of the tidyverse comes from being able to easily combine functions that do simple things well.  


<!-- This file by Charlotte Wickham is licensed under a Creative Commons Attribution 4.0 International License. -->