r-for-data-science.rmd

---
title: "R-for-data-science"
author: "Evan-Woods"
date: "2023-11-10"
output: github_document
always_allow_html: true
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

## Libraries

```{r}
if (!require(dplyr)) install.packages("dplyr")
# if (!require(stargazer)) install.packages("stargazer")
if (!require(tidyverse)) install.packages("tidyverse")
if(!require(nycflights13)) install.packages("nycflights13")
# if (!require(shiny)) install.packages("shiny")
# if(!require(Lahman)) install.packages("Lahman")
if(!require(ggplot2)) install.packages("ggplot2")
# if(!require(EnvStats)) install.packages("EnvStats")
# library(EnvStats)
library(tidyverse)
```

## R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see <http://rmarkdown.rstudio.com>.

When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:

```{r cars}
summary(cars)
```

```{r}
# knitr::knit_exit()
```

## Including Plots

You can also embed plots, for example:

```{r pressure, echo=FALSE}
plot(pressure)
```

Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot.

## 3.1 Data Visualization

### 3.1.1 Prerequisites
```{r}
mpg <- mpg
```
```{r}
?mpg
```

```{r}
ggplot(data = mpg) +
  geom_point(aes(displ, hwy))
```


```{r ggplot graphing template}
#ggplot(data = <DATA>) + 
#  <GEOM_FUNCTION>(mapping = aes(<MAPPINGS>))
```

```{r}
ggplot(data = mpg)
```
```{r}
mpg
```
```{r 3.2.4 Exercises}
# Scatterplot of hwy vs cyl
ggplot(mpg) +
  geom_point(aes(class, drv))
```
```{r}
ggplot(mpg) +
  geom_point(aes(hwy, displ, color = class))
```
```{r}
ggplot(mpg) + 
  geom_point(aes(hwy, displ, size = class))
```
```{r}
ggplot(mpg) +
  geom_point(aes(hwy, displ, alpha = class))
```
```{r}
ggplot(data = mpg) + 
  geom_point(aes(x = displ, y = hwy), color = "blue")
```
```{r}
# [Shapes](https://d33wubrfki0l68.cloudfront.net/cc94c11128cb951a9fd833667d7c8e726cde8448/b3728/visualize_files/figure-html/shapes-1.png)
ggplot(mpg) + 
  geom_point(aes(displ, hwy), shape = 1)
```
```{r View the data}
str(mpg)
```
```{r}
ggplot(mpg) +
  geom_point(aes(displ, hwy,  color = trans))
```
```{r}
ggplot(mpg) + 
  geom_point(aes(displ, hwy, color = year, alpha = year))
  labs(color = mpg$year)
```

```{r}
ggplot(mpg) + 
  geom_point(aes(displ, hwy, stroke = 5))
```


```{r}
?aes
```


```{r}
?geom_point
```


## Section 3.5: Facets
```{r}
ggplot(data = mpg) + 
  geom_point(aes(displ, hwy)) + 
  facet_wrap(~ model)
```

```{r}
str(mpg)
```

```{r}
ggplot(mpg) + 
  geom_point(aes(displ, hwy)) + 
  facet_wrap(drv ~ cyl)
```
```{r}
?mpg
```

```{r}
mpg$cyl
```


```{r}
ggplot(mpg) + 
  geom_point(aes(displ, hwy)) + 
  facet_grid(. ~ cyl)
```
```{r faceting on a continuous variable}
ggplot(mpg) +
  geom_point(aes(displ, hwy)) + 
  facet_wrap(~cty)
```
```{r}
ggplot(mpg) + 
  geom_point(aes(drv, cyl)) +
  facet_grid(drv ~ cyl)
```

```{r}
ggplot(mpg) +
  geom_point(aes(displ, hwy)) +
  facet_grid(drv ~ .)
```


```{r}
ggplot(mpg) + 
  geom_point(aes(displ, hwy)) +
  facet_grid(. ~ cyl)
```
```{r}
ggplot(data = mpg) +
  geom_point(aes(displ, hwy)) +
  facet_wrap(~class, nrow = 2)
```
```{r}
ggplot(data = mpg) +
  geom_point(aes(displ, hwy, color = class)) +
  facet_wrap(~ class)
```


```{r}
?facet_wrap
```

```{r}
ggplot(data = mpg) +
  geom_point(aes(displ, hwy))
```

```{r}
?geom_smooth
```


```{r}
ggplot(mpg) +
  geom_smooth(aes(displ, hwy))
```
```{r}
ggplot(mpg) +
  geom_smooth(aes(displ, hwy, linetype = drv, color =drv)) + 
  geom_point(aes(displ, hwy, color = drv))
```
```{r}
ggplot(mpg, aes(displ, hwy)) + 
  geom_point() +
  geom_smooth()
```

```{r}
ggplot(mpg, aes(displ, hwy)) +
  geom_point(aes(color = class)) + 
  geom_smooth()
```

```{r}
ggplot(mpg, aes(displ, hwy)) +
  geom_point(aes(color = class))+
  geom_smooth(data = filter(mpg, class == "subcompact"), se = FALSE)


```

```{r}
?geom_boxplot
```


```{r}
# Boxplot
ggplot(mpg, aes(displ)) +
  geom_boxplot() 

# Histogram
ggplot(mpg, aes(displ)) + 
  geom_histogram()

# Line Graph
ggplot(mpg, aes(displ, hwy)) + 
  geom_smooth(se = FALSE)

# Area Graph
ggplot(mpg, aes(displ, hwy)) + 
  geom_area()
```



```{r}
ggplot(mpg, aes(displ, hwy, color = drv )) + 
  geom_point() +
  geom_smooth(se = FALSE)
#geom_point(show.legend = FALSE) +
 # geom_smooth(se = FALSE, show.legend = FALSE)
  
```
```{r}
?geom_point
```


```{r}
ggplot(mpg, aes(displ, hwy)) +
  geom_point(size = 5) +
  geom_smooth(size = 3, se = FALSE)

ggplot(mpg, aes(displ, hwy)) +
  geom_smooth(size = 3, aes(displ, hwy, group =drv), se = FALSE) +
  geom_point(size = 5)  

ggplot(mpg, aes(displ, hwy, color = drv)) +
  geom_smooth(size = 3, se = FALSE) + 
  geom_point(size = 5)

ggplot(mpg) + 
  geom_point(size = 5, aes(displ, hwy, color = drv)) +
  geom_smooth(size = 3, aes(displ, hwy), se = FALSE)

ggplot(mpg) + 
  geom_point(size = 3, aes(displ, hwy, color = drv)) +
  geom_smooth(aes(displ, hwy, linetype = drv), se = FALSE, size = 2) 

ggplot(mpg, aes(displ, hwy)) + 
  geom_point(stroke = 7, color = "white") +
  geom_point(size = 5, aes(displ, hwy, color = drv))
```
## Section 3.7: Statistical Transformations
```{r}
ggplot(data = diamonds) + 
  geom_bar(aes(cut))
```
```{r}
ggplot(diamonds) + 
  stat_count(aes(cut))
```
```{r}
demo <- tribble(
  ~cut, ~freq, 
  "Fair", 1610, 
  "Good", 4906,
  "Very Good", 12082,
  "Premium", 13791,
  "Ideal", 21551
)

ggplot(data = demo) + 
  geom_bar(aes(cut, freq), stat = "identity")
```

```{r}
# Using a prop stat rather than count on the bar geom
ggplot(diamonds) + 
  geom_bar(aes(cut, y = stat(prop), group = 1))
```

### Section 3.7.1: Exercises
```{r}
# Plotting with a summary statistic
ggplot(diamonds) + 
  stat_summary(
    aes(cut, depth), 
      fun.min = min, 
      fun.max = max, 
      fun = median
  )

# Plotting with a geom_pointrange
ggplot(diamonds) +
  geom_pointrange(
    mapping = aes(cut, depth), 
    stat = "summary",
    fun.min = min,
    fun.max = max,
    fun = median
  )

```

```{r}
# Bar
ggplot(diamonds) +
  geom_bar(aes(cut))
```
```{r}
# Example of geometric column
df <- data.frame(trt = c("a", "b", "c"), outcome = c(2.3, 1.9, 3.2))
ggplot(df, aes(trt, outcome)) + 
  geom_col()
```
### The difference between geom_bar & geom_col
```{r}
# The difference between a geom_bar & a geom_col is a geom_bar uses a stat_count whereas geom_col uses values of of a variable. This is useful when you desire to plot categorical data against numerical data. 
```


### geom pairs
```{r}
# stat_bin : geom_bar
# stat_count : geom_bar
# stat_density : geom_area
# stat_bin_2d : geom_tile
# stat_bin_hex : geom_hex
# stat_density_2d : geom_density_2d
# stat_ellipse : geom_path
# stat_contour : geom_contour
# stat_summary_hex : geom_hex
# stat_summary_2d : geom_tile
# stat_boxplot : geom_boxplot
# stat_ydensity : geom_violin
# stat_ecdf : geom_step
# stat_quantile : geom_quantile
# stat_smooth : geom_smooth
# stat_function : geom_function
# stat_qq : geom_point
# stat_sum : geom_point
# stat_summary : geom_pointrange
# stat_summary_bin : geom_pointrange
# stat_identity : geom_point
# stat_unique : geom_point
```

### stat_smooth
```{r}
# [statsmooth docs](https://ggplot2.tidyverse.org/reference/geom_smooth.html#computed-variables)
# Stat smooth computes: 
#   y or x as the predicted value
#   ymin or xmin: lower pointwise confidence interval around the mean
#   ymax or xmax: upper pointwise confidence interval around the mean
#   se as standard error

# Parameters:
# mapping
# data
# position
# method
# formula
# se
# na.rm
# orientation
# show.legend
# inherit.aes
# geom, stat
# n: number of points at which to evaluate smoother
# span : controls the amount of smoothing
# fullrange 
# level: confidence interval to use
# method.args
```

```{r}
# I need to add groups because each column will not automatically sort the data proportionally into groups. Bar by default does not use a variable as a value in the y column. Therefore proportionally all data is being read into every column until the data is sorted into groups by declaring group = 1.

ggplot(data = diamonds) + 
  geom_bar(aes(color, after_stat(prop), group = 1))

ggplot(diamonds) + 
  geom_bar(aes(x = cut, fill = color, y = after_stat(prop), group = 1))
```


## 3.8 Position adjustments
```{r}

# Bar plots are quantities stacked on top of each other by default
ggplot(diamonds) +
  geom_bar(aes(cut, color = cut))

ggplot(diamonds) +
  geom_bar(aes(cut, fill = cut))

ggplot(diamonds) + 
  geom_bar(aes(x = cut, fill = clarity))
```
```{r}
# bars
# Identity will overlay the bars on each other
ggplot(diamonds, aes(cut, fill = clarity)) +
  geom_bar(alpha = 1/5, position = "identity")

ggplot(diamonds, aes(cut, color = clarity)) + 
  geom_bar(fill = NA, position = "identity")

# Dodge will show the bars side by side
ggplot(diamonds, aes(cut, fill = clarity)) + 
  geom_bar(position = "dodge")

# Fill stacks the bars as in default but the bars are each the same height
ggplot(diamonds, aes(cut, fill = clarity)) + 
  geom_bar(position = "fill")
```
#### Jitter 
```{r}
# This will add small amounts of random noise to make all points visible.
ggplot(mpg) +
  geom_point(aes(displ, hwy), position = "jitter")

ggplot(mpg) +
  geom_jitter(aes(displ, hwy))
```

### 3.8.1 Exercises
```{r}
# This plot needed color and jitter to show all the points
ggplot(mpg, aes(cty, hwy, color = cty)) +
  geom_jitter(width = 1, height = 1)

ggplot(mpg, aes(cty, hwy, color = cty)) +
  geom_count()
# The width param will control the amount of jitter
# geom_count will map the point position to area whereas geom_jitter maps the point to a slightly different point
```

```{r}
ggplot(mpg) +
  geom_boxplot(aes(cty, hwy, position = "jitter")) +
  coord_flip()
```

### 3.9 Coordinate Systems

```{r}
# coord_flip() to flip axis
# coord_quickmap to set aspect ratio for maps
# coord_polar() uses polar coordinates
bar <- ggplot(diamonds) + 
  geom_bar(
    aes(cut, fill = cut), 
    show.legend = FALSE,
    width = 1
  ) + 
  theme(aspect.ratio = 1) +
  labs(x = NULL, y = NULL)

bar + coord_flip()
bar + coord_polar()
```

```{r}
world <- map_data("world")

ggplot(world, aes(long, lat, group = group)) +
  geom_polygon(fill = "white", color = "black")

ggplot(world, aes(long, lat, group = group)) +
  geom_polygon(fill = "white", color = "black") +
  coord_quickmap()

```
### 3.9.1 Exercises
```{r}
# Creating a pie chart from a stacked bar chart
ggplot(diamonds) +
  geom_bar(aes(x = factor(1), fill = factor(cut)), position = "fill") +
  coord_polar(theta = "y") +
  xlab("") +
  ylab("") +
  labs(fill = "Cut")
```
```{r}
# coord_fixed fixes the aspect ratio such that x and y are 1
ggplot(mpg, aes(cty, hwy))+
  geom_point() + 
  geom_abline() +
  coord_fixed()

ggplot(mpg, aes(cty, hwy))+
  geom_point() + 
  geom_abline()
```

## 3.10 Code Template
```{r}
#ggplot(data = <DATA>) +
#  <GEOM_FUNCTION>(
#    mapping = aes(<MAPPINGS>), 
#    stat = <STAT>,
#    position = <POSITION>
#  ) +
#  <COORDINATE_FUNCTION> + 
#  <FACET_FUNCTION>
```

# 4 Workflow 
```{r}
ggplot(dota = mpg) +
  geom_point(mpg, mapping = aes(x = displ, y = hwy))

filter(mpg, cyl == 8)
filter(diamonds, carat > 3)
```
## 5 Data Transformation
```{r}
if(!require("nycflights13")) install.packages("nycflights13")
library(nycflights13)
library(tidyverse)
```
### 5.2 Filter
```{r}
filter(flights, month == 1, day == 1)
```
#### Floating point numbers
```{r}
near(sqrt(2) ^ 2, 2)
sqrt(2) ^ 2 == 2 # floating point precision is causing a flase
```

#### logical boolean operations
```{r}
TRUE & TRUE
FALSE | FALSE
xor(FALSE, TRUE)
```
```{r}
filter(flights, month == 11 | month == 12)
```

```{r}
# Finding months equal to november or december
nov_dec <- filter(flights, month %in% c(11, 12))
nov_dec
```
#### 5.2.4 Exercises
```{r}
(arr_delay_2_or_more_hours <- filter(flights, arr_delay >= 120))
(filter(flights, dest %in% c("IAH", "HOU")))
(filter(flights, carrier %in% c("UA", "AA", "Delta")))
(filter(flights, month %in% c(7, 8, 9)))
(filter(flights, arr_delay == 0, arr_time > 120))
(filter(flights, arr_delay >= 60, arr_time < 30))
(filter(flights, sched_dep_time > 0, sched_dep_time < 600))
(filter(flights, between(sched_dep_time, 0, 600))) # between is inclusive of the left and right ends
```

```{r}
summarise(flights)
```
### 5.3 Arrange Rows
```{r}
# reoder columns
arrange(flights,  day, year, month)

# reorder columns in descending order
arrange(flights, desc(dep_delay))
arrange(flights, is.na(carrier))
```
```{r}
summarise(flights)
```
##### 5.3.1 Exercises

```{r}
# Sorting all missing values at the start
df <- tibble(x = c(1, NA, 3))
filter(df, x > 1)
arrange(df, desc(is.na(x)))

# sort flights to find the most delayed flights
arrange(flights, dep_delay)
speed <- flights$distance/flights$air_time
(flights$speed <- speed)
arrange(flights, desc(speed))
  

# flights that traveled the farthest
arrange(flights, desc(distance))

# flights that traveled the shortest
arrange(flights, distance)

# 
```

### 5.4 Select 
```{r Selecting Columns By Name}
select(flights, year, month, day)
```
```{r Select all columns between year & day}
select(flights, year:day)
```
```{r select all columns excluding year & day}
select(flights, -(year:day))

```

```{r Select Helper Functions}
# starts_with("abc")
# ends_with("abc")
# contains("jks")
# matches("(.)\\1") # matches a regular expression
```


```{r}
flights_sml <- select(flights, 
                      year:day,
                      ends_with("delay"),
                      distance,
                      air_time
                      )
```


```{r}
# rename will rename all the variables that aren't mentioned when using a select
rename(flights_sml, arrival_delay = arr_delay)
```
```{r}
flights_sml
```

#### 5.4.1 Excercises
```{r}
select(flights, dep_time, dep_delay, arr_time, arr_delay)
select(flights, dep_delay, arr_time, arr_delay, dep_time)
# ... this will extend to include all orderings of dep_delay, arr_time, arr_delay, & dep_time
select(flights, dep_delay, dep_delay) # duplicates are listed only once

# selecting all_of(vars) will select all of the variables listed in var from a dataset. If the variables are not in a dataset, this will cause an error.
# selecting any_of(vars) will not throw an error when any one variable is not in the dataset. 
# i.e. 
vars <- c("Sepal.Length", "Sepal.Width")
#starwars %>% select(all_of(vars))
starwars %>% select(any_of(vars))
# any_of is useful for removing any of the variables in a list
iris %>% select(-any_of(vars))
```


### 5.5 Mutate
```{r}
# Mutate will add new rows to a dataset

flights_sml <- select(flights, 
                      year:day,
                      ends_with("delay"),
                      distance,
                      air_time
                      )

mutate(flights_sml, gain = dep_delay - arr_delay, speed = (distance / air_time) * 60)

# transmute will only refer to columns that were just created:
transmute(flights, gain = dep_delay - arr_delay, hours = air_time * 60, gain_per_hour = gain / hours)
```

```{r}
(x <- 1:10)
lead(x)
lag(x)
# lead()
# compute running differences x - lag(x)
# compute when values change x != lag(x)

```

```{r}
(x)
cumsum(x)
cummean(x)

# cumprod

# cummin
# cummax
```


```{r Rank}
y <- c(1,2,2,NA, 3, 4)
min_rank(y)
min_rank(desc(y))

# row_number()
# dense_rank()
# percent_rank()
# cume_dist()
```


#### 5.5 Modular arithmetic
```{r}
transmute(flights, hour = dep_time %/% 100, minutes = dep_time %/% 100)
```


```{r}
  summarise(flights, delay = mean(dep_delay, na.rm = TRUE))
```

```{r}
  by_dest <- group_by(flights, dest)
```

```{r}
  delay <- summarise(by_dest, count = n(), dist = mean(distance, na.rm = TRUE), delay = mean(arr_delay, na.rm = TRUE))
  (delay <- filter(delay, count > 20, dest != "HNL"))
#  (delay <- filter(delay, count > 10, delay < 6))

# group_by(flights, dest) %>% summarise(flights, count = n(), dist = mean(distance, na.rm = TRUE), delay = mean(arr_delay, na.rm = TRUE))


ggplot(data = delay, mapping = aes(x = dist, y = delay)) + 
  geom_point(aes(size = count, alpha = 1/3)) + 
  geom_smooth(se = FALSE)
```
```{r}

delays <- flights %>% group_by(dest) %>% summarise(count = n(), dist = mean(distance, na.rm = TRUE), delay = mean(arr_delay, na.rm =TRUE))
```

```{r}
dep_time <- group_by(flights, dep_time)
dep_time %>% summarise(count = n(), delay = mean(arr_delay, na.rm = TRUE))
```
```{r}
summarise(group_by(flights, dep_delay))
```

```{r}
x <- c(5,1,3,2,2, NA)
min_rank(x)
```


#### 5.5.2 Exercises
```{r}
# Converting flights scheduled depart time from hours since midnight to minutes
flights_sched_dep_time_hours <- flights$sched_dep_time %/% 100
flights_sched_dep_time_minutes <- flights$sched_dep_time %% 100
flights_sched_dep_time_total_minutes <- flights_sched_dep_time_hours * 60 + flights_sched_dep_time_minutes
flights$sched_dep_time <- flights_sched_dep_time_total_minutes
```

```{r}
# Converting flights arrival time from hours since midnight to minutes
flights_arr_time_hours <- flights$arr_time %/% 100
flights_arr_time_minutes <- flights$arr_time %% 100
flights_arr_time_total_minutes <- flights_arr_time_hours * 60 + flights_arr_time_minutes
flights$arr_time <- flights_arr_time_total_minutes
```

```{r}
# Converting flights depart time from hours since midnight to minutes
flights_dep_time_hours <- flights$dep_time %/% 100
flights_dep_time_minutes <- flights$dep_time %% 100
flights_dep_time_total_minutes <- flights_dep_time_hours * 60 + flights_dep_time_minutes
flights$dep_time <- flights_dep_time_total_minutes
(flights)
```




```{r}
air_time <- flights$air_time
arr_dep <- flights$arr_time - flights$dep_time
```

```{r}
# Find the 10 most delayed flights using a ranking function. 

####
delays <- flights$arr_delay + flights$dep_delay
flights <- mutate(flights, delays)
flight_delays <- (select(flights, delays, everything()))
group_by(flight_delays, delays)
delays_groups <- group_by(flight_delays,delays)
delays_groups

```

```{r}
delays <- flights$arr_delay + flights$dep_delay

# flights %>% group_by(delays) %>% summarise(count = n())

delays_ranked <- min_rank(delays)
flights <- mutate(flights, delays = flights$arr_delay + flights$dep_delay) %>% select(delays, everything())

flights
```

```{r}
flights <- mutate(flights, delay_rank = min_rank(desc(delays))) %>% select(delay_rank, everything())

(ten_most_delayed_flights <- subset(flights, delay_rank <= 10) %>% arrange(delay_rank))
```

```{r}
(ten_most_delayed_flights)
```


```{r}
# Quesion 5
# 1:3 + 1:10 returns the sum of 1 - 3 and 1 - 3 followed by the sum of 1 - 3 and  4 - 6 until the limit is of 10 is reached in the longer sequence. The shorter sequence is cycled until the longer sequence completes within the sum. 
1:3 + 1:10
```

```{r}
# Quesion 6
# sin
# cos
# tan

# acos
# asin
# atan
# atan2

# cospi
# sinpi
# tanpi

```

```{r 5.6 Grouped summaries with summarise}
summarise(flights, delay = mean(dep_delay, na.rm = TRUE))
```

```{r}
by_day <- group_by(flights, year, month, day)
```

```{r}
summarise(by_day, delay = mean(dep_delay, na.rm = TRUE))
```

```{r}
by_dest <- group_by(flights, dest)
delay <- summarise(by_dest, count = n(), dist = mean(distance, na.rm = TRUE), delay = mean(arr_delay, na.rm = TRUE))
delay <- filter(delay, count > 20, dest != "NHL")

ggplot(data = delay, mapping = aes(x = dist, y = delay)) + 
  geom_point(aes(size = count), alpha = 1/3) +
  geom_smooth(se = FALSE)
```

```{r}
delays <- flights %>% 
  group_by(dest) %>%
  summarise(
    count = n(), 
    dist = mean(distance, na.rm = TRUE),
    delay = mean(arr_delay, na.rm = TRUE)
  ) %>%
  filter(count > 20, dest != "HNL")


```

## 5.6.2 Missing Values
```{r}
flights %>%
  group_by(year, month, day) %>%
  summarise(mean = mean(dep_delay))
```

```{r}
not_cancelled <- flights %>%
  filter(!is.na(dep_delay), !is.na(arr_delay))

not_cancelled %>%
  group_by(year, month, day) %>%
  summarise(mean = mean(dep_delay))
```

## Section 5.6.3: Counts

```{r}
# count(n()) count values
# count non-missing values (sum(!is.na(x)))
delays <- not_cancelled %>%
  group_by(tailnum) %>%
  summarise(delay = mean(arr_delay))

ggplot(data = delays, mapping = aes(x = delay)) +
  geom_freqpoly(binwidth = 10)
```

```{r}
delays <- not_cancelled %>%
  group_by(tailnum) %>%
  summarise(
    delay = mean(arr_delay, na.rm = TRUE), 
    n = n()
  )

ggplot(data = delays, mapping = aes(x = n, y = delay)) + 
  geom_point(alpha = 1/10)
```


### 5.6.3 Counts
```{r}
not_cancelled <- flights %>% filter(!is.na(dep_delay), !is.na(arr_delay))

not_cancelled %>% group_by(year, month, day) %>% summarise(mean = mean(dep_delay))
```


```{r}
delays <- not_cancelled %>% group_by(tailnum) %>% summarise(delay = mean(arr_delay))

ggplot(delays, mapping = aes(delay)) + 
  geom_freqpoly(binwidth = 10)
```

```{r}
delays <- not_cancelled %>% group_by(tailnum) %>% summarise(delay = mean(arr_delay, na.rm = TRUE), n = n())

ggplot(data = delays, mapping = aes(x = n, y = delay))+
  geom_point(alpha = 1/10)
```

```{r}
batting <- as_tibble(Lahman::Batting)
```

```{r}
batting
```


```{r}
batters <- batting %>% group_by(playerID) %>% summarise(ba = sum(H, na.rm = TRUE) / sum(AB, na.rm = TRUE), ab = sum(AB, na.rm = TRUE))
```

```{r}
batters %>% filter(ab > 100) %>% ggplot(mapping = aes(x = ab, y = ba)) + 
  geom_point() + 
  geom_smooth(se = FALSE)
```


```{r}
batters %>%
  arrange(desc(ba))
```
#### 5.6.4 Useful Summary Functions
```{r}
not_cancelled %>%
  group_by(year, month, day) %>%
  summarise(
    avg_delay1 = mean(arr_delay),
    avg_delay2 = mean(arr_delay[arr_delay>0])
  )
```

```{r}
not_cancelled %>% 
  group_by(dest) %>% 
  summarise(distance_sd = sd(distance)) %>%
  arrange(desc(distance_sd))
```

```{r}
# When do the first and last flights leave each day?
not_cancelled %>%
  group_by(year, month, day) %>%
  summarise(
    first = min(dep_time),
    last = max(dep_time)
  )
```

```{r}
# Select the first element
first(not_cancelled$arr_delay)

# Select the last element
last(not_cancelled$arr_delay)

# Select the nth element
nth(not_cancelled$arr_delay, 3)

# Selecting the 3rd element of the arr_delay array
not_cancelled$arr_delay[4]

# Selecting the 1st column of the not_cancelled dataframe
not_cancelled[1]

```

```{r}
not_cancelled %>%
  group_by(year, month, day) %>%
  mutate(r = min_rank(desc(dep_time))) %>%
  filter(r %in% range(r))
```

```{r}

not_cancelled %>%
  group_by(year, month, day) %>%
  mutate(r = min_rank(desc(dep_time))) %>%
  filter(r %in% range(r))

```
```{r}

not_cancelled %>%
  group_by(year, month, day) %>%
  mutate(r = min_rank(desc(dep_time))) %>%
  filter(r %in% range(r))
```

```{r}
not_cancelled %>%
  group_by(year, month, day) %>%
  mutate(r = min_rank(desc(dep_time))) %>%
  filter(r %in% range(r))
```

```{r}
 not_cancelled %>%
  group_by(year, month, day) %>%
  mutate(r = min_rank(desc(dep_time))) %>%
  filter(r %in% range(r))
```

```{r}
not_cancelled %>%
  group_by(year, month, day) %>%
  mutate(r = min_rank(desc(dep_time))) %>%
  filter(r %in% range(r))
```

```{r}
 not_cancelled %>%
  group_by(year, month, day) %>%
  mutate(r = min_rank(desc(dep_time))) %>%
  filter(r %in% range(r))
```

```{r}
# sum(!is.na(x)) # number of non-missing values

not_cancelled_greatest_dep_time <- not_cancelled %>%
  group_by(year, month, day) %>%
  mutate(r = min_rank(desc(dep_time))) %>%
  filter(r %in% range(r))

(not_cancelled_greatest_dep_time)

sum(!is.na(not_cancelled_greatest_dep_time)) # number of non-missing values

sum(!is.na(not_cancelled_greatest_dep_time)) # number of non-missing values

sum(!is.na(not_cancelled_greatest_dep_time)) # number of non-missing values 

sum(!is.na(not_cancelled_greatest_dep_time)) # number of non-missing values 

sum(!is.na(not_cancelled_greatest_dep_time)) # number of non-missing values 

n_distinct(not_cancelled_greatest_dep_time) # count the number of distinct values

n_distinct(not_cancelled_greatest_dep_time) # count the number of distinct values

n_distinct(not_cancelled_greatest_dep_time) # count the number of distinct values

n_distinct(not_cancelled_greatest_dep_time) # count the number of distinct values

n_distinct(not_cancelled_greatest_dep_time) # count the number of distinct values

n_distinct(not_cancelled_greatest_dep_time) # count the number of distinct values

n_distinct(not_cancelled_greatest_dep_time) # count the number of distinct values

```

```{r}
# Count
not_cancelled %>%
  count(dest)
```

```{r}
 not_cancelled %>% 
  count(dep_time)
```

```{r}
# counting the total number of miles a plane flew
not_cancelled %>%
  count(tailnum, wt = distance)
```

```{r}
not_cancelled
```


```{r}
 not_cancelled %>%
  count(tailnum, wt = day)
```

```{r}
not_cancelled %>% 
  group_by(year, month, day) %>%
  summarise(n_early = sum(dep_time > 500))
```

```{r}

# Summary will peel off one layer of grouping for each call

daily <- group_by(flights, year, month, day)

(per_day <- summarise(daily, flights = n())) # counting the number of flights each day

(per_month <- summarise(per_day, flights = sum(flights))) # summing the number of flights in the day column for each group month


(number_of_months_in_a_year <- summarise(per_month, flights = n())) # The count of the number of months in a year

(per_year <- summarise(per_month, flights = sum(flights))) # The sum of the flights for all the months for all the days in a given year. 

# This takes the sum of all the flights. 
daily %>%
  ungroup() %>%            # no longer grouped by date
  summarise(flights = n()) # all flights

```

#### 5.6.7 Exercises
```{r}
# arrival delay & departure delay are equally as important; You cannot distinguish the reason for a delay based on the fact that the plane is late or early.

not_cancelled %>% group_by(dest) %>% summarise(n())

not_cancelled %>% group_by(tailnum, distance) %>% summarise(distance = n())

# dep_delay could still exist even if the flight is canceled. Because there is a delay does not mean the entire flight is cancelled. The columns are equally important.

cancelled_flights_per_day <- filter(flights, is.na(dep_delay)) %>% group_by(day) %>% count()

average_delay <- flights %>% group_by(day) %>% summarise(avg_delay = mean(arr_delay, na.rm = TRUE))

cancelled_flights_per_day_average_delay<- mutate(average_delay, cancelled_flights_per_day) %>% rename(cancelled_flights_per_day = n)

# cancelled_flights_per_day_average_delay <- rename(temp, cancelled_flights_per_day = n)

cancelled_flights_per_day_average_delay <- mutate(cancelled_flights_per_day_average_delay, proportion = cancelled_flights_per_day / avg_delay)

#count(flights, is.na(dep_delay)) 

```

```{r}
ggplot(cancelled_flights_per_day_average_delay) + 
  geom_point(aes(x = day, y = avg_delay)) +
  geom_smooth(aes(x = day, y = proportion), se = FALSE) +
  ylab("Average Delay") +
  labs(title = "Proportion of cancelled flights with respect to average delay")
```

```{r 5.6.7.5 which carrier has the worst delays}
# Which carrier has the worst delays?
carrier_delays_ranked <- nycflights13::flights

(carrier_delays_ranked <- carrier_delays_ranked %>% mutate(ranked_delay = min_rank(desc(arr_delay))) %>% select (ranked_delay, carrier, everything()) %>% arrange(ranked_delay))

filter(carrier_delays_ranked, ranked_delay < 6)
```

```{r}
carrier_delays_ranked
```


```{r}
# 5.6.7.5 disentangle the effects of bad airports vs. bad carriers
# Which carrier has the worst delays? Challenge: can you disentangle the effects of bad airports vs. bad carriers? Why/why not? (Hint: think about flights %>% group_by(carrier, dest) %>% summarise(n()))

# compare the average of arrival delays to a destination vs the average of delays by carrier

# temp <- carrier_delays_ranked %>% group_by(carrier, dest) %>% summarise(n())

average_carrier_delays <- carrier_delays_ranked %>% group_by(carrier) %>% summarise(average_carrier_delay = mean(arr_delay, na.rm = TRUE))

average_dest_delays <- carrier_delays_ranked %>% group_by(dest) %>% summarise(average_destination_delay = mean(arr_delay, na.rm = TRUE))

(top_ten_greatest_delays <- carrier_delays_ranked %>% select(ranked_delay, carrier, dest) %>% filter(ranked_delay < 10))

(average_carrier_delays)

(average_dest_delays)

(first_obs <- filter(first(top_ten_greatest_delays)))
filter(average_carrier_delays, carrier == "HA")
filter(average_dest_delays, dest == "HNL")

# carrier_str <- str(first_obs["carrier"])
# filter(average_carrier_delays, carrier == carrier_str)
```


```{r}
# 5.6.7.5 disentangle the effects of bad airports vs. bad carriers
# The number of late arrivals / total flights by carrier


(arrival_delays_greater_than_zero_grouped_by_carrier <- carrier_delays_ranked %>% group_by(carrier) %>% count(late_arrival = arr_delay > 0) %>% filter(late_arrival == TRUE) %>% select(carrier, n) %>% rename(late_arrival = n))

(total_number_of_flights_by_carrier <- carrier_delays_ranked %>% group_by(carrier) %>% summarise(n()) %>% rename(total_flight = `n()`))

# master_df <- data.frame(arrival_delays_greater_than_zero_grouped_by_carrier, total_number_of_flights_by_carrier)

(arrival_delays_greater_than_zero_grouped_by_carrier$late_arrival /total_number_of_flights_by_carrier$total_flight)
(arrival_delays_greater_than_zero_grouped_by_carrier$carrier)

proportion_late_arrivals_total_flights_by_carrier <- data.frame(arrival_delays_greater_than_zero_grouped_by_carrier$carrier, 
           arrival_delays_greater_than_zero_grouped_by_carrier$late_arrival,
           total_number_of_flights_by_carrier$total_flight, 
           arrival_delays_greater_than_zero_grouped_by_carrier$late_arrival /total_number_of_flights_by_carrier$total_flight)

proportion_late_arrivals_total_flights_by_carrier <- proportion_late_arrivals_total_flights_by_carrier %>% rename(carrier = arrival_delays_greater_than_zero_grouped_by_carrier.carrier, late_arrival = arrival_delays_greater_than_zero_grouped_by_carrier.late_arrival, total_flight = total_number_of_flights_by_carrier.total_flight, proportion_late_arrivals = arrival_delays_greater_than_zero_grouped_by_carrier.late_arrival.total_number_of_flights_by_carrier.total_flight)
```

```{r}
proportion_late_arrivals_total_flights_by_carrier
```

```{r}
# 5.6.7.5 disentangle the effects of bad airports vs. bad carriers
# The number of late arrivals / total flights to destination

(arrival_delays_greater_than_zero_dest <- carrier_delays_ranked %>% group_by(dest) %>% count(late_arrival = arr_delay > 0) %>% filter(late_arrival == TRUE) %>% select(dest, n) %>% rename(late_arrival = n))

(total_number_of_flights_by_dest <- carrier_delays_ranked %>% group_by(dest) %>% summarise(n()) %>% rename(total_flight = `n()`) %>% filter(dest != 'LEX' & dest != 'LGA'))



(proportion_late_arrivals_total_flights_by_dest <- data.frame(total_number_of_flights_by_dest$dest, arrival_delays_greater_than_zero_dest$late_arrival, total_number_of_flights_by_dest$total_flight, arrival_delays_greater_than_zero_dest$late_arrival / total_number_of_flights_by_dest$total_flight))

```

```{r}
proportion_late_arrivals_total_flights_by_dest
```


```{r}
proportion_late_arrivals_total_flights_by_dest <- proportion_late_arrivals_total_flights_by_dest %>% 
  rename(dest = total_number_of_flights_by_dest.dest,
         late_arrival = arrival_delays_greater_than_zero_dest.late_arrival,
         total_flight = total_number_of_flights_by_dest.total_flight,
         proportion_late_arrivals = arrival_delays_greater_than_zero_dest.late_arrival.total_number_of_flights_by_dest.total_flight
         )
```
```{r}
proportion_late_arrivals_total_flights_by_dest
```

```{r}
# 5.6.7.5 disentangle the effects of bad airports vs. bad carriers

(first_obs <- filter(first(top_ten_greatest_delays)))
filter(average_carrier_delays, carrier == "HA")
filter(average_dest_delays, dest == "HNL")
filter(proportion_late_arrivals_total_flights_by_dest, dest == "HNL")
filter(proportion_late_arrivals_total_flights_by_carrier, carrier == "HA")

# The proportion of late arrivals for the HNL dest is greater than the proportion of late arrivals for the HA carrier. Furthermore, the average carrier delay for the HA carrier is much less than the HNL destination. Therefore, the reason the reason the majority of late arrivals is from the HA carrier to the HNL destination is most likely because of the HNL destination, not because of the HA Carrier. This analysis could be done with a function for each pair in the ranked list of late arrivals. 

```


```{r}
# 6
# if sort is true, then count(sort= True) will show the largest groups at the top; only works for atomic and list types
starwars %>% count(sex, gender, species, sort = TRUE)
```
### 5.7 Grouped mutates and filters

```{r}
# Quesion 1
# Grouped mutates vs a normal mutate:
# Grouped mutates will aggregate all values together in a group for all columns
# normal mutates will alter the values by individual observations, leaving each column as a representation of a single observation 
flights_sml <- select(flights, 
                      year:day, 
                      ends_with("delay"),
                      distance, 
                      air_time
                      )
```


```{r Normal mutate}
mutate(flights_sml, 
       gain = dep_delay - arr_delay, 
       speed = distance / air_time * 60
       )
```


```{r }
flights_sml %>%
  group_by(year, month, day) %>%
  filter(rank(desc(arr_delay)) < 10)
```


```{r which plane has the worst on-time record }
# tailnum N384HA has the worst on-time record
worst_on_time_record <- nycflights13::flights
  names(flights)
worst_on_time_record <- flights %>% select(-delay_rank, everything())
worst_on_time_record %>% select(delays, tailnum, everything()) %>% arrange(desc(delays))
```


```{r What time of day should you fly if you want to avoid delays as much as possible}
n_no_delay <- flights %>% group_by(sched_dep_time) %>% filter(delays <= 0) %>% summarise(delays) %>% count(sched_dep_time)
sched_dep_time_no_delay_list <- unique(n_no_delay$sched_dep_time)

n_delay_min <- flights %>% group_by(sched_dep_time) %>% filter(delays > 0) %>% summarise(delays) %>% count(sched_dep_time) %>% arrange(n)
sched_dep_time_delay_list <- unique(n_delay_min$sched_dep_time)

length(sched_dep_time_no_delay_list)
length(sched_dep_time_delay_list)

flights_to_find <- sched_dep_time_no_delay_list %in% sched_dep_time_delay_list

scheduled_flights_with_no_delays <- sched_dep_time_delay_list[flights_to_find == FALSE]

# n_no_delay %>% filter(sched_dep_time == 232)
# n_no_delay %>% filter(sched_dep_time == 225)
```

```{r}
flights %>% select(dest, everything())
```

```{r}
flights
```
```{r}
not_cancelled <- flights %>% filter(!is.na(dep_delay) | !is.na(arr_delay))
```


```{r for each destination compute the total minutes of delay}
total_minutes_of_delay <- not_cancelled %>% filter(!is.na(delays))
(delays_greater_than_zero <- total_minutes_of_delay %>% filter(delays > 0) %>% filter(!is.na(delays)))

(total_minutes_of_delay_per_destination <- delays_greater_than_zero %>% group_by(dest) %>% filter(!is.na(delays)) %>% summarise(sum_delays = sum(delays)) %>% arrange(desc(dest)))

total_minutes_of_delay_per_destination 

```


```{r  For each flight compute the proportion of total delay for its destination}

delays_greater_than_zero_group_by_flights_dest <- delays_greater_than_zero %>% group_by(flight, dest) %>% select(flight, dest, delays, everything())

left_join(delays_greater_than_zero_group_by_flights_dest, total_minutes_of_delay_per_destination, by=c('dest')) %>% mutate(proportion_delay_per_dest = delays/sum_delays) %>% select(flight, dest, delays, sum_delays, proportion_delay_per_dest, everything()) 

```

```{r}
# Explore how the delay of a flight is related to the delay of an immediately preceding flight
# how lag works
# (x <- seq(1, 10))
# (x_lag <- lag(x))
# x - x_lag

###
comparison_of_flight_delay <- nycflights13::flights

dep_time_hours <- comparison_of_flight_delay$dep_time %/% 100
dep_time_minutes <- comparison_of_flight_delay$dep_time %% 100
dep_time_min_since_midnight <- (dep_time_hours * 60) + (dep_time_minutes)
comparison_of_flight_delay$dep_time_min_since_midnight <- dep_time_min_since_midnight

comparison_of_flight_delay$total_delay <- comparison_of_flight_delay$dep_delay + comparison_of_flight_delay$arr_delay

names(comparison_of_flight_delay)
head(comparison_of_flight_delay)
```


```{r}
# Explore how the delay of a flight is related to the delay of an immediately preceding flight
comparison_of_flight_delay<- comparison_of_flight_delay %>%
  select(year, month, day, flight, sched_dep_time, dep_time, total_delay, dep_time_min_since_midnight, sched_arr_time, everything()) %>% arrange(year, month, day, sched_dep_time)


# comparison_of_flight_delay %>% select(dep_delay, flight, everything())
# (comparison_of_flight_delay)
```


```{r}
# Explore how the delay of a flight is related to the delay of an immediately preceding flight
(comparison_of_flight_delay_no_na <- comparison_of_flight_delay %>% filter(!is.na(dep_delay)))
```


```{r}
# Explore how the delay of a flight is related to the delay of an immediately preceding flight
# After increase in the difference of delays between prior flights, there is a decrease in  of nearly the same magnitude from zero. It appears as if the planes are making up time lost from the previous delays by leaving early. 

# (comparison_of_flight_delay_no_na)
n_points = 100

print("delay_first")
(delay_first <- comparison_of_flight_delay$dep_delay[1:n_points])

print("lag_delay_first")
(lag_delay <- lag(comparison_of_flight_delay$dep_delay[1:n_points]))
# (lag_delay_sum <- (delay_first + lag_delay))

print("lag_delay_difference")
(lag_delay_difference <- ( delay_first- lag_delay))
```


```{r}
# Explore how the delay of a flight is related to the delay of an immediately preceding flight
ggplot()+
  geom_jitter(aes(x = seq(1:length(lag_delay_difference)), y = lag_delay_difference))
  geom_smooth(aes(x = length(lag_delay_difference), y = lag_delay_difference))
# (lag_delay_difference)

# lag_delay_difference_no_NA <- lag_delay_difference[2:15]

# typeof(lag_delay_difference_no_NA)

# cumsum(lag(lag_delay_difference_no_NA))
# cumsum(1:15)

# comparison_of_flight_delay_no_na$flight
```
```{r 6: can you find flights that are suspiciously fast?}
fast_flights <- comparison_of_flight_delay_no_na
head(fast_flights)
```


```{r 6.1: can you find flights that are suspiciously fast?}
fast_flights <- fast_flights %>% mutate(air_time_hour = (air_time / 60), mph = distance / air_time_hour)
(fast_flights_arranged <- fast_flights %>% select(distance, air_time_hour, mph, flight, everything()) %>% arrange(desc(mph)))

boxplot(fast_flights_arranged$mph, horizontal = TRUE, main = "mph")

IQR(fast_flights_arranged$mph, na.rm = TRUE)
quantile(fast_flights_arranged$mph, na.rm = TRUE)
outlier_range = 1.5 * (iqr <- 438.1509 - 358.0892)

median = 404.1509 

q3 <- 438.8235

outlier_bound <- outlier_range + q3
```


```{r 6.3: can you find flights that are suspiciously fast?}
(proportional_air_time <- fast_flights_arranged 
 %>% filter(!is.na(air_time_hour)) 
 %>% group_by(flight, dest)
 %>% summarise(air_time_hour_min = min(air_time_hour), air_time_hour_max = max(air_time_hour, rm.na = TRUE), air_time_hour_mean = mean(air_time_hour)) 
 %>% mutate(air_time_max_per_min = air_time_hour_max / air_time_hour_min, air_time_hour_range = air_time_hour_max - air_time_hour_min) %>% select(dest, air_time_max_per_min, air_time_hour_max, air_time_hour_min, air_time_hour_range, air_time_hour_mean) %>% arrange(desc(air_time_max_per_min)))

# These are the flights in order to greatest to least proportional air time. 
proportional_air_time %>% arrange(desc(air_time_max_per_min)) %>% select(air_time_max_per_min, flight, dest, everything()) 

boxplot(proportional_air_time$air_time_max_per_min, horizontal = TRUE, na.rm = TRUE, main = "Proportional Time in Air Relative to Shortest Flight")
quantile(proportional_air_time$air_time_max_per_min)
median <- 1.179104
q1 <- 1.033333
q3 <- 1.352941
iqr <- q3 - q1
upper_outlier_range <- 1.5 * iqr

### Flights that are proportional outliers (Answer)
proportional_air_time %>%
  filter(air_time_max_per_min > (q3 + upper_outlier_range)) %>%
  group_by(flight) %>%
  arrange(desc(air_time_max_per_min)) %>%
  select(flight, dest, air_time_max_per_min, air_time_hour_max, air_time_max_per_min, everything())

```


```{r 6.4: can you find flights that are suspiciously fast?}
# Extra
outlier_list <- fast_flights_arranged %>% filter(mph > outlier_bound) %>% arrange(desc(mph))
proportional_air_time %>% filter(flight %in% outlier_list$flight) %>% arrange(desc(air_time_hour_range), flight)
```
```{r 7.1 Find all destinations that are flown by at least two carriers. Use that information to rank the carriers.}
flights_two_carriers <- nycflights13::flights
head(flights_two_carriers)
```

```{r 7.2 Find all destinations that are flown by at least two carriers. Use that information to rank the destinations.}
# Answer
dest_two_carriers <- nycflights13::flights
dest_two_carriers_by_carrier <- dest_two_carriers %>% group_by(dest, carrier) %>% select(dest, carrier, everything()) %>% summarise()
dest_two_carriers_by_carrier %>% mutate(dest_count = as.numeric(as.factor(dest))) %>% summarise(n_carriers_per_dest = sum(dest_count)) %>% select(dest, n_carriers_per_dest) %>% filter(n_carriers_per_dest > 2) %>% mutate(rank_carriers_per_dest = min_rank(n_carriers_per_dest)) %>% arrange(rank_carriers_per_dest)
```


```{r 7.3 Find all destinations that are flown by at least two carriers. Use that information to rank the carriers.}
# carriers_by_flight <- flights_two_carriers %>% group_by(flight, carrier) %>% select(flight, carrier, everything()) %>% summarise()
# carriers_by_flight %>% group_by(flight) %>% summarise(number_of_carriers = sum(flight)) %>% filter(number_of_carriers > 2) %>% mutate(rank = min_rank(desc(number_of_carriers))) %>% arrange(rank) %>% select(rank, flight, number_of_carriers, everything())
# 
# 
# carriers_by_dest <- dest_two_carriers %>% group_by(flight, carrier) %>% select(flight, carrier, everything()) %>% summarise()
# 
# carriers_by_flight %>% group_by(flight) %>% summarise(number_of_carriers = sum(flight)) %>% filter(number_of_carriers > 2) %>% mutate(rank = min_rank(desc(number_of_carriers))) %>% arrange(rank) %>% select(rank, flight, number_of_carriers, everything())

```


```{r}
# For each plane, count the number of flights before the first delay of greater than 1 hour
  n_flights_before_first_delay_greater_than_1_hour <- comparison_of_flight_delay
```


```{r}
# For each plane, count the number of flights before the first delay of greater than 1 hour
  n_flights_before_first_delay_greater_than_1_hour
```


```{r}
# For each plane, count the number of flights before the first delay of greater than 1 hour
first_time_dep_delay_is_greater_than_one_hour <- first(n_flights_before_first_delay_greater_than_1_hour %>% group_by(year, month, day, sched_dep_time) %>% filter(dep_delay > 60) %>% arrange(year, month, day, sched_dep_time))

(first_time_dep_delay_is_greater_than_one_hour)
# (first_time_dep_delay_is_greater_than_one_hour$sched_dep_time)
```


```{r}
# For each plane, count the number of flights before the first delay of greater than 1 hour
### Answer
n_flights_before_first_delay_greater_than_1_hour %>% group_by(year, month, day, sched_dep_time) %>% filter(
  sched_dep_time < first_time_dep_delay_is_greater_than_one_hour$sched_dep_time & 
    year <= first_time_dep_delay_is_greater_than_one_hour$year & 
    month <= first_time_dep_delay_is_greater_than_one_hour$month & 
    day <= first_time_dep_delay_is_greater_than_one_hour$day
  ) %>% arrange(sched_dep_time)
# nth(n_flights_before_first_delay_greater_than_1_hour <- n_flights_before_first_delay_greater_than_1_hour %>% group_by(year, month, day, sched_dep_time), 2)

```



## Section 7.3 Variation

#### Section 7.3.4 Exercise:

```{r}
head(diamonds)
```


```{r 1. Explore the distribution of each of the x, y, and z variables in diamonds. }
# The z axis is depth, the x & y axis are length and width.
ggplot(diamonds) + 
  geom_freqpoly(aes(x), color = "red", bins = 50) +
  geom_freqpoly(aes(y), color = "green", bins = 50, linetype = "dashed") + 
  geom_freqpoly(aes(z), color = "blue", bins = 50)
```

```{r 2. Explore the distribution of price}
# There are no diamonds worth 1500. There are fewer diamonds worth 3000 - 4000 that 2000 - 3000 or 4000 - 5000.
ggplot(diamonds, aes(price)) + 
  geom_freqpoly(color = "darkgreen", binwidth = 20) +
  coord_cartesian(x = c(0, 6000))

```

```{r 3.}
# There are 1500 diamonds that are 0.99 carat & 1500 diamonds that are 1.0 carat 
# ggplot(diamonds, aes(carat)) + 
#   geom_freqpoly(color = "darkgreen", binwidth = .01) +
#   xlim(x = c(0, 1.1)) + 
#   ylim(y = c(0, 3000))

# ggplot(diamonds, aes(carat)) + 
#   geom_freqpoly(color = "darkgreen", binwidth = .01) +
#   xlim(x = c(0, 1.5)) + 
#   ylim(y = c(0, 3000))

ggplot(diamonds, aes(carat)) + 
  geom_freqpoly(color = "darkgreen") 
  # xlim(x = c(0, 1.5)) + 
  # ylim(y = c(0, 3000))

```

```{r 4. }
# If you leave binwidth unset then the default binwidth of 30 will be used. If you try and zoom so only half a bar shows, then your bin width is too large for your current resolution & you need to scale it down so that you can view more points. 
```


## Section 7.4 Missing values

```{r}
diamonds %>% mutate(y_m = ifelse(y < 3 | y > 20, NA, y)) %>% select(y, y_m, everything()) %>% arrange(y)
```


```{r}
# Drop values 
diamonds %>% filter(between(y, 3, 20))
# diamonds2 %>% select(y, everything()) %>% arrange(desc(y))
```


```{r}
# replace missing values
diamonds3 <- diamonds %>% mutate(y = ifelse(y < 3 | y > 20, NA, y))
(diamonds3 %>% select(y, everything()) %>% arrange(y))
```

## Section 7.4.1 Exercises
```{r}
diamonds2 <- diamonds %>% select(y, everything()) %>% arrange(desc(y))
```


```{r}
# Quesion 1
# The default missing values are removed with a warning win geom_hist. This is the same as with geom_bar. There is no difference.

ggplot(diamonds2) +
  geom_histogram(aes(y), na.rm = TRUE)
```

```{r}
# Quesion 2
# It removes values that are NA.
```


## Section 7.5 Covariation
```{r}


```

## Section 7.5.1.1 Exercises

```{r}
# Quesion 1
nycflights13::flights %>% 
  mutate(
    cancelled = is.na(dep_time),
    sched_hour = sched_dep_time %/% 100,
    sched_min = sched_dep_time %% 100,
    sched_dep_time = sched_hour + sched_min / 60
  ) %>% 
  ggplot(mapping = aes(sched_dep_time, y = after_stat(density))) + 
    geom_freqpoly(mapping = aes(colour = cancelled), binwidth = 1/4)
```

```{r}
# Quesion 2
diamonds
```


```{r}
# Quesion 2.1

ggplot(data = diamonds, mapping = aes(x = price, y = after_stat(density))) + 
  geom_freqpoly(mapping = aes(colour = cut), binwidth = 500) 
    # geom_freqpoly(mapping = aes(colour = color), binwidth = 500) 

# ggplot(data = diamonds, mapping = aes(x = price, y = after_stat(density))) + 
#   geom_freqpoly(mapping = aes(colour = color), binwidth = 500)

```
```{r}
# Quesion 3
if(!require("ggstance")) install.packages("ggstance")
library(ggstance)



```



```{r}
# Load ggplot2 package
library(ggplot2)

# Create a sample data frame
set.seed(123)
df <- data.frame(value = rnorm(100))

# Create a frequency polygon with a specified color
ggplot(df, aes(x = value)) +
  geom_freqpoly(color = "green") +
  ggtitle("Frequency Polygon with Custom Color")
```

## Section 7.5.2 Two Categorical Variables

```{r}
diamonds %>%
  count(color, cut) %>% mutate( n = n*.5)
```


```{r}
ggplot(data = diamonds) +
  geom_count(aes(cut, color))
```



### Section 7.5.2 Exercises
```{r 1. How could you rescale the count dataset above to more clearly show the distribution of cut within colour, or colour within cut?}
# I don't understand this question.
diamonds_half_scale <- diamonds %>%
  count(color, cut) %>% mutate( n = n*.5)
```

```{r}
#  1.1
ggplot(data = diamonds_half_scale) +
  geom_count(aes(cut, color))
```

```{r}
# Explore how average flight delays vary by destination and month of year
(dest_month_avg_delay <- flights %>% group_by(month, dest) %>% select(dest, month, everything()) %>% summarise(avg_delay = mean(delays, na.rm = TRUE)))
```


```{r}
# Explore how average flight delays vary by destination and month of year
# There are too many destinations related to individual months. It could be improved by limiting the number of destinations on a given graph. 
ggplot(dest_month_avg_delay) + 
  geom_tile(aes(month, dest, fill = avg_delay))

```

```{r}
# 3 Why is it slightly better to use aes(x = color, y = cut) rather than aes(x = cut, y = color) in the example above
# There are increasing levels of quality from left to right. 
```

## Section 7.5.3 Two Continuous Variables
```{r}
# To use geom_hex
if(!require("hexbin")) install.packages("hexbin")
library(hexbin)
```

```{r}
smaller <- diamonds %>%
  filter(carat < 3)
```


```{r}
ggplot(data = smaller) +
  geom_bin2d(mapping = aes(x = carat, y = price))

ggplot(data = smaller) + 
  geom_hex(aes(carat, price))
```
```{r}
# Display the number of points contained within a boxplot with varwidth = True; 
# Display the same number of points in each bin with cut_number()

ggplot(data = smaller, mapping = aes(x = carat, y = price)) +
  geom_boxplot(aes(group = cut_number(carat, 20)))
```

### Section 7.5.3.1 Exercises
```{r 1. What do you need to consider when using cut_width() vs cut_number()? How does that impact a visualisation of the 2d distribution of carat and price?}
 # Cut width divides a variable into bins of a specified width. This will change the statistics of each boxplot-bin while keeping the width of the bin constant.
  # Cut number defines the number of points that are allocated to a bin. The width of each bin in this case will vary, but the number of points in each bin will remain constant.

# When using a frequency polygon, it is important to consider that cut width will divide the bins into a specified width. This means that a frequency polygon would have a specified density and a variable number of points for that density. This would increase the count of points per density for each point on the graph which would be visible by the height of the line on the frequency polygon.  With cut number, the width of each bin will vary, but the number of points in each bin will be the same. This would result in a line that has periods of wide girth followed by sharp spikes in count.
```

```{r 2 Visualize the distribution of carat partitioned by price}
ggplot(data = smaller, mapping = aes(x = carat)) +
  geom_freqpoly(aes(group = cut_number(price, 20))) +
  labs(title = "Cut Number Freqpoly: Constant Number of Price Points Per Polygon")

ggplot(data = smaller, mapping = aes(x = carat)) + 
  geom_freqpoly(aes(group = cut_width(price, 20))) +
  labs(title = "Cut Width Freqpoly: Constant Width of Price Points Per Polygon")

ggplot(data = smaller, aes(carat)) +
  geom_freqpoly() +
  labs(title = "Standard Freqpoly")

# ggplot(data = smaller, mapping = aes(x = price)) +
#   geom_freqpoly(aes(group = cut_number(price, 20))) +
#   labs(title = "Price: Cut Number Freqpoly (Number of Points is Constant)")
# 
# ggplot(data = smaller, mapping = aes(x = price)) +
#   geom_freqpoly(aes(group = cut_width(price, 20))) +
#   labs(title = "Price: Cut Width Freqpoly (Width is Constant)")
# 
# ggplot(data = smaller, aes(price)) +
#   geom_freqpoly() +
#   labs(title = "Price: Standard Freqpoly")
```
```{r 3 How does the price distribution of very large diamonds compare to small diamonds. Does it surprise you?}
# The price distribution is greater for large diamonds as compared to small diamonds. This does not surprise me.
```

```{r}
# Quesion 4
ggplot(data = smaller) + 
  geom_hex(aes(carat, price))
```
```{r}
# Quesion 5
# It is clear to see that there are outliers in a scatter plot as they are single points that are differentiated from the group. In a binned plot this would be indicated by a bin that was abnormally stretched. Without a reference group, normalcy of a binned plot's bin shape is speculative, whereas in a scatterplot, the majority of point grouping may be clearly defined.
```

## Section 10: Tibbles
```{r}
as_tibble(iris)
```
```{r}
tibble(
  x = 1:5,
  y = 1, 
  z = x ^ 2 + y
)
```

```{r}
tb <- tibble(
  `:)` = "smile",
  ` ` = "space",
  `2000` = "number"
)
tb[["newcol"]] = "value"
```


```{r}
tribble(
  ~x, ~y, ~z,
  #--|--|----
  "a", 2, 3.6,
  "b", 1, 8.5
)
```
```{r eval = FALSE}
nycflights13::flights %>% View()
```


```{r}
# Width = Inf will display all the columns
# print( n = number) will determine The number of of rows of the display
nycflights13::flights %>% print(n = 10, width = Inf)
```

## Section 10.3.2 Subsetting
```{r}
df <- tibble(
  x = runif(5),
  y = rnorm(5)
)
```

```{r}
# Extract by Name
df$x
```


```{r}
# Extract by Name
df[["x"]]
```

```{r}
# Extract by position
df[[1]]
```
```{r}
# Similar to selecting x with a pipe
df["x"]
```
```{r}
# Extracting data with a pipe
df %>% .$x
df %>% .[["x"]]
```


# 10.5 exercises
```{r 1. How can you tell if an object is a tibble?}
# The description will be of "df" or "tibble" on a print of the data
# using class will allow you to view the type of the data whether it be a dataframe of a tibble
class(mtcars)
class(tb)
# print(mtcars)
```

```{r}
# Quesion 2
# The default data frame behaviors assign the value of "a" to x, y, and z rather than "xyz"
df <- data.frame(abc = 1, xyz = "a")
```
```{r}
df
```


```{r}
# Quesion 2.1
df$x
```


```{r}
#  2.2
df[, "xyz"]
```


```{r}
#  2.3
df[, c("abc", "xyz")]
```
```{r}
var <- "mpg"

tb1<- tibble(
  mpg = "123",
  abc = c("alphabet", "alphabet2")
)

tb1["abc"] # select the column (returned data is a tibble)
tb1[["abc"]] # select the values of column "abc" (returned data is the type of the returned data)
```
```{r}
# Quesion 4
annoying <- tibble(
  `1` = 1:10,
  `2` = `1` * 2 + rnorm(length(`1`))
)

annoying[["1"]]
annoying[["2"]]

ggplot(annoying) + 
  geom_point(aes(`1`, `2`))

annoying[["3"]] = annoying[["2"]] / annoying[["1"]]

(annoying)


annoying <- annoying %>% rename("one" = `1`, "two" = `2`, "three" = `3`)
annoying
```

```{r}
# Quesion 5
# tibble::enframe will frame data in tibble format. i.e.
# enframe(1:3) produces a tibble
# deframe will extract the data from the tibble, using the class of the data itself as the type of data: i.e.
val <- deframe(enframe(1:3))
class(val)
val
val[1]

```
```{r}
# Quesion 6
# max footer lines controls how many extra lines are printed at the footer of a tibble
```


## Section 11: Data Import

```{r}
# e_woods_matrix <- read_csv("trait_matrix.xlsx - Sheet 1.csv")
# deepa_matrix <- read_csv("Candidate Rankings.xlsx - Sheet1.csv")
# health <- read_csv("HealthAutoExport-2023-10-29-2023-11-05.json")
# eye_classification <- read_csv("EEG_Eye_State_Classification.csv")

# Define the character as na
read_csv("a,b,c\n1,2,.", na=".")

# Drop lines that start with a comment
read_csv("# this is a comment\na,b,c\n1,2,.", comment = "#", na = ".")
read_csv("# this is a comment
         This is the second line of data
         \na,b,c\n1,2,.", comment = "#", na = ".")
# Passing column names as a character vector
read_csv("1,2,3\n4,5,6,", col_names = c("x", "y", "z"))

```
#### 11.2.2 Exercises
```{r}
# read_delim will be used for "|" delimited files
# read_csv and read_tsv have all arguments in common.
# The most important arguments to read_fwf() are the file, col_positions, and col_types
# pass in quote to read_csv to specify quotes

# 5 there are only two columns
read_csv("a,b\n1,2,3\n4,5,6") # reads this as a:1 , b:23

# the column rows are not the same
read_csv("a,b,c\n1,2\n1,2,3,4") # column c on row 1 is NA and 34 on row 2

#

```
### 11.3 Parsing
```{r}
 # All data can be parsed. The types of parsing includes:
# parse_number
# parse_character
# parse_factor
# parse_datetime
# parse_logical
# parse_double

# Parsing will handle character encodings, and locale so as to represent clean data. 

# use guess_encoding() to guess the encoding of a character string
```

#### 11.3.5 Exercises
```{r}
# The most important arguments to locale are date_names, date_format, decimal_mark, & tz

# There is an error that decimal_mark & grouping mark must be different if both are the same. 
#parse_double("1,23", locale = locale(decimal_mark = ",", grouping_mark = (",")))

# 
parse_date("01/02/15", "%m/%d/%y")

```

### Section 12: Tidy Data

### Section 12.2.1 Exercises:

```{r}
table1
#> # A tibble: 6 × 4
#>   country      year  cases population
#>   <chr>       <dbl>  <dbl>      <dbl>
#> 1 Afghanistan  1999    745   19987071
#> 2 Afghanistan  2000   2666   20595360
#> 3 Brazil       1999  37737  172006362
#> 4 Brazil       2000  80488  174504898
#> 5 China        1999 212258 1272915272
#> 6 China        2000 213766 1280428583
table2
#> # A tibble: 12 × 4
#>   country      year type           count
#>   <chr>       <dbl> <chr>          <dbl>
#> 1 Afghanistan  1999 cases            745
#> 2 Afghanistan  1999 population  19987071
#> 3 Afghanistan  2000 cases           2666
#> 4 Afghanistan  2000 population  20595360
#> 5 Brazil       1999 cases          37737
#> 6 Brazil       1999 population 172006362
#> # ℹ 6 more rows
table3
#> # A tibble: 6 × 3
#>   country      year rate             
#>   <chr>       <dbl> <chr>            
#> 1 Afghanistan  1999 745/19987071     
#> 2 Afghanistan  2000 2666/20595360    
#> 3 Brazil       1999 37737/172006362  
#> 4 Brazil       2000 80488/174504898  
#> 5 China        1999 212258/1272915272
#> 6 China        2000 213766/1280428583

# Spread across two tibbles
table4a  # cases
#> # A tibble: 3 × 3
#>   country     `1999` `2000`
#>   <chr>        <dbl>  <dbl>
#> 1 Afghanistan    745   2666
#> 2 Brazil       37737  80488
#> 3 China       212258 213766
table4b  # population
#> # A tibble: 3 × 3
#>   country         `1999`     `2000`
#>   <chr>            <dbl>      <dbl>
#> 1 Afghanistan   19987071   20595360
#> 2 Brazil       172006362  174504898
#> 3 China       1272915272 1280428583
```
```{r}
# Quesion 1
# Table 1 organizes its columns by country, year, cases, and population. It organizes its rows numerically where each row represents data that is associated with a country. The data within the table are individual values. 
table1
#> # A tibble: 6 × 4
#>   country      year  cases population
#>   <chr>       <dbl>  <dbl>      <dbl>
#> 1 Afghanistan  1999    745   19987071
#> 2 Afghanistan  2000   2666   20595360
#> 3 Brazil       1999  37737  172006362
#> 4 Brazil       2000  80488  174504898
#> 5 China        1999 212258 1272915272
#> 6 China        2000 213766 1280428583
#> 

# Table 2 organizes its columns by country, year, type, & count. The rows are organized with cases and population variables in the type column. Each cell contains only one item which is either a variable or a name of a variable. This data is not tidy. 

table2
#> # A tibble: 12 × 4
#>   country      year type           count
#>   <chr>       <dbl> <chr>          <dbl>
#> 1 Afghanistan  1999 cases            745
#> 2 Afghanistan  1999 population  19987071
#> 3 Afghanistan  2000 cases           2666
#> 4 Afghanistan  2000 population  20595360
#> 5 Brazil       1999 cases          37737
#> 6 Brazil       1999 population 172006362
#> # ℹ 6 more rows

# Table 3 organizes its columns by country, year, & rate. The rows are organized by country. The rate column variables for each country contains values that are comprised of the count of cases divided by the population count. This data is not tidy. To tidy this data, I suggest adding the count of cases and population as columns and using the distinct values in these columns for rate. 

table3
#> # A tibble: 6 × 3
#>   country      year rate             
#>   <chr>       <dbl> <chr>            
#> 1 Afghanistan  1999 745/19987071     
#> 2 Afghanistan  2000 2666/20595360    
#> 3 Brazil       1999 37737/172006362  
#> 4 Brazil       2000 80488/174504898  
#> 5 China        1999 212258/1272915272
#> 6 China        2000 213766/1280428583
#> 
#> 


# Table 4a & 4b contain tibbles such that the column names are country, `1999`, & `2000`. The rows are individual countries in both tibbles. The values in the tibbles are individual values. This data is not tidy because the column names are variables themselves: 1999 & 2000 are "year" variables. Furthermore, the data is split between two tibbles.  

# Spread across two tibbles
table4a  # cases
#> # A tibble: 3 × 3
#>   country     `1999` `2000`
#>   <chr>        <dbl>  <dbl>
#> 1 Afghanistan    745   2666
#> 2 Brazil       37737  80488
#> 3 China       212258 213766
table4b  # population
#> # A tibble: 3 × 3
#>   country         `1999`     `2000`
#>   <chr>            <dbl>      <dbl>
#> 1 Afghanistan   19987071   20595360
#> 2 Brazil       172006362  174504898
#> 3 China       1272915272 1280428583
```

```{r}
# Compute rate for table2 and table4a and table4b
# Extract the number of TB cases per country per year From table2.
n_cases_per_country <- table2 %>% group_by(type_cases = type == "cases") %>% filter(type_cases == TRUE) %>% group_by(country) %>% summarise(n_cases = sum(count))
```


```{r}
# Compute rate for table2 and table4a and table4b
n_years_per_country <- table2 %>% group_by(type_cases = type == "cases") %>% filter(type_cases == TRUE) %>% group_by(country, year) %>% summarise() %>% summarise(n_years = n())

countries <- table2 %>% group_by(type_cases = type == "cases") %>% filter(type_cases == TRUE) %>% group_by(country) %>% summarise() 

n_cases_per_year_per_country <- (n_cases_per_country$n_cases / n_years_per_country$n_years)

(n_cases_per_year_per_country_tb <- tibble(countries, n_cases_per_year_per_country))

# Extract the number of TB cases per country per year from tables 4a & 4b.
countries <- table4a[["country"]]
(counts_1999 <- table4a[["1999"]])
(counts_2000 <- table4a[["2000"]])

(counts_per_year <- (counts_1999 + counts_2000) / 2)
(n_counts_per_country_per_year_4a <- tibble(countries, counts_per_year))
```


```{r 2.2 Extract the matching population per country per year for table2 and table4a and table4b}
# table 2
n_population_per_country <- table2 %>% group_by(type_cases = type == "population") %>% filter(type_cases == TRUE) %>% group_by(country) %>% summarise(n_population = sum(count))

n_years_per_country <- table2 %>% group_by(type_cases = type == "cases") %>% filter(type_cases == TRUE) %>% group_by(country, year) %>% summarise() %>% summarise(n_years = n())

countries <- table2 %>% group_by(type_cases = type == "cases") %>% filter(type_cases == TRUE) %>% group_by(country) %>% summarise() 

n_population_per_year_per_country <- (n_population_per_country$n_population / n_years_per_country$n_years)

n_population_per_year_per_country_tb <- tibble(countries, n_population_per_year_per_country)

# Table4b

# population
(countries_4b <- table4b[["country"]])
(population_1999_4b <- table4b[["1999"]])
(population_2000_4b <- table4b[["2000"]])
population_per_year_4b <- (population_1999_4b + population_2000_4b) / 2

n_population_per_year_per_country_4b <- tibble(countries_4b, population_per_year_4b)
(n_population_per_year_per_country_4b)
```


```{r 2.3 Divide cases by population, and multiply by 10000 for table2 and table4a and table4b}
# Table 2
(n_cases_per_year_per_country_tb)
(n_population_per_year_per_country_tb)

(rate_table2 <- (n_cases_per_year_per_country_tb$n_cases_per_year_per_country / n_population_per_year_per_country_tb$n_population_per_year_per_country) * 10000)

(rate_table4a4b <- (n_counts_per_country_per_year_4a$counts_per_year / n_population_per_year_per_country_4b$population_per_year_4b) * 10000)

```
```{r Store back in the appropriate place}
table2
rate_table2

rate_table2_formatted <- c(rate_table2[[1]], rate_table2[[1]], rate_table2[[1]], rate_table2[[1]],rate_table2[[2]], rate_table2[[2]], rate_table2[[2]], rate_table2[[2]],rate_table2[[3]], rate_table2[[3]], rate_table2[[3]], rate_table2[[3]])

table2[["rate"]] = rate_table2_formatted
# table2

###

rate_table4a4b

table4a[["rate"]] = rate_table4a4b
table4a

table4b[["rate"]] = rate_table4a4b
table4b


# It was easier to address table4a & 4b; However working with table2 was more efficient. Containing variables in the cells of table2 proved challenging, and the split tibbles proved inefficient.
```
```{r 3 Recreate the plot showing change in cases over time using table2 instead of table1. What do you need to do first?}
# Compute rate per 10,000
table1 %>% 
  mutate(rate = cases / population * 10000)
#> # A tibble: 6 × 5
#>   country      year  cases population  rate
#>   <chr>       <dbl>  <dbl>      <dbl> <dbl>
#> 1 Afghanistan  1999    745   19987071 0.373
#> 2 Afghanistan  2000   2666   20595360 1.29 
#> 3 Brazil       1999  37737  172006362 2.19 
#> 4 Brazil       2000  80488  174504898 4.61 
#> 5 China        1999 212258 1272915272 1.67 
#> 6 China        2000 213766 1280428583 1.67

# Compute cases per year
table1 %>% 
  count(year, wt = cases)
#> # A tibble: 2 × 2
#>    year      n
#>   <dbl>  <dbl>
#> 1  1999 250740
#> 2  2000 296920

# Visualise changes over time
library(ggplot2)
ggplot(table1, aes(year, cases)) + 
  geom_line(aes(group = country), colour = "grey50") + 
  geom_point(aes(colour = country))

# table2 %>% group_by(cases_logical = type == "cases") %>% filter(cases_logical) %>% group_by(year, country) %>% summarise() 

(table2_n_cases_per_country_per_year <- table2 %>% group_by(type_cases = type == "cases") %>% filter(type_cases == TRUE) %>% group_by(country))

ggplot(table2_n_cases_per_country_per_year, aes(year, count)) + 
  geom_line(aes(group = country), color = "grey50") +
  geom_point(aes(color = country))
```
```{r}
table4a %>% pivot_longer(c(`1999`, `2000`), names_to = "year", values_to = "counts")
```

```{r}
table2
tidy_table2 <- table2 %>% pivot_wider(names_from = "year", values_from = "count") %>% pivot_longer(c(`1999`, `2000`), names_to = "year", values_to= "count") %>% pivot_wider(names_from = "type", values_from = "count")
tidy_table2

```


### Section 12.3.3 Exercises:
```{r}
# The values in a column become column names after a pivot wider. The outermost column is used as column names for pivot_wider(). pivot_longer() will then place the column names into rows, but will maintain the initial column ordering of the first row. pivot_longer() will not re-order rows.

stocks <- tibble(
  year = c(2015, 2015, 2016, 2016),
  half = c(1,2,1,2),
  return = c(1.88,0.59,0.92, 0.17)
)
```

```{r}
stocks
```

```{r}
stocks %>%
  pivot_wider(names_from = year, values_from = return ) %>%
   pivot_longer(`2015`:`2016`, names_to = "year", values_to = "return")
```
```{r}
table4a
```



```{r}
table4a
```


```{r}
table4a
```


```{r eval = FALSE}
# table4a %>% pivot_longer(c(1999, 2000), names_to = "year", values_to = "cases")
# The names need to be in backticks because they are numbers. i.e.
#table4a %>% 
  # pivot_longer(c(1999, 2000), names_to = "year", values_to = "cases")
```

```{r}
# Quesion 3
# Calling wider on this tribble will allow the values to be placed in a double, a column for personid would allow this data to be transformed appropriately.
people <- tribble(
  ~name,             ~names,  ~values, ~pid,
  #-----------------|--------|---------|----
  "Phillip Woods",   "age",       45, 1,
  "Phillip Woods",   "height",   186, 1,
  "Phillip Woods",   "age",       50, 2,
  "Jessica Cordero", "age",       37, 3,
  "Jessica Cordero", "height",   156, 3,
)

people %>% group_by(name, names,) %>% summarise(values) 
# %>% summarise
# %>% summarise() %>% select(everything())

# Answer:
(people_wider <- people %>% pivot_wider( names_from = names, values_from = values))

# val[["age"]]
# %>% pivot_wider(names_from = name, values_from = values)
```


```{r}
# Quesion 4
preg <- tribble(
  ~pregnant, ~male, ~female,
  "yes", NA, 10,
  "no", 20, 12
)


preg %>% pivot_longer(c("male", "female"), names_to = "gender", values_to = "count") %>% select(count, pregnant, gender)
```


## Section 12.4 Separating and Uniting

#### Section 12.4.1 Separate
```{r}
# table3
table3 %>% separate(rate, into = c("count", "population")) %>% separate(year, into = c("century", "year"), sep=2)
```

#### Section 12.4.2 Unite
```{r Unite}
table5 %>%
  unite(new, century, year, sep = "")
```
#### Section 12.4.3 Exercises
```{r}
tibble(x = c("a,b,c", "d,e,f,g", "h,i,j")) %>%
  separate(x, c("one", "two", "three"), extra = "merge")

tibble(x = c("a,b,c", "d, e", "f, g, i")) %>%
  separate(x, c("one", "two", "three"), fill = "left")

```
```{r}
# Quesion 2
# Removes input columns from the output dataframe
```
```{r}
# Quesion 3
# Extract will turn a group into columns. Extract will separate groups into columns as well. Extract has been superceded. 
```

## Section 12.5 Missing Values:
```{r}
stocks <- tibble(
  year   = c(2015, 2015, 2015, 2015, 2016, 2016, 2016),
  qtr    = c(   1,    2,    3,    4,    2,    3,    4),
  return = c(1.88, 0.59, 0.35,   NA, 0.92, 0.17, 2.66)
)

```
```{r}
stocks %>% pivot_wider(names_from = year, values_from = return)
```
```{r}
treatment <- tribble(
  ~ person,           ~ treatment, ~response,
  "Derrick Whitmore", 1,           7,
  NA,                 2,           10,
  NA,                 3,           9,
  "Katherine Burke",  1,           4
)
```

```{r}
treatment %>% fill(person)
```

```{r}
# Complete 
df <- tibble(
  group = c(1:2, 1, 2),
  item_id = c(1:2, 2, 3),
  item_name = c("a", "a", "b", "b"),
  value1 = c(1, NA, 3, 4),
  value2 = 4:7
)
df
```


```{r}
df %>% complete(group, item_id, item_name)
```
#### Section 12.5.1 Exercises
```{r}
df %>% complete(group, nesting(item_id, item_name)) 
# Complete will find all the combinations of elements n a list. 
# Fill will fill in missing value with the last observation carried forward.
# 
```
```{r}
# Quesion 1
# What does the direction argument to fill do?
treatment %>% fill(person, .direction = "up")
# Direction in fill will fill NA from a particular direction

```


```{r}
who
```

```{r}
who1 <- who %>% pivot_longer(
  cols = new_sp_m014:newrel_f65, 
  names_to = "key",
  values_to = "cases",
  values_drop_na = TRUE
)
who1
```
```{r}
who1 %>% count(key)
```


```{r}
who2 <- who1 %>%
  mutate(key = stringr::str_replace(key, "newrel", "new_rel"))
who2
```
```{r}
who3 <- who2 %>%
  separate(key, c("new", "type", "sexage"))
who3
```

```{r}
who3 %>% 
  count(new)
who4 <- who3 %>%
  select(-new, -iso2, -iso3)
```
```{r}
who5 <- who4 %>%
  separate(sexage, c("sex", "age"), sep = 1)
who5
```
```{r}
who5 <- who4 %>%
  separate(sexage, c("sex", "age"), sep = 1)
who5
```
```{r}
# Checking for implicit missing values
# names()
n_who5 <- who5 %>% pivot_wider(names_from = year, values_from = cases) 
n_who5
n_who5 %>% filter(is.na(`1997`))
```


```{r}
# Checking for implicit missing values
# who5 %>% complete(type, sex) %>% filter(is.na(case))
```


```{r}
# Afghanistan	sn	m	014

# who5 %>% group_by(country, type, sex, age) %>% filter(country == "Afghanistan", type == "sn", sex == "m", age == "014")


# %>% group_by(type) %>% summarise()
# %>% group_by(country) %>% summarise()
# %>%
#   complete(country, var, sex, age, cases)
```

```{r}
who %>%
  pivot_longer(
    cols = new_sp_m014:newrel_f65,
    names_to = "key",
    values_to = "cases",
    values_drop_na = TRUE
  ) %>%
    mutate(
    key = stringr::str_replace(key, "newrel", "new_rel")
  ) %>%

  separate(key, c("new", "var", "sexage")) %>%
  # select(-new, -iso2, -iso3) %>%
  separate(sexage, c("sex", "age"), sep = 1)
```


```{r}
# Quesion 1
# Dropping NA values is necessary in order to create a tidy tibble. Otherwise, the values of cases are "NA". Yes, it is reasonable to drop NA values to ensure that the values that are present in the tibble are valid. On the contrary, dropping NA values could be filled rather than dropped. It is possible to show implicit missing values through the presence of NA values. If these values are dropped, then the implicit missing values in the data may be more challenging to detect as explicit missing values are turned implicit. The difference between NA and zero is that NA represents a value that is missing from the dataset and zero defines a numeric value that is present and recorded as having a value of literally zero. Yes, there are years missing between 1997 and 2000. There are many implicit missing values in the dataset. This can be shown by pivoting the dataset wider to bring the years into a column and then listing the values from cases. The year 1997 has many missing values for cases in Afghanistan for example. See the code snippet below:

# n_who5 <- who5 %>% pivot_wider(names_from = year, values_from = cases) 
# n_who5
# n_who5 %>% filter(is.na(`1997`))
```


```{r}
# Quesion 2
# If you neglect the mutate step, data will be missing from the tibble. It will not separate on "new" because there is only the presence of "newrel" and the separator is "_".
who %>%
  pivot_longer(
    cols = new_sp_m014:newrel_f65,
    names_to = "key",
    values_to = "cases",
    values_drop_na = TRUE
  ) %>%
  #   mutate(
  #   key = stringr::str_replace(key, "newrel", "new_rel")
  # ) %>%

  separate(key, c("new", "var", "sexage")) %>%
  # select(-new, -iso2, -iso3) %>%
  separate(sexage, c("sex", "age"), sep = 1)
```


```{r}
# 3 iso2 and iso3
redundant <- who %>%
  pivot_longer(
    cols = new_sp_m014:newrel_f65,
    names_to = "key",
    values_to = "cases",
    values_drop_na = TRUE
  ) %>%
    mutate(
    key = stringr::str_replace(key, "newrel", "new_rel")
  ) %>%

  separate(key, c("new", "var", "sexage")) %>%
  # select(-new, -iso2, -iso3) %>%
  separate(sexage, c("sex", "age"), sep = 1)

(redundant) # this tibble has 76,046 observations

redundant_dropped <- who %>%
  pivot_longer(
    cols = new_sp_m014:newrel_f65,
    names_to = "key",
    values_to = "cases",
    values_drop_na = TRUE
  ) %>%
    mutate(
    key = stringr::str_replace(key, "newrel", "new_rel")
  ) %>%

  separate(key, c("new", "var", "sexage")) %>%
  select(-new, -iso2, -iso3) %>%
  separate(sexage, c("sex", "age"), sep = 1)

(redundant_dropped) # This contains the same number of observations: 76,046


# %>% pivot_wider(names_from = country, values_from = iso2)
```


```{r}
# 3 iso2 and iso3
# redundant %>% select(iso3)
(redundant)
# redundant %>% group_by(country, new) %>% summarise() %>% count()
```


```{r 3 redundant iso2}
# There each country contains only one iso2

# There are no countries with more than one iso2 or contain a missing value of iso2
(redundant %>% group_by(country, iso2) %>% summarise() %>% count() %>% filter(n != 1 | is.na(n)))

country_iso2 <- redundant %>% group_by(country, iso2) %>% summarise()
n_unique_iso2_per_country <- length(unique(country_iso2$iso2))

# The number of countries are equal to the number of unique iso2
if (length(country_iso2$country) == n_unique_iso2_per_country){
  print("The number of countries are equal to the number of unique iso2")
}
# If the number of unique were less, there would be repeated values or missing values.
# Because the number of unique iso is equal to the number of countries and each country only has one value, then these values are redundant.
```


```{r 3 iso3}
# There each country contains only one iso3

# There are no countries with more than one iso3 or contain a missing value of iso3
(redundant %>% group_by(country, iso3) %>% summarise() %>% count() %>% filter(n != 1 | is.na(n)))

country_iso3 <- redundant %>% group_by(country, iso3) %>% summarise()
n_unique_iso3_per_country <- length(unique(country_iso3$iso3))

# The number of countries are equal to the number of unique iso3
if (length(country_iso3$country) == n_unique_iso3_per_country){
  print("The number of countries are equal to the number of unique iso3")
}
# If the number of unique were less, there would be repeated values or missing values.
# Because the number of unique iso is equal to the number of countries and each country only has one value, then these values are redundant.


```

```{r redundant new example}
# There each country contains only one iso3

# There are no countries with more than one iso3 or contain a missing value of iso3
(redundant %>% group_by(country, new) %>% summarise() %>% count() %>% filter(n != 1 | is.na(n)))

country_new <- redundant %>% group_by(country, new) %>% summarise()
n_unique_new_per_country <- length(unique(country_new$new))

# The number of countries are equal to the number of unique iso3
if (length(country_new$country) == n_unique_new_per_country){
  print("The number of countries are equal to the number of unique new")
} else if(n_unique_new_per_country == 1) {
  print("There is only 1 unique entry for every country. This variable is redundant because it holds no unique value.")
} else {
  print("unique values found")
  print(length(country_new$country))
  print(n_unique_new_per_country)
}
# If the number of unique were less, there would be repeated values or missing values.
# There is only 1 unique entry for every country. This variable is redundant because it holds no value.


```

```{r redundancy counterexample}
# There each country contains only one iso3

# There are no countries with more than one iso3 or contain a missing value of iso3
(redundant %>% group_by(country, year) %>% summarise() %>% count() %>% filter(n != 1 | is.na(n)))

country_year <- redundant %>% group_by(country, year) %>% summarise()
n_unique_year_per_country <- length(unique(country_year$year))

# The number of countries are equal to the number of unique iso3
if (length(country_year$country) == n_unique_year_per_country){
  print("The number of countries are equal to the number of unique new")
} else if(n_unique_year_per_country == 1) {
  print("There is only 1 unique entry for every country. This variable is redundant because it holds no unique value.")
} else {
  print("unique values found")
  print(length(country_year$country))
  print(n_unique_year_per_country)
}
# If the number of unique were less, there would be repeated values or missing values.

```

```{r}
# Quesion 4
base_who_q4 <- who %>%
  pivot_longer(
    cols = new_sp_m014:newrel_f65,
    names_to = "key",
    values_to = "cases",
    values_drop_na = TRUE
  ) %>%
    mutate(
    key = stringr::str_replace(key, "newrel", "new_rel")
  ) %>%
  separate(key, c("new", "var", "sexage")) %>%
  select(-new, -iso2, -iso3) %>%
  separate(sexage, c("sex", "age"), sep = 1)



```
```{r}

head(base_who_q4) 

(number_of_cases_per_country <- base_who_q4 %>% group_by(country, cases) %>% summarise()  %>% summarise(cases_per_country = sum(cases)))

(number_of_cases_per_year <- base_who_q4 %>% group_by(year, cases) %>% summarise() %>% summarise(cases_per_year = sum(cases)))

(number_of_cases_per_sex <- base_who_q4 %>% group_by(sex, cases) %>% summarise() %>% summarise(cases_per_sex = sum(cases)))
(number_of_cases_per_sex <- base_who_q4 %>% group_by(sex, cases) %>% summarise() %>% summarise(cases_per_sex = sum(cases)))
```
```{r}
# Quesion 1
# I would need to combine tables airports, flights, and planes. I would need to gather the longitude and lattitude of the origin and destination from airports in order to calculate the trajectory of the plane on a world map. I would need the distance calculated by the distance from the origin to the destination to identify the lenght of the line. I would need to group origin and destination by tailnum in flights to identify which flight tailnum went to which origin and destination.
```

```{r}
# Quesion 2
# The relationship between weather and airports is origin
```


```{r}
# Quesion 3
# Weather would need to include a relation to destination from flights.
```

```{r}
# Quesion 4
# I would want the following values in the table: holiday, month, day, year, number_of_people. The primary key would be the year, month, day and the foreign key would be the year, month, day in flights.
```

#### Section 13.3 Keys
#### Section 13.3.1 Exercises
```{r Add a surogate key to flights}
surogate_key <- nycflights13::flights
surogate_key %>% mutate(surogate_key = row_number()) %>% select(surogate_key, everything())
```
```{r 2. Identify the keys in the following datasets}
if(!require("Lahman")) install.packages("Lahman")
if(!require("babynames")) install.packages("babynames")
if(!require("nasaweather")) install.packages("nasaweather")
if(!require("fueleconomy")) install.packages("fueleconomy")
if(!require("ggplot2")) install.packages("ggplot2")
```


```{r 2.1 Identify the keys in the following datasets}
length(unique(Lahman::Batting$teamID))
length(Lahman::Batting$teamID)
Lahman::Batting
babynames::babynames
nasaweather::atmos
fueleconomy::vehicles 
ggplot2::diamonds 

# I would suggest that playerID is key in the Lahman dataset. There is no primary key in the Lahman dataset.
# There is no primary key in the babynames dataset. I would use the row_number as a surrogate key. 
# A combination of lattitude, longitude, year, & month the categories I would use to create a surrogate key. Row number would work as well.
# id is the key in fueleconomy vehicles.
# There is no primary key in the ggplot2::diamonds dataset. I would mutate the rows to allow for a rownumber for each observation to be used as a key. 

```

```{r}

```


```{r}
batting <- Lahman::Batting
pitching <- Lahman::Pitching
fielding <- Lahman::Fielding
```
```{r}
batting %>% count(playerID)
```
```{r}
pitching %>% count(playerID)
```
```{r}
fielding %>% group_by(playerID) %>% summarise(n())
```
```{r}
# Batting and pitching have a one to one relationship on playerID where one playerID in pitching relates to one playerID in batting. The same is true with respect to batting and fielding. 
```
## Section 13.4: Mutating Joins



```{r Mutating Joins}
flights2 <- flights %>% 
  select(year:day, hour, origin, dest, tailnum, carrier)
flights2
```

```{r}
# A mutating join is akin to a left join 

# Left Join
flights2 %>% 
  select(-origin, -dest) %>%
  left_join(airlines, by = "carrier")

# Mutating Join
flights2 %>%
  select(-origin, -dest) %>%
  mutate(name = airlines$name[match(carrier, airlines$carrier)])
```

```{r}
flights2 %>%
  select(-origin, -dest) %>%
  left_join(airlines, by = "carrier")
```

#### 13.4.1 Understanding Joins
```{r Understanding Joins}
x <- tribble(
  ~key, ~val_x,
  1, "x1",
  2, "x2",
  3, "x3"
)

y <- tribble(
  ~key, ~val_y,
  1, "y1",
  2, "y2",
  4, "y3"
)



```

#### Section 13.4.2 Inner Joins
```{r}
x %>% inner_join(y, by = "key")
# Inner joins drop observations that are unmatched.
```
#### 13.4.3 Outer Joins
```{r }
x %>% left_join(y, by = 'key')
x %>% right_join(y, by = 'key')
x %>% full_join(y, by = 'key')
```

#### 13.4.4 Duplicate keys
```{r}
x <- tribble(
  ~key, ~val_x,
     1, "x1",
     2, "x2",
     2, "x3",
     1, "x4"
)
y <- tribble(
  ~key, ~val_y,
     1, "y1",
     2, "y2"
)

left_join(x, y, by = 'key')
```

```{r}
x <- tribble(
  ~key, ~val_x,
     1, "x1",
     2, "x2",
     2, "x3",
     3, "x4"
)
y <- tribble(
  ~key, ~val_y,
     1, "y1",
     2, "y2",
     2, "y3",
     3, "y4"
)

left_join(x,y, by = "key")
```
#### Defining the key columns
```{r}
flights2 %>%
  left_join(weather)
```
```{r}
flights2 %>%
  left_join(airports, c("dest" = "faa"))
```

```{r}
flights2 %>%
  left_join(airports, c("origin" = "faa"))
```
#### Section 13.4.6 Exercises
```{r 1. Compute the average delay by destination, then join on the airports data frame so you can show the spatial distribution of delays}

airports %>% 
  semi_join(flights, c("faa" = "dest")) %>%
  ggplot(aes(lon, lat)) + 
  borders("state") +
  geom_point() +
  coord_quickmap()
```
```{r}
flights 
```
```{r}
airports
```


```{r}
airports %>% semi_join(flights, c("faa" = "dest"))
```



```{r}
# pseudo-filter airport destinations in flight destinations
airports_dest <- airports %>% semi_join(flights, c("faa" = "dest"))
airports_dest
```


```{r}
# LGA is in origin; NA in dest.
flights %>% 
  filter(!is.na(dep_delay) & !is.na(arr_delay)) %>% 
  mutate(total_delay = dep_delay + arr_delay) %>% 
  filter(origin == "LGA")
# %>% 
  # group_by(dest) %>% 
  # summarise(avg_total_delay = mean(total_delay, rm.na = TRUE)) 
```


```{r}
# LGA is NA in flights here and is filtered
(avg_delay_per_dest <- flights %>% filter(!is.na(dep_delay) & !is.na(arr_delay)) %>% mutate(total_delay = dep_delay + arr_delay) %>% group_by(dest) %>% summarise(avg_total_delay = mean(total_delay)))
```
```{r}
avg_delay_per_dest %>% filter(dest == "LGA")
```

```{r}
airports %>% filter(faa == "LGA")
```
```{r}
# LGA is NA in flights ???
flights %>% filter(dest == "LGA")
```


```{r}
airports_in_flight_dest <- airports %>% semi_join(flights, c("faa" = "dest"))
```

```{r}
airports_in_flight_dest %>% filter(faa == "LGA")
```
```{r}
avg_delay_per_dest
```


```{r}
# adding the avg delay to the airport destination tibble; LGA in airports_dest; LGA not in avg_delay_per_dest because it is derived from flights which lists LGA destination as NA or arr_time & dep_time.
airports_dest_avg_delay <- left_join(airports_dest, avg_delay_per_dest, by = c("faa" = "dest"))

# Dropping LGA; Value is NA because of above.  
(clean_airports_dest_avg_delay <- airports_dest_avg_delay %>% select(faa, avg_total_delay, everything()) %>% filter(!is.na(avg_total_delay)))
```



```{r}
clean_airports_dest_avg_delay %>% 
  ggplot(aes(lon, lat, color = avg_total_delay)) + 
  borders("state") +
  geom_point() +
  coord_quickmap()
```


```{r}
# 2. Add the location of the origin and destination to flights
# Add the location of the origin and destination (i.e. the lat and lon) to flights.

# There are only 3 origins
flights %>% filter(!is.na(dep_delay) & !is.na(arr_delay)) %>% mutate(total_delay = dep_delay + arr_delay) %>% group_by(origin) %>% summarise(avg_total_delay = mean(total_delay, rm.na = TRUE))

```

```{r}
# 2. Add the location of the origin and destination to flights
(avg_delay_per_origin <- flights %>% filter(!is.na(dep_delay) & !is.na(arr_delay)) %>% mutate(total_delay = dep_delay + arr_delay) %>% group_by(origin) %>% summarise(avg_total_delay = mean(total_delay, rm.na = TRUE)))
```


```{r}
# 2. Add the location of the origin and destination to flights
(airports_origin <- airports %>% semi_join(flights, c("faa" = "origin")))
```



```{r}
# 2. Add the location of the origin and destination to flights
airports_origin_avg_delay <- left_join(airports_origin, avg_delay_per_origin, by = c("faa" = "origin"))

airports_origin_avg_delay %>% select(faa, avg_total_delay, everything())
```


```{r}
# 2. Add the location of the origin and destination to flights
(airports_dest_avg_delay) %>% filter(faa == "EWR" | faa == "JFK" | faa == "LGA")

# (ewr <- first(airports_origin_avg_delay))
# (jfk <- nth(airports_origin_avg_delay, 2))


# comment out and run once
# airports_dest_origin_avg_delay <- airports_dest_avg_delay %>% add_row(ewr)
# airports_dest_origin_avg_delay %>% add_row(jfk)

# Examine results
# airports_dest_origin_avg_delay%>% filter(faa == "EWR" | faa == "JFK" | faa == "LGA")

# left_join(airports_dest_avg_delay, airports_origin_avg_delay)

# flights_origin <- left_join(flights, airports, by = c("origin" = "faa")) %>% mutate(lon_origin = lon, lat_origin = lat) %>% mutate(row_number = row_number()) %>% select(row_number, origin, dest, lon_origin, lat_origin, everything())
# 
# flights_dest <- left_join(flights, airports, by = c("dest" = "faa")) %>% mutate(lon_dest = lon, lat_dest = lat) %>% mutate(row_number = row_number()) %>% select(row_number, origin, dest, lon_dest, lat_dest, everything())
# 
# left_join(flights_origin, flights_dest)


# (flights_dest <- left_join(flights, airports_dest_avg_delay, by = c("dest" = "faa")))
# (flights_origin <- left_join(flights, airports_dest_avg_delay, by = c("origin" = "faa")))

```

```{r}
avg_delay_per_origin
```

```{r}
# Destination
# avg_delay_per_dest
# clean_airports_dest_avg_delay %>% select(faa, avg_total_delay, lon, lat, everything()) %>% rename( )

# rename faa to dest
clean_airports_dest_avg_delay_dest <- clean_airports_dest_avg_delay %>% select(faa, avg_total_delay, lon, lat, everything()) %>% rename(dest = faa )

```
```{r}
(clean_airports_dest_avg_delay_dest)
```
```{r}
# origin , avg total delay, lon, lat
airports_origin_avg_delay_short <- airports_origin_avg_delay %>% select(faa, avg_total_delay, lat, lon)

# creating a single tibble
clean_airports_dest_avg_delay_dest_short <- clean_airports_dest_avg_delay_dest %>% select(dest, avg_total_delay, lat, lon)
```

```{r}
# common name
airports_origin_avg_delay_short <- airports_origin_avg_delay_short %>% rename(loc = faa)
clean_airports_dest_avg_delay_dest_short <- clean_airports_dest_avg_delay_dest_short %>% rename( loc = dest)
```


```{r}
# Full Join
origin_dest_flights <- clean_airports_dest_avg_delay_dest_short %>% full_join(airports_origin_avg_delay_short)
```


```{r}
origin_dest_flights %>%
  ggplot(aes(lon, lat, color = avg_total_delay)) + 
    borders("state") + 
    geom_point() +
    coord_quickmap() + 
    labs(x = "Longitude", y = "Latitude", title = "Average total Delay of Flights by Location")
```


```{r}
# Quesion 3
# Is there a relationship between the age of a plane and its delays?
flights_total_delay <- flights %>% mutate(total_delay = (dep_delay + arr_delay)) %>% select(total_delay, everything())

# planes_year_manufactured <-
# planes %>% rename(year_manufactured = "year)

planes_year_manufactured <- planes %>% mutate(year_manufactured = year)

plane_age_vs_delays <- flights_total_delay %>% left_join(planes_year_manufactured, by = "tailnum") %>% select(tailnum, total_delay, year_manufactured, everything())


# plane_age_vs_delays <- 
  # plane_age_vs_delays %>% filter(!is.na(year_manufactured))
  
clean_plane_age_vs_delays <- plane_age_vs_delays %>% filter(!is.na(year_manufactured))
clean_plane_age_vs_delays <- clean_plane_age_vs_delays %>% mutate(year = year.x) %>% select(everything(), -year.x, -year.y) 
clean_plane_age_vs_delays <- clean_plane_age_vs_delays %>% filter(!is.na(total_delay))
clean_plane_age_vs_delays <- clean_plane_age_vs_delays %>% arrange(year_manufactured)
```

```{r}
# Quesion 3
# Is there a relationship between the age of a plane and its delays?
# Newer planes 
year_manufactured_vs_total_delays <- clean_plane_age_vs_delays %>% group_by(year_manufactured, total_delay) %>% summarise() %>% summarise(total_delays_per_year = n())

```  
  
```{r}
ggplot(year_manufactured_vs_total_delays) +
  geom_point(aes(year_manufactured, total_delays_per_year, color = total_delays_per_year)) +
  geom_smooth(aes(year_manufactured, total_delays_per_year), se = FALSE, color = "lightblue") + 
  labs(x = "Year Manufactured", y = "Total Delays Per Year", title = "Does Plane Age Effect Delays?")
```
```{r}
# Quesion 4
# What weather conditions make it more likely to see a delay?
flights
```


```{r}
# Quesion 4
# calculate dep delay in minutes since midnight
# dep_delay_minutes_since_midnight <- ((flights$dep_delay %/% 100) * 60) + (flights$dep_delay %% 100)
# arr_delay_minutes_since_midnight <- ((flights$arr_delay %/% 100) * 60) + (flights$arr_delay %% 100)
# 
# flights$dep_delay_minutes_since_midnight <- dep_delay_minutes_since_midnight
# flights$arr_delay_minutes_since_midnight <- arr_delay_minutes_since_midnight
```


```{r}
# Quesion 4
flights_weather <- flights %>% left_join(weather)
```


```{r}
# Quesion 4
names(weather)
```


```{r}
# Quesion 4
clean_flights_weather_tb <- flights_weather %>% select(dep_delay, arr_delay, temp, dewp, humid, wind_dir, wind_speed, wind_gust, precip, pressure, visib, time_hour, everything()) %>% filter(!is.na(wind_gust)) %>% arrange(desc(dep_delay))

# (flights_weather)

```

```{r}
flights_weather
```


```{r}
clean_flights_weather_tb
ggplot(clean_flights_weather_tb) + 
  geom_histogram(aes(clean_flights_weather_tb$dep_delay))

clean_flights_weather_tb
ggplot(clean_flights_weather_tb) + 
  geom_histogram(aes(clean_flights_weather_tb$arr_delay))
```
```{r}
# Departure: What weather conditions make it more likely to see a delay?
  clean_flights_weather_tb <- clean_flights_weather_tb %>% filter(!is.na(pressure))
  clean_flights_weather_tb %>% select(-arr_delay) %>% arrange(dep_delay)
```

```{r}
if(!require("corrr")) install.packages("corrr")
library(corrr)
```

```{r}
names(weather)
```


```{r}
# correlate(clean_flights_weather_tb) %>% View()

# corrr_clean_flights_weather_tb <- 

clean_flights_weather_dep_delay_tb <- clean_flights_weather_tb %>% select(dep_delay, temp, dewp, humid, wind_dir, wind_speed, wind_gust, precip, pressure, visib)

clean_flights_weather_dep_delay_positive_tb <- clean_flights_weather_dep_delay_tb %>% filter(dep_delay > 0)
```


```{r}
clean_flights_weather_dep_delay_positive_tb %>% 
  correlate() %>% 
  autoplot(method = "Identity") + geom_text(aes(label=round(r, digits=2)), size = 2.5)
```


```{r}


# dep_delay as a function of temp, dewp, humidity, wind_speed, wind_gust, precipitation

ggplot(clean_flights_weather_dep_delay_positive_tb) + 
  geom_point(aes(dep_delay, humid)) +
  geom_smooth(aes(dep_delay, humid), se = FALSE)

```
```{r}
# Arrival: What weather conditions make it more likely to see a delay?
  clean_flights_weather_tb <- clean_flights_weather_tb %>% filter(!is.na(pressure))
  clean_flights_weather_tb %>% select(-dep_delay) %>% arrange(arr_delay)
clean_flights_weather_arr_delay_tb <- clean_flights_weather_tb %>% select(arr_delay, temp, dewp, humid, wind_dir, wind_speed, wind_gust, precip, pressure, visib)
```


```{r}
clean_flights_weather_arr_delay_positive_tb <- clean_flights_weather_arr_delay_tb %>% filter(arr_delay > 0)
clean_flights_weather_arr_delay_positive_tb %>% 
  correlate() %>% 
  autoplot(method = "Identity") + geom_text(aes(label=round(r, digits=2)), size = 2.5)
# arr_delay as a function of temp, dewp, humidity, wind_speed, wind_gust, precipitation
```


```{r}
ggplot(clean_flights_weather_arr_delay_positive_tb) + 
  geom_point(aes(arr_delay, humid)) +
  geom_smooth(aes(arr_delay, humid), se = FALSE)
```
```{r}
ggplot(clean_flights_weather_arr_delay_positive_tb) + 
  geom_point(aes(arr_delay, dewp)) +
  geom_smooth(aes(arr_delay, dewp), se = FALSE)
```
```{r}
ggplot(clean_flights_weather_arr_delay_positive_tb) + 
  geom_point(aes(arr_delay, temp)) +
  geom_smooth(aes(arr_delay, temp), se = FALSE)
```
```{r}
# There is a correlation between arrival and departure delays on days that are more humid, have higher dewpoints, have more rain, and have higher temperatures. 
```

```{r}
#  5. What happened on June 13, 2013?
names(flights)
```


```{r}
#  5. What happened on June 13, 2013?
june_13_2013 <- flights %>% filter(year == "2013", month == "6", day == "13") %>% arrange(sched_dep_time)
```

```{r}
ggplot(june_13_2013) + 
  geom_point(aes(sched_dep_time, dep_delay), color = "lightblue") + 
  geom_smooth(aes(sched_dep_time, dep_delay), color = "darkblue", se = FALSE) + 
  labs(title = "Departure Delays on June 13th 2013", x = "Scheduled Departure Times", y = "Departure Delay (min)")

ggplot(june_13_2013) + 
  geom_point(aes(sched_arr_time, arr_delay), color = "lightblue") + 
  geom_smooth(aes(sched_arr_time, arr_delay), color = "darkblue", se = FALSE) + 
  labs(title = "Arrival Delays on June 13th 2013", x = "Scheduled Arrival Times", y = "Arrival Delay (min)")

# June 13th 2013 was an overcast, rainy, & foggy day. The rain reduced visibility to 2 miles between the times of 9:57 AM, 10:58 AM  and again at 7:51 PM. This corresponds to the increase in dealys with respect to scheduled arrival and departure times. Reference: https://www.timeanddate.com/weather/usa/new-york/historic?month=6&year=2013
```

## Section 13.5: Filtering joins
```{r}
# semi_join(x, y) keeps all the observations in x that are also present in y 
# anti_join(x, y) drops all the observationsin x that are alse present in y

# Example:
top_dest <- flights %>%
  count(dest, sort = TRUE) %>%
  head(10)
top_dest


```

```{r}
# Find each flight that went to one of those destinations:
flights %>% 
  filter(dest %in% top_dest$dest)

```

```{r}
# Only the flights that are in the top destinations
flights %>% 
  semi_join(top_dest)
```
# 13.5.1 Exercises
```{r 1. What does it mean for a flight to have a missing tailnum?}

# A missing tailnumber on a flight means that the tailnumber was not recorded. 
tailnum_not_in_planes <- flights %>%
  anti_join(planes, by = "tailnum")

```

```{r}
tailnum_not_in_planes %>% group_by(origin) %>% summarise(n())
```

```{r}
# tailnum_not_in_planes %>% group_by(dep_time) %>% summarise(n())
```

```{r}
tailnum_not_in_planes
```


```{r}
# Answer: The carriers MQ and AA are mostly not recorded in the planes tibble. 
n_planes_not_in_planes_tb_by_carrier_MQ_AA <- tailnum_not_in_planes %>% group_by(carrier) %>% summarise(count = n()) %>% filter(carrier == "MQ" | carrier == "AA") %>% summarise(n_planes_not_in_planes_tb_by_carrier = sum(count))

total_n_planes_not_in_planes_tb <- tailnum_not_in_planes %>% group_by(carrier) %>% summarise(count = n()) %>% summarise(total_n_planes_not_in_planes_tb = sum(count))

percent_of_planes_from_carrier_MQ_and_AA_not_in_planes_tb <- (n_planes_not_in_planes_tb_by_carrier_MQ_AA / total_n_planes_not_in_planes_tb) * 100
(percent_of_planes_from_carrier_MQ_and_AA_not_in_planes_tb)
```


```{r}
# tailnum_not_in_planes %>% group_by(dest) %>% summarise(n())
```

```{r}
# Quesion 2
# All Planes in planes tibble with at least 100 flights
tailnumbers_with_at_least_100_flights <- flights %>% group_by(tailnum) %>% summarise(n_flights = n()) %>% arrange(n_flights) %>% filter(n_flights >= 100)

planes %>%
  semi_join(tailnumbers_with_at_least_100_flights, by = "tailnum")

```

```{r}
# Quesion 3
vehicles <- fueleconomy::vehicles
common <- fueleconomy::common

# The most common models
vehicles %>%
  semi_join(common)

```

```{r}
# Quesion 4
# Find the 48 hours over the course of the whole year that have the worst delays. These hours are not contiguous. The hours in flights are contiguous only by 19 hours. 

# Day and number of hours 
flights %>% group_by(year, month, day, hour) %>% select(year, month, day, hour, dep_delay, everything()) %>% summarise() %>% summarise(n_hours = n()) %>% select(-year, -month, day, n_hours, )

# Groups of hours
flights %>% filter(year == 2013, month == 1, day == 1) %>% group_by(hour) %>% summarise() %>% arrange(hour)

forty_eight_hours_with_the_worst_delays <- flights %>% mutate(rank = min_rank(desc(dep_delay))) %>% filter(rank <= 48) %>% select(dep_delay, year, month, day, hour) %>% arrange(desc(dep_delay))

(forty_eight_hours_with_the_worst_delays)

weather %>%
  semi_join(forty_eight_hours_with_the_worst_delays)

```


```{r}
# Quesion 5
# These are all the flights that are not in airports where the destinations in flights are not located in the faa column in airports.
anti_join(flights, airports, by = c("dest" = "faa")) 

# These are all the airports that are not in flights where the faa in airports are not located in the dest column in flights
anti_join(airports, flights, by = c("faa" = "dest"))

```
```{r}
# Quesion 6
# names(planes)
# 
# names(flights)

# flights[["carrier"]] %>% filter()

(planes)
# flights
 flights_filtered_by_planes_tb <- flights %>%
  semi_join(planes, by = "tailnum")
 
 (flights_filtered_by_planes_tb)
 
 flights_planes_tb <- flights_filtered_by_planes_tb %>% left_join(planes, by = "tailnum")
```


```{r}
# Quesion 6
(flights_planes_tb)
```
```{r}
# Quesion 6
# flights_planes_tb %>% select(carrier, tailnum) %>% group_by(carrier, tailnum) %>% summarise() %>% summarise(n_planes = n())

# flights_planes_tb %>% select(carrier, tailnum) %>% group_by(carrier, tailnum) 

# There exist planes that are flown by multiple airlines. 
flights %>% group_by(tailnum, carrier) %>% summarise() %>% summarise(n_carriers = n()) %>% filter(n_carriers > 1)

flights %>% group_by(tailnum, carrier) %>% filter(tailnum == "N146PQ") %>% summarise()

```

#### Section 13.6: Join Problems
```{r}

```

#### Section 13.7: Set Operations
```{r}
df1 <- tribble(
  ~x, ~y,
   1,  1,
   2,  1
)
df2 <- tribble(
  ~x, ~y,
   1,  1,
   1,  2
)
```

```{r}
df1
```
```{r}
df2
```


```{r}
# return only observations in both df1 and df2
intersect(df1, df2)
```

```{r}
# return unique observations in df1 and df2
union(df1, df2)
```

```{r}
# return observations in df1 but not df2
setdiff(df1, df2)
```


## Section 14: Strings
```{r}
if(!require(tidyverse)) install.package("tidyverse")
library(tidyverse)
```


```{r}
x <- c("\"", "\\")
x
```


```{r}
writeLines(x)
```


#### 14.2.1 String Length
```{r}
str_length(c("a", "R for data science", NA))
```

```{r}
# Combine two strings 
str_c("x", "y")
```

```{r}
# Control how combined strings are separated
str_c("x", "y", sep = ",")
```

```{r}
# Replacing missing values
x <- c("abc", NA)
x
```

```{r}
str_c("|-", x, "-|")
```

```{r}
# print NA as literal "NA"
str_c("|-", str_replace_na(x), "-|")
```


```{r}
str_c(c("x", "y", "z"), collapse = ", ")

```

```{r}
x <- c("Apple", "Banana", "Pear")
str_sub(x, 1, 3)

# negative numbers count backwards from end
str_sub(x, -3, -1)

```

```{r}
str_sub("a", 1, 5)
```

```{r}
x <- c("apple", "eggplant", "banana")
str_sort(x, locale = "en") # English
str_sort(x, locale = "haw")
```


#### 14.2.5 Exercises
```{r}
# Quesion 1
# paste0 has no spaces in the separator between strings
# paste has a default of " " in as the separator between strings that are combined.

# paste0 is similar in function to str_c
# paste is str_c using a sep = " "

# str_c treats NA as NA and paste0 and paste will treat NA as a string.

```


```{r}
# Quesion 2
# Where separator adds a space, collapse will remove a space or designated character between string vectors
```

```{r}
# Quesion 3
test_string <- "12345678"
len <- str_length(test_string)
ceiling(len/2)
str_sub(test_string, start = ceiling(len/2), end = ceiling(len/2))
# The start and end are inclusive. If there are an odd number of characters, then I am using the ceiling to return the middle value. If there are an even number of characters, I will return the lower most of value between the difference.
```

```{r}
# Quesion 4
thanks <- 'R would not be what it is today without the invaluable help of these people
outside of the (former and current) R Core team, who contributed by donating
code, bug fixes and documentation: Valerio Aimale, Suharto Anggono, Thomas
Baier, Gabe Becker, Henrik Bengtsson, Roger Bivand, Ben Bolker, David Brahm,
G"oran Brostr"om, Patrick Burns, Vince Carey, Saikat DebRoy, Matt Dowle, Brian
D\'Urso, Lyndon Drake, Dirk Eddelbuettel, Claus Ekstrom, Sebastian Fischmeister,
John Fox, Paul Gilbert, Yu Gong, Gabor Grothendieck, Frank E Harrell Jr, Peter
M. Haverty, Torsten Hothorn, Robert King, Kjetil Kjernsmo, Roger Koenker,
Philippe Lambert, Jan de Leeuw, Jim Lindsey, Patrick Lindsey, Catherine Loader,
Gordon Maclean, Arni Magnusson, John Maindonald, David Meyer, Ei-ji Nakama,
Jens Oehlschl\"agel, Steve Oncley, Richard O\'Keefe, Hubert Palme, Roger D. Peng,
Jose\' C. Pinheiro, Tony Plate, Anthony Rossini, Jonathan Rougier, Petr Savicky,
Guenther Sawitzki, Marc Schwartz, Arun Srinivasan, Detlef Steuer, Bill Simpson,
Gordon Smyth, Adrian Trapletti, Terry Therneau, Rolf Turner, Bill Venables,
Gregory R. Warnes, Andreas Weingessel, Morten Welinder, James Wettenhall, Simon
Wood, and Achim Zeileis. Others have written code that has been adopted by R and
is acknowledged in the code files, including '

```

```{r}
# Question 4.1
cat(str_wrap(thanks, width = 100), "\n")
```

```{r}
# Question 4.2
# String wrap will wrap the number of characters used before a newline character is inserted. 
```

```{r}
# Quesion 5
# str_trim will remove the whitespace at both ends of a string.
# str_pad(sample, width = str_length(sample) + 2, side = "both", pad = " ") is the opposite of str_trim
```

```{r}
# Quesion 6
vector <- c("a", "b")

split_string_func <- function(input) {
  return_val <- c("")
  for (col in seq_along(input)) {
    if (length(input) == 0) {
        return("")
      break
      } else if(length(input) == 1 ) {
        if (input[[col]] == "" ){
          return("")
        } else {
          return_val <- str_c(return_val, input[[col]], ".")  
        }
        
      } else {
      if (str_length(input[[col]]) == 0) {
        next
      }
      if (col != length(input)){
        return_val <- str_c(return_val, input[[col]], ", ")
      } else {
        return_val <- str_c(return_val, "and ",  input[[col]], ".")
      }
    }
  }
  return(return_val)
}
split_string_func(vector)
```

#### Section 14.3 Matching Patterns with Regular Expressions
```{r}

```

#### Section 14.3.1.1 Exercises
```{r}
# Quesion 1
x <- "\\"
writeLines(x)
```


```{r}
# Quesion 1
# "\" as a string representation of a regular expression converts to "". It is converted to a NULL regular expression, and will not match a literal "\".
# "\\" as a string representation of a regular expression becomes converted to the regular expression "\". The converted regular expression is escaping nothing and will not match a literal "\".
# "\\\" as a string representation of a regular expression becomes converted to the regular expression "\\". The regular expression will be converted to search for the string "\". To write the string "\" to output, "\\" is needed. "\\" will convert to "\" on console output. The string representation of the a regular expression "\\\" will create a regular expression that is searching for "\" where "\\" is used in the string to print "\" to the console. One needs to find "\\" to find the "\" printed in a console because the string "\\" will convert to "\" on a print. Therefore, "\\\" will search for the string "\". "\" would escape nothing and would not print "\" to the console. "\\" will convert from a string to "\" on console output. Ultimately, the regular expression needs to find "\\" which in turn needs a string representation of a regular expression - each of which require an additional "\" resulting in the string representation of a regular expression that searches for a string "\\" which will output "\" to be "\\\\".

str_view(x, "\\\\")

```

```{r}
# Quesion 2
x <- '"\'\\'
writeLines(x)
str_view(x,'\\"\\\'\\\\')
```


```{r}
# Quesion 3
# "\..\..\.." will match ".a.b.c";
# '\..\..\..'

x <- '.a.b.c'
writeLines(x)

str_view(x, '\\..\\..\\..')
```

## Section 14.3.2: Anchors
```{r}

```

#### Section 14.3.2.1: Exercises
```{r}
x <- '$^$'

str_view(x, '\\$\\^\\$')
```

```{r}
# Quesion 1
x <- 'yes'

str_view(x, '^y.+')

```

```{r}
# Quesion 2
x <- 'spacex'

str_view(x, '.+x$')
```

```{r}
# Quesion 3
x <- "Sam"

str_view(x, "^...$")
```

```{r}
# Quesion 4
x <- '1234567'

str_view(x, "^(.......+)$")
```


#### Section 14.3.3: Character classes alternatives
```{r }

```

#### Section 14.3.3.1 Exercises
```{r}
#  1.1
x <- 'afterlife'

str_view(x, '^[aeiou].[a-z]+')

```

```{r}
#  1.2
x <- 'cnstnts'
x_not <- 'constants'

str_view(x, '^[^aeiou]+$')
```


```{r}
# Question 1.3
x <- 'started'
x_not <- 'seed'

str_view(x, '[a-z]+[^eed]ed$')
```

```{r}
# Question 1.4
x <- 'starting'
x2 <- 'concise'

str_view(x, '^[a-z]+(ing|ise)$')
```


```{r}
# Quesion 2
x <- 'perceive'
x2 <- 'piece'
x_not <- 'percieve'

str_view(x, '(cei)')
```

```{r}
# Quesion 3
x <- 'queque'

str_view(x, '(qu)')
```

```{r}
# Quesion 4
american <- 'color'
british <- 'colour'

str_view(american, '[a-z]*[o][u][r]$')
```

```{r}
# Quesion 5
x <- '800-867-5309'

str_view(x, '[\\d]{3}[-][\\d]{3}[-][\\d]{4}')

```


#### Section 14.3.4.1 Exercises
```{r}
# Quesion 1
# ? is {0,1}
# + is {1,}
# * is {0,}
```

```{r}
# Quesion 2
# Any character zero or more times
x <- '{asdf}'
str_view(x, '\\{.+\\}')

# "{" followed by any character one or more times followed by a "}"

# \d{4}-\d{2}-\d{2} This is four digits followed by a dash followed by two digits followed by a dash followed by two more digits

# \\\\{4} This is searching for a four contiguous "\"

```


```{r}
# Quesion 3
x <- 'sdf'
str_view(x, '^[^aeiou]{3}')

x <- 'aeiou'
str_view(x, '[aeiou]{3,}')

x <- 'dfdfsfdfdf'
str_view(x, '([^aeiou][^aeiou]){2,}')

```

```{r}
# Quesion 4
# https://regexcrossword.com/challenges/beginner.
```

#### Section 14.3.5: grouping and backreferences
```{r}
x <- 'bbbanananan'
str_view(x, '(.)\\1\\1')

x <- 'aaaa'
str_view(x, "(.)(.)\\2\\1")

# The expression (.)\1\1 matches any character followed by the same character twice.
# The string representation of the regular expression "(.)(.)\\2\\1" will match any two characters followed by the second matched character followed by the first matched character. 

# (..)\1 is a regular expression that will match any two characters followed by the same group of characters. 

# "(.).\\1.\\1" will match any character followed by any character followed by the first character that is matched followed by any character followed by the first character that is matched. 

# "(.)(.)(.).*\\3\\2\\1" will match any character followed by any character followed by any character followed by any character zero or more times follwed by the third character that is matched followed by the second character that is matched followed by the first character that is matched. 
```

```{r}
# Quesion 2.1 
x <- 'eve'
str_view(x, "(.).*\\1")
```

```{r}
#  2.2
x <- 'church'
str_view(x, '(..).*\\1')
```

```{r}
#  2.3
x <- 'eleven'
str_view(x, '(.).*\\1.*\\1.*')
```


## Section 14.4: Tools
```{r}

```

#### Section 14.4.1.1 Exercises

```{r}
#  1.1
x <- 'x'
words <- c("spacex", "x", "not")
str_detect(words, '.*x$')
```

```{r}
#  1.2
words <- c("alphabet", "evan", "neuralink")
str_detect(words, '^[aeiou].*[^aeiou]$')
```

```{r 1.3.1}
# Are there any words that contain at least one of each different vowel
# If you were working for neuralink and you needed to parse all detected words of thought... you would need to know these skills... 

# words_example <- c("aa", "neuralinko", "counterexample")

contains_a <- str_count(words, "[a]")
contains_e <- str_count(words, "[e]")
contains_i <- str_count(words, "[i]")
contains_o <- str_count(words, "[o]")
contains_u <- str_count(words, "[u]")

for (index in seq_along(words)) {
  if (contains_a[[index]] >= 1 & 
      contains_e[[index]] >= 1 & 
      contains_i[[index]] >= 1 & 
      contains_o[[index]] >= 1 & 
      contains_u[[index]] >= 1){
    print(words[[index]])
  }
}


```

```{r}
# Quesion 2
vowels <- str_count(words, '[aeiou]')
word_count <- str_count(words, '[a-z]')

word_proportion <- vowels / word_count

for (col in seq_along(words)) {
  if (vowels[[col]] == max(vowels)){
    print_val <- str_c(words[[col]], "has the most vowels.", sep = " ")
    print(print_val)
  }
  
  if (word_proportion[[col]] == max(word_proportion)) {
    print_val <- str_c(words[[col]], "has the greatest ratio of vowels to characters in the word.", sep = " ")
    print(print_val)
  }
  
}
```


#### Section 14.4.2: Exact Matches
```{r}
length(sentences)

head(sentences)
```
#### 14.4.2.1 Exercises
```{r}
# Quesion 1
colours <- c("red", "orange", "yellow", "green", "blue", "purple")
colour_match <- str_c(colours, collapse = "\\b|\\b")
colour_match <- str_pad(colour_match, str_length(colour_match) + 2, side = "both", pad = " ")
colour_match <- str_replace_all(colour_match, " ", "\\\\b")
colour_match
```

```{r}
# Sentences that contain a color.
has_colour <- str_subset(sentences, colour_match) # str_subset will create a list of sentences. 
head(has_colour)
```

```{r}
# The color that was found in the sentences. 
matches <- str_extract(has_colour, colour_match) # string extract will extract the first color found in the sentences.
head(matches)
```

```{r}
# Sentences with more than one match of color in the sentence. 
more <- sentences[str_count(sentences, colour_match) > 1]
str_view_all(more)
```


```{r}
# Showcasing the fact that str_extract only pulls the first color from each sentence in which a color is found:
str_extract(more, colour_match) # Notice that the first sentence contains both blue and red which are not present in the returned value from str_extract.
```

```{r}
# To get all matches found in strings, use str_extract_all:
str_extract_all(more, colour_match) # Notice both blue and red appear. 
```

```{r}
str_extract_all(more, colour_match, simplify = TRUE)

```
```{r}
x <- c("a", "a b", "a b c") 
str_extract_all(x, "[a-z]", simplify = TRUE)
```

```{r}
more
```

```{r}
# Quesion 2.1
# Extract the first word from each sentence in the Harvard dataset.
# head(sentences)

first_word <- '^[A-Za-z]+'
str_extract_all(sentences, first_word)

```

```{r}
#  2.2
# All words ending in "ing"

ending_ing <- '[A-Za-z]+(ing)'

str_extract_all(sentences, ending_ing, simplify = TRUE)
```

```{r}
#  2.3.2 
# !!! do not split this into smaller parts; do not use for... use regex only...?

# All plurals sometimes
# n_sentence <- 320

# sentence <- sentences[n_sentence]
# sentence

plurals <- '(\\w+[^iea][b-h|j-r|t|v-z](s)\\b)'



remove_non_plurals <- 'sometimes|Always|always|Sometimes|Does|does'

for (col in seq_along(sentences)) {
  current_sentence <- sentences[[col]]
  extraction <- str_remove_all(current_sentence,remove_non_plurals)
  identified_plurals <- str_extract_all(extraction, plurals)
  if (!(identical(identified_plurals[[1]], character(0)))){
    print(extraction)
    print(identified_plurals)
  }
}

```

```{r}
#  2.3.2
# !!! do not split this into smaller parts; do not use for... use regex only...?
# Extract all plural words. 

# Answer: This uses a blocking character to define a word, a group of words that are in a negative lookahead group, then any number of one or more word characters followed by a single character that is not a,i,s,u and is alphabetic character followed by a group containing an s.

plurals <- "\\b(?!sometimes|does|Always|always|Sometimes|Does|its\\b)\\w+[b-h|j-r|t|v-z](s)\\b"
str_extract_all(sentences, plurals, simplify = TRUE)
```


#### Section 14.4.3 Grouped matches
```{r}

```



#### 14.4.3.1 Exercises
```{r}
# Quesion 1
# Find all words that come after a "number" like "one", "two", "three", etc. Pull out both the number and the word.

numbers <- c("zero","one", "two", "three", "four", "five", "six", "seven", "eight", "nine")
test_string <- "one employee"
regex_numbers <- str_c(numbers, collapse = "\\b|\\b")
regex_numbers <- str_pad(regex_numbers, width = str_length(regex_numbers) + 2, side = "both", pad = " ")
regex_numbers <- str_replace_all(regex_numbers, " ", "\\\\b")
regex_numbers <- str_c("(", regex_numbers)
regex_numbers <- str_c(regex_numbers, ")")
regex_numbers <- str_c(regex_numbers, " ([^ ]+)")

regex_numbers
# test_string %>% str_extract(test_string, regex_numbers, )
str_extract(test_string, regex_numbers)

```

```{r}
# Quesion 2
contraction_exp <- "(\\w+)('s)"

contractions <- tibble(sentence = sentences) %>%
  tidyr::extract(
    sentence, c("word", "contraction"), contraction_exp,
    remove = FALSE
  )

contractions %>% filter(!is.na(word) & !is.na(contraction))
```


#### Section 14.4.4: Replacing Matches
```{r}
sentences %>%
  str_replace("([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+)", "\\1 \\3 \\2") %>%
  head(5)
```


#### Section 14.4.4.1: Exercises
```{r}
# Quesion 1
# Replace all forward slashes with backslashses.

test_string <- "/"

forward_slash_regex <- '(\\/)'
replacement_regex <- '\\\\'
test_string %>% str_view(forward_slash_regex)


ans <- test_string %>% str_replace_all(forward_slash_regex, "\\\\")
print(ans)
```

```{r}
# Quesion 2

test_string <- "NEURALINK"

test_string %>% 
  str_replace_all("[A]", "a") %>% 
  str_replace_all("[B]", "b") %>%
  str_replace_all("[C]", "c") %>% 
  str_replace_all("[D]", "d") %>%
  str_replace_all("[E]", "e") %>% 
  str_replace_all("[F]", "f") %>%
  str_replace_all("[G]", "g") %>% 
  str_replace_all("[H]", "h") %>%
  str_replace_all("[I]", "i") %>% 
  str_replace_all("[J]", "j") %>%
  str_replace_all("[K]", "k") %>% 
  str_replace_all("[L]", "l") %>%
  str_replace_all("[M]", "m") %>% 
  str_replace_all("[N]", "n") %>%
  str_replace_all("[O]", "o") %>% 
  str_replace_all("[P]", "p") %>%
  str_replace_all("[Q]", "q") %>% 
  str_replace_all("[R]", "r") %>%
  str_replace_all("[S]", "s") %>% 
  str_replace_all("[T]", "t") %>%
  str_replace_all("[U]", "u") %>% 
  str_replace_all("[V]", "v") %>%
  str_replace_all("[W]", "w") %>% 
  str_replace_all("[X]", "x") %>%
  str_replace_all("[Y]", "y") %>% 
  str_replace_all("[Z]", "z")

```

```{r}
# Quesion 3
# Switch the first and last letters in words. Which of those strings are still words?
test_sample <- words[2]
match_regex <- "\\b(.)([a-z]*)(.)\\b"
replacement_regex <- "\\3\\2\\1"
# 
# test_sample
# test_sample %>% str_replace(match_regex, replacement_regex)

new_words <- words %>%
  str_replace(match_regex, replacement_regex)

list_of_sensible_words <- words[str_equal(new_words, words)]

length(list_of_sensible_words) 

# 37 of the words are still words. 
list_of_sensible_words
```
## Section 14.4.5: Splitting

```{r}
sentences %>%
  head(5) %>%
  str_split(" ")
```
```{r}
# Extract the first element of a list

"a|b|c|d" %>%
  str_split("\\|") %>%
  .[[1]]
```

```{r}
# Otherwise return a matrix with simplify = TRUE
words %>%
  head(10) %>%
  str_split(" ", simplify = TRUE)
```
```{r}
# Request a maximum number of pieces:

fields <- c("Organization: Neuralink", "State: Texas", "City: Austin", "Employee: Hired", "Patient: Cured")

fields %>%
  head(10) %>%
  str_split(": ", n = 2, simplify = TRUE)
```

```{r}
x <- "This is a sentence. This is another sentence"
str_view_all(x, boundary("word"))

str_split(x, boundary("word"))
str_split(x, " ")
```

#### Section 14.4.5.1: Exercises
```{r}
# Quesion 1
sample_string <- "apples, pears, and bananas"

sample_string %>% str_split(boundary("word"))
```

```{r}
# Quesion 2
# It is better to split by word boundary than by spaces because a boundary will not include punctuation whereas words at the end of a sentence will.
```

```{r}
# Quesion 3
sample_string %>% str_split("")
# Splitting by "" will split each element in a string into individual characters.
# "" is equivalent to boundary(character)
```


#### Section 14.4.6: Find Matches
```{r}
# str_locate() to find the starting and ending locations of each match.
# str_locate() to find a matching pattern; str_sub() to extract and/or modify the patterns.

```

## 14.5 Other Types of Patterns
```{r}
# A pattern that is a string will automatically make a conversion to regex.
str_view(fruit, "nana")

str_view(fruit, regex("nana"))
```

```{r}
bananas <- c("banana", "Banana", "BANANA")
str_view(bananas, "banana")

# Ignore case
str_view(bananas, regex("banana", ignore_case = TRUE))
```

```{r}
 # multiline = TRUE allows ^ and $ to match the start of each line rather than the start of each string

x <- "Line 1\nLine 2\nLine 3\n"

# The start of the first string
str_extract_all(x, "^Line")[[1]]

# The start of the first line
str_extract_all(x, regex("^Line", multiline = TRUE))[[1]]

```

```{r}
# Comments: comments = TRUE will allow spaces and # to be ignored
phone <- regex("
  \\(?     # optional opening parens
  (\\d{3}) # area code
  [) -]?   # optional closing parens, space, or dash
  (\\d{3}) # another three numbers
  [ -]?    # optional space or dash
  (\\d{3}) # three more numbers
", comments = TRUE)

str_match("888-867-5309", phone)
```

```{r}
# Regex options:
# dotall = TRUE allows . to match one of any type of character including \n
```

```{r}
# Other regex options
# fixed() matches exactly the specified sequence in bytes. It ignores all special regular expressions and operates at a very low level.

if(!require("microbenchmark")) install.packages("microbenchmark")
library(microbenchmark)

# Fixed is about 3 times as faster than regex. Do not use with non-English data.
microbenchmark::microbenchmark(
  fixed = str_detect(sentences, fixed("the")), 
  regex = str_detect(sentences, "the"),
  times = 20
)

```


```{r}
# coll compares strings with standard collation rules. 
# If a character is represented with two or more ways, coll will repect the human readable equality of the two. 
# i.e. a with an accent can also be represented as a character "a" that has an accent. i.e.:
a1 <- "\u00e1"
a2 <- "a\u0301"
c(a1, a2)

# False, should be true
a1 == a2

# Fixed reports false; should be true.
str_detect(a1, fixed(a2))

# Collate reports True.
str_detect(a1, coll(a2))

# Collate is the slowest because the rules are complex. However, collate is the only function to return the correct answer.
microbenchmark(
  str_detect(a1, regex(a2)),
  str_detect(a1, fixed(a2)),
  str_detect(a1, coll(a1)),
  times = 20
)

```

```{r}
# Using boundary with other functions.
x <- "This is a sentence"
str_view_all(x, boundary("word"))
str_extract_all(x, boundary("word"))
```
#### Section 14.5.1: Exercises
```{r}
# Quesion 1
# Regex
str_detect("\\", regex("\\\\"))

# Fixed
str_detect("\\", fixed("\\"))
```

```{r}
# Quesion 2
# What are the five most common words in sentences?
head(sentences)
words_in_sentences <- str_split(sentences, boundary("word"), simplify = TRUE)

wordList <- c("")
for (word in seq_along(words_in_sentences)) {
  current_word <- words_in_sentences[word]
  wordList[word] = str_to_lower(current_word)
}
length(wordList)
unique_word_list <- unique(wordList)
length(unique_word_list)

count_of_unique_word <- c("")
for (word in seq_along(unique_word_list)){
  current_word <- unique_word_list[[word]]
  regex_word <- str_c("\\b", current_word)
  regex_word <- str_c(regex_word, "\\b")
  word_count <- str_count(wordList, regex_word)
  # word_count
  
  # print("sum(word_count)")
  # print(sum(word_count))
  # print("word")
  # print(word)
  
  count_of_unique_word[word] <- sum(word_count)
}

unique_word_list_tb <- tibble(unique_word_list, as.integer(count_of_unique_word))
(unique_word_list_tb)
unique_word_list_tb <- unique_word_list_tb %>% rename(count_of_unique_word = `as.integer(count_of_unique_word)`)
unique_word_list_tb_filtered_arranged <- unique_word_list_tb %>% filter(!(unique_word_list == "")) %>% arrange(desc(count_of_unique_word))
head(unique_word_list_tb_filtered_arranged, 5)
```

# Section 14.6: Other uses of regular expressions

```{r}
# Searches all object available from the global environment. Useful if you forget the name of the function.
apropos("replace")
```


```{r}
# List all files in a directory
head(dir(pattern = "\\."))
```

## Section 14.7: stringi
```{r}
# stringi contains 256 functions. stringr is built on stringi, but only contains 59 functions. 
```

#### Section 14.7.1: Exercises
```{r}
# Quesion 1
# Stringi functions
# Count the number of words: stringi::stri_count()
# Find duplicated strings: stringi::stri_dup()
# Generates random strings: stringi::stri_rand_strings()
# Control the language that stri_sort uses for sorting by passing a locale value to the function stri_sort. It is also possible to set the variable "french".
```

# Section 15: Factors
## Section 15.1: Creating Factors
```{r}
# Creating a factor

# Assigning Data
x1 <- c("Dec", "Apr", "Jan", "May")

# Manually assigning months
month_levels <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

# Creating a factor with levels
factorx <- factor(x1, levels = month_levels)
factorx

# Sortable factor
sort(factorx)

# Create factor with data
factordata <- factor(x1)
factordata

# Sort
sort(factordata)

# Create a factor with data where the leves are the unique values in the data
factor_unique <- factor(x1, levels = unique(x1))
sort(factor_unique)

# Setting a factor levels as found in hte data
factor_unique_after <- x1 %>% factor() %>% fct_inorder()
sort(factor_unique_after)

# Access the levels directly 
levels(factordata)

```
## Section 15.3 General Social Survey
```{r}

```

#### Section 15.3.1: Exercise
```{r}
# Quesion 1
# This bar chart is rotated 90 degrees because the x-axis of rincome was illegible. Removing Refused, Don't Know, No Answer, and Not Applicable from the current chart into a different bar chart and/or creating a new chart that consists of only those variables would make it clear as to the distribution of rincome at first glance. It would be useful to add a legend that described precisely what is meant by the abbreviation: "Lt". It would be useful to know why there are a great number of values in the category "Not Applicable". 

ggplot(gss_cat)+
  geom_bar(aes(rincome)) + 
  coord_flip() 
```

```{r}
# Quesion 2
# Protestant is the most common religion in this survey.
ggplot(gss_cat) + 
  geom_bar(aes(relig)) + 
  coord_flip()
```
```{r}
# names(gss_cat)

class(gss_cat$partyid)
```


```{r}
# Independent is the most common party in this survey.
# How do you reorder a bar chart using a factor???
ggplot(gss_cat) + 
  geom_bar(aes(partyid)) + 
  coord_flip()
```

```{r}
party_id_count <- gss_cat %>% group_by(partyid) %>% summarise(count = n())


names(party_id_count)


```


```{r}

# To reorder the bars of a bar chart, use geom_col, aes(fct_reorder(factor, count_of_factor), count, after_stat = "Identity", fill = count)
ggplot(party_id_count) + 
  geom_col(aes(x = fct_reorder(partyid, count), y = count, after_stat = "Identity", fill = count)) +
  coord_flip()

```

#### Section 15.4: Modifying factor order
```{r}
relig_summary <- gss_cat %>%
  group_by(relig) %>%
  summarise(
    age = mean(age, na.rm = TRUE),
    tvhours = mean(tvhours, na.rm = TRUE),
    n = n()
  )

ggplot(relig_summary, aes(tvhours, relig)) + geom_point()
```
```{r}
# class(relig_summary$tvhours)

# reorder a factor: fct_reorder(relig, tvhours): Sort religion using the values of tvhours
ggplot(relig_summary, aes(tvhours, fct_reorder(relig, tvhours))) + geom_point()
```

```{r}
# Reorder individual factors

rincome_summary <- gss_cat %>%
  group_by(rincome) %>%
  summarise(
    age = mean(age, na.rm = TRUE), 
    tvhours = mean(tvhours, na.rm = TRUE),
    n = n()
  )

# ggplot(rincome_summary, aes(age, fct_reorder(rincome, age))) + geom_point() # rincome already has an order; do not do this

# ggplot(rincome_summary, aes(age, fct_relevel(rincome))) + geom_point()
ggplot(rincome_summary, aes(age, rincome)) + geom_point() # Natural Plot
ggplot(rincome_summary, aes(age, fct_relevel(rincome, "Not applicable"))) + geom_point() # Moves Not applicable to the front of the list. 

```
```{r}
# fct_reorder2 will reorder the factor by the y values associated with the largest x values in the plot.

by_age <- gss_cat %>%
  filter(!is.na(age)) %>%
  count(age, marital) %>%
  group_by(age) %>%
  mutate(prop = n / sum(n))

ggplot(by_age, aes(age, prop, colour = marital)) +
  geom_line(na.rm = TRUE)

# reordering the legend using fct_reorder2(data, x, y); fct_reorder 2 reorders the y values by the largest value that corresponds to the values in x. fct_reorder2(data, )... given x, reorder y with the largest corresponding value.

ggplot(by_age, aes(age, prop, colour = fct_reorder2(marital, age, prop))) +
  geom_line() +
  labs(colour = "marital")
```
```{r}
# Reordering Bar Charts
# reorder factor levels by frequency level using fct_infreq (largest value first); 
# fct_rev() to reverse the ordering of the factors.

# Original
gss_cat %>%
  ggplot(aes(marital)) +
  geom_bar()

# infreq
gss_cat %>% 
  mutate(marital = marital %>% fct_infreq()) %>%
  ggplot(aes(marital)) + 
  geom_bar()

# infreq & reversed
gss_cat %>% 
  mutate(marital = marital %>% fct_infreq() %>% fct_rev()) %>%
  ggplot(aes(marital)) + 
  geom_bar()


```

#### Section 15.4.1: Exercises
```{r}
# Quesion 1
# The mean may not be a good summary for tvhours if there are outliers. Outliers can effect the mean. The median would be a better choice to represent an average with outliers. 
```

```{r}
# Quesion 2
# head(gss_cat)
# names(gss_cat)
# Factors: marital, race, rincome, partyid, relig, denom

# Order of levels:

# levels(gss_cat$marital) # arbitrary order
# levels(gss_cat$race) # arbitrary order
levels(gss_cat$rincome) # prinicipled: descending with respect to values
# levels(gss_cat$partyid) # principled: strength of polarity of party
# levels(gss_cat$relig) # arbitrary order
# levels(gss_cat$denom) # arbitrary order
```

```{r}
# Quesion 3
# The factors are decreasing in incremental value as the levels increase within the collection. Column 4 represents the largest value & column 15 represents the least significant numeric value in the penultimate significant position within the collection. The plot plots the values from the value within column of the least significant position  upwards as the position within the collection of levels increases. By moving the value from the column in the most significant position of factor levels to the least significant position, i.e. "the front", the least significant position, 1, was plotted first at the bottom of the plot.  
```

## Section 15.5: Modifying factor levels
```{r}

# fct_recode() allows you to rename the values at each level

gss_cat %>% count(partyid)

gss_cat %>%
  mutate(partyid = fct_recode(partyid,
                              "Republican, strong" = "Strong republican",
                              "Republican, weak" = "Not str republican",
                              "Independent, near rep" = "Ind,near rep",
                              "Independent, near dem" = "Ind,near dem",
                              "Democrat, weak" = "Not str democrat",
                              "Democrat, strong" = "Strong democrat"
                              )) %>%
                              count(partyid)
```



```{r}
# Combine groups by assigning multiple levels to the same level.
gss_cat %>%
  mutate(partyid = fct_recode(partyid,
                              "Republican, strong" = "Strong republican",
                              "Republican, weak" = "Not str republican",
                              "Independent, near rep" = "Ind,near rep",
                              "Independent, near dem" = "Ind,near dem",
                              "Democrat, weak" = "Not str democrat",
                              "Democrat, strong" = "Strong democrat",
                              "Other" = "No answer",
                              "Other" = "Don't know",
                              "Other" = "Other party"
                              )) %>%
                              count(partyid)
```



```{r}
# Collapsing levels:
gss_cat %>%
  mutate(partyid = fct_collapse(partyid, 
                                other = c("No answer", "Don't know", "Other party"), 
                                rep = c("Strong republican", "Not str republican"),
                                ind = c("Ind,near rep", "Independent", "Ind,near dem"),
                                dem = c("Not str democrat", "Strong democrat"))) %>%
                                count(partyid)
```

```{r}
# lumping all the small groups together to make a table simpler
gss_cat %>%
  mutate(relig = fct_lump(relig)) %>%
  count(relig)

# Specify the number of lumps with n
gss_cat %>%
  mutate(relig = fct_lump(relig, n = 10)) %>%
  count(relig)
```

```{r}
# gss_cat %>% count(year)
(gss_cat_party_collapse_year_partyid_count <-gss_cat %>% mutate(partyid = fct_collapse(partyid,
  other = c("No answer", "Don't know", "Other party"),
  rep = c("Strong republican", "Not str republican"),
  ind = c("Ind,near rep", "Independent", "Ind,near dem"),
  dem = c("Not str democrat", "Strong democrat")
)) %>% group_by(year, partyid) %>% summarise(count = n()) %>% filter(partyid == "rep" | partyid == "dem" | partyid == "ind"))

```

```{r}
gss_cat_party_collapse_year_partyid_count %>% count(year)
```

```{r}
# Quesion 1
ggplot(gss_cat_party_collapse_year_partyid_count) +
  geom_point(aes(year, count, group = partyid, color = partyid)) + 
  geom_smooth(aes(year, count, group = partyid, color = partyid), se = FALSE) +
  labs(title = "Number of Members in the Republican, Independent, and Democratic Parties", subtitle = "Years: 2000 - 2014", x = "Year", y = "Population")
```

```{r}
# Quesion 2
# rincome can be regrouped into "$10000 to $24999, "Lt $1000 to $9999", and over 25000. No answer, Don't know, Refused, & Not applicable can all be sorted into a category listed as Other.

gss_cat %>% count(rincome) # original
gss_cat %>% mutate(rincome = fct_lump(rincome, n = 4)) %>% count(rincome) # unreliable, unknown what comprises "Other", useful for a quick idea of groups.

gss_cat_regrouped <- gss_cat %>% mutate(rincome = fct_recode(rincome,
  "$25000 or more" = "$25000 or more",
  
  "$10000 to $24999" = "$10000 - 14999", 
  "$10000 to $24999" = "$15000 - 19999", 
  "$10000 to $24999" = "$20000 - 24999",
  
  "Lt $1000 to $9999" = "Lt $1000", 
  "Lt $1000 to $9999" = "$1000 to 2999", 
  "Lt $1000 to $9999" = "$3000 to 3999", 
  "Lt $1000 to $9999" = "$4000 to 4999", 
  "Lt $1000 to $9999" = "$5000 to 5999", 
  "Lt $1000 to $9999" = "$6000 to 6999", 
  "Lt $1000 to $9999" = "$7000 to 7999", 
  "Lt $1000 to $9999" = "$8000 to 9999", 
  
  "Other" = "Don't know", 
  "Other" = "Refused", 
  "Other" = "No answer", 
  "Other" = "Not applicable"
  ))

gss_cat_regrouped %>% count(rincome)
```

```{r}
# Summary of what I learned: 
# fct_reorder to reorder columns 
# fct_collapse to collapse columns 
# fct_recode to recode columns into new groups
# fct_reorder2 to reorder the y values in a legend to match orders of the lines. 
```


# Section 16: Dates and Times
```{r}
# Create date time from input
flights %>% 
  select(year, month, day, hour, minute) %>%
  mutate(departure = make_datetime(year, month, day, hour, minute))
```


```{r}
make_datetime_100 <- function(year, month, day, time) {
  make_datetime(year, month, day, time %/% 100, time %% 100)
}

flights_dt <- flights %>%
  filter(!is.na(dep_time), !is.na(arr_time)) %>%
  mutate(
    dep_time = make_datetime_100(year, month, day, dep_time),
    arr_time = make_datetime_100(year, month, day, arr_time), 
    sched_dep_time = make_datetime_100(year, month, day, sched_dep_time),
    sched_arr_time = make_datetime_100(year, month, day, sched_arr_time)
  ) %>%
  select(origin, dest, ends_with("delay"), ends_with("time"), distance, flight)

flights_dt
```

```{r}
flights_dt %>%
  ggplot(aes(dep_time)) +
  geom_freqpoly(binwidth = 86400) # 86400 seconds = 1 day
```

```{r}
flights_dt %>%
  filter(dep_time < ymd(20130102)) %>%
  ggplot(aes(dep_time)) +
  geom_freqpoly(binwidth = 600) # 600 s = 10 minutes
```

```{r}
as_datetime(today())
as_date(now())
```

#### 16.2.4: Exercises
```{r}
# Quesion 1
# There is a warning that the function failed to parse & the data is NA.
ymd(c("2010-10-10", "bananas"))
```

```{r}
# Quesion 2
# tzone sets the current time zone of the value today.
today(tzone = "GMT")
today(tzone = "EST")
today(tzone = "UTC")
```

```{r}
# Question 3.1
if(!require("lubridate")) install.packages("lubridate")
library(lubridate)
```


```{r}
# Question 3.2
d1 <- "January 1 2010"
d2 <- "2015-Mar-07"
d3 <- "06-Jun-2017"
d4 <- c("August 19 (2015)", "July 1 (2015)")
d5 <- "12/30/14" # Dec 30, 2014

```

```{r}
# Question 3.3
mdy(d1)
ymd(d2)
dmy(d3)
mdy(d4)
mdy(d5)
```

## Section 16.3: Date-time components
```{r}
# Return an abbreviated name of the month or day of the week. Set abbr = FALSE to return the full name.
datetime <- ymd_hms("2016-07-08 12:34:56")

year(datetime)
month(datetime)
mday(datetime)

yday(datetime)
wday(datetime)
```

```{r}
# month() & wday() : label = TRUE will return an abbreviated version of the day of the month or the day of the week. 
# abbr = FALSE will return the full name of the day of the month or day of the week.

month(datetime, label = TRUE)
weekday <- wday(datetime, label = TRUE, abbr = FALSE)
class(weekday)
(weekday)
```

```{r}
# wday(flights_dt$dep_time, label = TRUE)
```


```{r}
flights_dt %>%
  mutate(wday = wday(dep_time, label = TRUE)) %>%
  ggplot(aes(x = wday)) +
  geom_bar()
```

```{r}
flights_dt %>%
  mutate(minute = minute(dep_time)) %>%
  group_by(minute) %>%
  summarise(
    avg_delay = mean(arr_delay, na.rm = TRUE),
    n = n()) %>%
  ggplot(aes(minute, avg_delay)) +
  geom_line()
```

```{r}
sched_dep <- flights_dt %>%
  mutate(minute = minute(sched_dep_time)) %>%
  group_by(minute) %>%
  summarise(
    avg_delay = mean(arr_delay, na.rm = TRUE),
    n = n())

ggplot(sched_dep, aes(minute, avg_delay)) + 
  geom_line()
```

#### Section 16.3.4: Exercises
```{r}
# Quesion 1
# How does the distribution of flight times within a day change over the course of the year?
flights_dt %>%
  mutate(day = day(dep_time)) %>% count(day)
```


```{r}
# Frequency of arrival times for the year 2013
flights_dt %>% 
  ggplot(aes(arr_time)) + 
  geom_freqpoly(binwidth = 86400) # 86400 = Number of seconds within a day
```


```{r}
# Quesion 2
# dep_time
# sched_dep_time
# dep_delay

flights_dt %>%
  mutate(minute = minute(dep_time)) %>%
  group_by(minute) %>%
  summarise(
    avg_delay = mean(arr_delay, na.rm = TRUE),
    n = n()) %>%
  ggplot(aes(minute, avg_delay)) +
  geom_line()

####
```


```{r}
# Quesion 2
flights_dt %>% select(dep_time, sched_dep_time, dep_delay)
```


```{r}
# Quesion 2
# Compare the dep_time, sched_dep_time, & dep_delay. Are they consistent?

flights_dt$dep_time[2] - flights_dt$sched_dep_time[2]

```


```{r}
# Quesion 2
flights_dt %>% group_by(dep_time, sched_dep_time, dep_delay) 

dep_time_minus_sched_dep_time <- difftime(flights_dt$dep_time, flights_dt$sched_dep_time, units = c("mins"))

class(dep_time_minus_sched_dep_time)
times1 <- dep_time_minus_sched_dep_time
times2 <- as.difftime(flights_dt$dep_delay, units = "mins")

# time <- 28
# times1[time]
# times2[time]

flights_dt$sched_dep_time[times1 != times2][1]
flights_dt$dep_time[times1 != times2][1]
flights_dt$dep_delay[times1 != times2][1]

# Recorded Departure Delay
hours <- flights_dt$dep_delay[times1 != times2][1] / 60
minutes <- flights_dt$dep_delay[times1 != times2][1] %% 60
(hours)
(minutes)

# Quantity of detected Errors
length(flights_dt$dep_delay[times1 != times2])

# Calculated difference between dep_time and scheduled departure time
flights_dt$dep_time[times1 != times2][1] - flights_dt$sched_dep_time[times1 != times2][1]

# Calculated difference between dep_time and scheduled departure time in minutes
(calculated_difference_min <- 9*60 + (.783333 * 60))

# Numeric discrepancy
flights_dt$dep_delay[times1 != times2][1]  - calculated_difference_min

# There are 1205 inconsistencies within the data. The dep_delay of a sample of the dataset suggests a recorded delay of 853 minutes whereas the actual departure of the same sample was calculated to be 587 minutes. The difference is 266 minutes. I infer this is an error in recording the dep_delay rather than an error in the difference between the recordings of the scheduled_dep_time and the dep_time.

```

```{r}
# Quesion 3
# Compare air_time with the duration between the departure and arrival.
flights_dt %>% select(air_time)

# flights$air_time
arr_time_minus_dep_time <- difftime(flights_dt$arr_time, flights_dt$dep_time, units = "mins")
air_time_as_difftime <- as.difftime(flights_dt$air_time, units = "mins")

length(arr_time_minus_dep_time)
length(flights_dt$air_time)
length(flights$distance)

n_time = 3

flights_dt$dep_time[n_time]
flights_dt$arr_time[n_time]

arr_time_minus_dep_time[n_time]
air_time_as_difftime[n_time]

equal_arrival_times <- flights_dt$arr_time[arr_time_minus_dep_time == air_time_as_difftime]
length(equal_arrival_times)

unequal_arrival_times <- flights_dt$arr_time[arr_time_minus_dep_time != air_time_as_difftime]
length(unequal_arrival_times)

flights_dt$origin[n_time]
flights_dt$dest[n_time]

flights_dt$distance[n_time]

# There are 327867 flights that contain discrepancies between the time in the air and the difference between the departure time and arrival time. There are 913 flights where the difference between the departure time and arrival times are equal to the time spent in the air.
```


```{r}
# Quesion 3
flights_dt_diff <- flights_dt %>% filter(arr_time %in% unequal_arrival_times) %>% mutate(diff_arr_minus_dep = difftime(arr_time, dep_time, units = "mins")) %>% mutate(air_time = as.difftime(air_time, units = "mins")) %>% select(dep_time, arr_time, diff_arr_minus_dep, air_time, distance, dest, origin, everything()) 
```


```{r}
head(flights_dt_diff)
```

```{r} 
# Planes that spent time in the air by destination.

# Planes that spent less time in the air.
air_time_less_dest_list <- flights_dt_diff %>% filter(diff_arr_minus_dep > air_time) %>% count(dest)

# plans that spent more time in the air. 
air_time_greater_dest_list <- flights_dt_diff %>% filter(diff_arr_minus_dep < air_time) %>% count(dest)
```

```{r} 
# There are 73 destinations in common between these two lists.
air_time_greater_dest_list %>% filter((dest %in% air_time_less_dest_list$dest))

# There are 21 destinations that are not common between these two lists.
air_time_greater_dest_list %>% filter(!(dest %in% air_time_less_dest_list$dest))
```



```{r}
# Planes that spent time in the air by origin.

# Planes that spent less time in the air.
air_time_less_origin_list <- flights_dt_diff %>% filter(diff_arr_minus_dep > air_time) %>% count(origin)

# Planes that spent more time in the air. 
air_time_greater_origin_list <- flights_dt_diff %>% filter(diff_arr_minus_dep < air_time) %>% count(origin)
```


```{r}
# No origins not in common between these two lists.
air_time_greater_origin_list %>% filter(!(origin %in% air_time_less_origin_list$origin))
```


```{r}
# All origins are common between these two lists.
air_time_greater_origin_list %>% filter((origin %in% air_time_less_origin_list$origin))
```

```{r}
# Planes that spent a greater amount of time in the air. Sorted. 
air_time_greater_dest_list %>% arrange(desc(n))

# Planes that spent less time in the air. Sorted. 
air_time_less_dest_list %>% arrange(desc(n))
```


```{r}
length(air_time_greater_dest_list$dest)

```


```{r}
# Quesion 3
# Airport destinations where the plane circled during its flight.
airports %>% 
  semi_join(air_time_greater_dest_list, c("faa" = "dest")) %>%
  ggplot(aes(lon, lat)) + 
  borders("state") +
  geom_point() +
  coord_quickmap()
```
```{r}
# Quesion 3
# Airport destinations where the plane taxied after its flight.
airports %>% 
  semi_join(air_time_less_dest_list, c("faa" = "dest")) %>%
  ggplot(aes(lon, lat)) + 
  borders("state") +
  geom_point() +
  coord_quickmap()
```


```{r}
# Planes that spent more time in the air. 
number_of_flights_per_distance <- flights_dt_diff %>% filter(diff_arr_minus_dep < air_time) %>% group_by(distance) %>% summarise(count = n()) %>% arrange(desc(count))
```

```{r}
average_flight_distance_air_time_greater_than_arr_dep_diff <- sum(number_of_flights_per_distance$distance) / length(number_of_flights_per_distance$distance)
```

```{r}
# Planes that spent less time in the air.
number_of_flights_per_distance_air_time_less <- flights_dt_diff %>% filter(diff_arr_minus_dep > air_time) %>% group_by(distance) %>% summarise(count = n()) %>% arrange(desc(count))
```


```{r}
average_flight_distance_air_time_less_than_arr_dep_diff <- sum(number_of_flights_per_distance_air_time_less$distance) / length(number_of_flights_per_distance_air_time_less$distance)
```

```{r}
# Comparison of average flights times for planes that spent more time in the air versus less:
average_flight_distance_air_time_greater_than_arr_dep_diff
average_flight_distance_air_time_less_than_arr_dep_diff
```


```{r}
# After viewing the map of fligths that spent longer in the air than the difference between the arrival and departure time and comparing the average amount of flights among distances that spent more time in the air than the difference between the arrival and departure times, I infer that the planes that spent more time in the air were farther to their destination on average. Planes that spent less time in the air were closer to their destinations.
```


```{r}
# Quesion 4
# How does the average delay time change over the course of a day? I will use the sched_dep_delay to group the departure delay times. Then I will compute the average amongst the groups. 

flights_dt_diff
```

```{r}
# Quesion 4
flights_dt %>% mutate(day = day(dep_time)) %>%
  select(day, dep_time, dep_delay) %>% group_by(day) %>% summarise(mean(dep_delay))
```


```{r}
# Quesion 4
# how does the average 
flights_dt %>% mutate(day = day(dep_time)) 

# %>%
#   select(day, dep_time, dep_delay) %>% group_by(day) %>% summarise(mean(dep_delay))

ggplot(flights_dt) +
  geom_point(aes(dep_time, dep_delay)) +
  geom_smooth(aes(dep_time, dep_delay), se = FALSE)

```
```{r}
# Quesion 4
# Change in average departure delay over the course of a day. 
avg_dep_delay <- flights_dt %>% group_by(sched_dep_time, dep_delay) %>% summarise(n()) %>% summarise(mean(dep_delay))

ggplot(avg_dep_delay) +
  geom_point(aes(sched_dep_time, `mean(dep_delay)`)) +
  geom_smooth(aes(sched_dep_time, `mean(dep_delay)`), se = FALSE)
```


```{r}
# Quesion 5
avg_dep_delay <- flights_dt %>% group_by(sched_dep_time, dep_delay) %>% summarise(n()) %>% summarise(mean(dep_delay))
```


```{r}
# Quesion 5
avg_dep_delay %>% mutate(wday = wday(sched_dep_time, label = TRUE)) %>% arrange(`mean(dep_delay)`) %>% filter(`mean(dep_delay)` >0)
```


```{r}
# Quesion 5
# Saturday is the day with the lowest average delay. 
flights_dt %>% mutate(wday = wday(sched_dep_time, label = TRUE)) %>% group_by(wday, dep_delay) %>% summarise(n()) %>% summarise(mean(dep_delay)) %>% arrange(`mean(dep_delay)`)
```

```{r}
# Quesion 6

diamonds_carat <- diamonds %>% count(carat) %>% arrange(desc(`n`))
flights_sched_dep_time <- flights %>% count(sched_dep_time) %>% arrange(desc(`n`))

ggplot(diamonds_carat) +
  geom_freqpoly(aes(diamonds_carat$n))
```


```{r}
# Quesion 6
min(diamonds$carat)
max(diamonds$carat)
mean(diamonds$carat)
sd(diamonds$carat)

###

min(flights$sched_dep_time)
max(flights$sched_dep_time)
mean(flights$sched_dep_time)
sd(flights$sched_dep_time)

```


```{r}
flights_dt %>%
  mutate(wday = wday(dep_time, label = TRUE)) %>%
  ggplot(aes(x = wday)) +
  geom_bar()
```


```{r}
flights_dt %>%
  mutate(day = day(dep_time)) %>%
  group_by(day) %>%
  summarise(
    avg_delay = mean(arr_delay, na.rm = TRUE),
    n = n()) %>%
  ggplot(aes(day, avg_delay)) +
  geom_line()
```
```{r}
diamonds$carat
```


```{r}
# Distribution of carats in Diamonds
ggplot() +
  geom_histogram(aes(diamonds$carat))

# Distribution of scheduled departure times in flights
ggplot() +
  geom_histogram(aes(flights$sched_dep_time))

# These two distributions are not similar. 
```

```{r}
# Quesion 7

```
```{r}
# flights_dt %>% mutate(min = minute(dep_time)) %>% select(min, everything()) %>% group_by(min) %>% summarise(n())

count_of_early_departed_flights_grouped_by_minute <- flights_dt %>% mutate(min = minute(dep_time)) %>% mutate(early = dep_delay < 0) %>% select(early, min, dep_delay, everything()) %>% filter(early == TRUE) %>% group_by(min, dep_delay) %>% summarise() %>% summarise(count = n())


(count_of_early_departed_flights_grouped_by_minute)

ggplot(count_of_early_departed_flights_grouped_by_minute) +
  geom_line(aes(min, count))

```

```{r}
# flights_dt %>% mutate(min = minute(dep_time)) %>% select(min, everything()) %>% group_by(min) %>% summarise(n()) ???

flights_dt %>% mutate(early = dep_delay < 0) %>% filter(early == TRUE) %>% select(early, sched_dep_time, dep_delay, everything())
```


```{r}
###
count_of_early_departed_flights_grouped_by_minute <- flights_dt %>% mutate(min = minute(sched_dep_time)) %>% mutate(early = dep_delay < 0) %>% select(early, min, dep_delay, everything()) %>% filter(early == TRUE) %>% group_by(min, dep_delay) %>% summarise() %>% summarise(count = n())

(count_of_early_departed_flights_grouped_by_minute)

ggplot(count_of_early_departed_flights_grouped_by_minute) +
  geom_line(aes(min, count))

```

```{r}
# Causality:
# Empirical Association
# Temporal priority of the independent variable
# Nonspuriousness (There are is not a hidden variable influencing the dependent outcome.)
#---#
# Identifying a causal mechanism (how)
# Specifying the context in which the effect occurs (under which conditions & parameters)




```

```{r}
#  Question 7
# Hypothesis: Early Departures of flights in minutes 20-30 and 50-60 are caused by scheduled flights that leave early. 

# flights_dt %>% mutate(min = minute(dep_time), delayed = dep_delay > 0, early = dep_delay < 0) %>% select(early, delayed, dep_delay, dep_time, min, everything()) 

# Early departures of flights in minutes 20-30 
flights_dt %>% mutate(min = minute(dep_time), delayed = dep_delay > 0, early = dep_delay < 0) %>% select(early, delayed, dep_delay, dep_time, min, everything()) %>% filter(min >= 20, min <= 30, early == TRUE) %>% arrange(min)

# Scheduled Flights that leave early

flights_dt %>% mutate(min = minute(dep_time), delayed = dep_delay > 0, early = dep_delay < 0) %>% select(early, delayed, dep_delay, dep_time, min, sched_dep_time, everything()) 

# flights_dt %>% mutate(min = minute(dep_time), delayed = dep_delay > 0, early = dep_delay < 0) %>% select(early, delayed, dep_delay, dep_time, min, everything())

# Is there a correlation between scheduled flights that leave late and 

# Early departures of flights in minutes 20-30 are caused by scheduled flights that leave early. 
# Early departures of flights are the same concept as scheduled flights that leave early.

# Examine the early departures.
# Examine the scheduled departures. 
# Examine the departure times.

# Plot sched_dep_times in minutes 20 - 30 that are delayed.
# Is there a correllation between scheduled departure times that are delayed and early departures?
```


```{r}
#  Question 7
# scheduled flights that are delayed during minutes 20 to 30.

flights_dt %>% 
  mutate(delayed = dep_delay > 0, min = minute(sched_dep_time)) %>%
  select(delayed, min, sched_dep_time, everything()) %>%
  arrange(min) %>% filter(delayed == TRUE)


# %>% 
  # 
  # filter(delayed == TRUE, min >=20, min <=30) %>% 
  # select(min, sched_dep_time) %>% arrange(min) %>% 
  # group_by(min) %>% 
  # summarise(count = n())


# scheduled_flights_min_20_30_delayed <- flights_dt %>% 
#   mutate(delayed = dep_delay > 0, min = minute(sched_dep_time)) %>% 
#   filter(delayed == TRUE, min >=20, min <=30) %>% 
#   select(min, sched_dep_time) %>% arrange(min) %>% 
#   group_by(min) %>% 
#   summarise(count = n())
# 
# (scheduled_flights_min_20_30_delayed)
# ggplot(scheduled_flights_min_20_30_delayed) + 
#   geom_line(aes(min, count)) + 
#   labs(title = "Number of flights that are delayed from minutes 20 - 30")
```


```{r}
#  Question 7
####
# scheduled flights that are not delayed (early) during minutes 20 to 30.
scheduled_flights_min_20_30_not_delayed <- flights_dt %>% 
  mutate(delayed = dep_delay > 0, min = minute(sched_dep_time)) %>% 
  filter(delayed == FALSE, min >=20, min <=30) %>% 
  select(min, sched_dep_time) %>% arrange(min) %>% 
  group_by(min) %>% 
  summarise(count = n())


(scheduled_flights_min_20_30_not_delayed)
ggplot(scheduled_flights_min_20_30_not_delayed) + 
  geom_line(aes(min, count)) + 
  labs(title = "Number of flights that are delayed from minutes 20 - 30")
```


```{r}
#  Question 7
####

# Flights that are early departures in minutes 20 - 30. 

# Early departures of flights in minutes 20-30 
flights_min_20_30_early <- flights_dt %>% mutate(min = minute(sched_dep_time), delayed = dep_delay > 0, early = dep_delay < 0) %>% select(early, delayed, dep_delay, dep_time, min, everything()) %>% filter(min >= 20, min <= 30, early == TRUE) %>% arrange(min) %>% group_by(min, dep_delay) %>% summarise(count = n()) %>% summarise(count)

(flights_min_20_30_early)
ggplot(flights_min_20_30_early) +
  geom_smooth(aes(min, count), se = FALSE) + 
  labs(title = "Distribution of Early departures during minutes 20 - 30.")
```


```{r}
#  Question 7
# Late departures of flights in minutes 20-30
flights_min_20_30_late <- flights_dt %>% mutate(min = minute(sched_dep_time), delayed = dep_delay > 0, early = dep_delay < 0) %>% select(early, delayed, dep_delay, dep_time, min, everything()) %>% filter(min >= 20, min <= 30, delayed == TRUE) %>% group_by(min, dep_delay) %>% summarise(count = n()) %>% summarise(count)

(flights_min_20_30_late)

ggplot(flights_min_20_30_late) +
  geom_smooth(aes(min, count), se = FALSE) + 
  labs(title = "Count of Late delays during minutes 20 - 30")

```

```{r}
(flights_min_20_30_early)
ggplot() +
  geom_smooth(aes(flights_min_20_30_early$min, flights_min_20_30_early$count), color = "lightblue", se = FALSE) + 
  geom_smooth(aes(flights_min_20_30_late$min, flights_min_20_30_late$count), color = "darkgreen", se = FALSE) + 
  labs(title = "Distribution of Late Delays & Early departures during minutes 20 - 30.", x = "Flight Minute Group", y = "Quantity of Flights") 


```

```{r}

# Early departures of flights in minutes 50-60 
flights_min_50_60_early <- flights_dt %>% mutate(min = minute(sched_dep_time), delayed = dep_delay > 0, early = dep_delay < 0) %>% select(early, delayed, dep_delay, dep_time, min, everything()) %>% filter(min >= 50, min <= 60, early == TRUE) %>% arrange(min) %>% group_by(min, dep_delay) %>% summarise(count = n()) %>% summarise(count)

(flights_min_50_60_early)
ggplot(flights_min_50_60_early) +
  geom_smooth(aes(min, count), se = FALSE) + 
  labs(title = "Distribution of Early departures during minutes 50 - 60.")
```

```{r}
# Late departures of flights in minutes 50-60
flights_min_50_60_late <- flights_dt %>% mutate(min = minute(sched_dep_time), delayed = dep_delay > 0, early = dep_delay < 0) %>% select(early, delayed, dep_delay, dep_time, min, everything()) %>% filter(min >= 50, min <= 60, delayed == TRUE) %>% group_by(min, dep_delay) %>% summarise(count = n()) %>% summarise(count)

(flights_min_50_60_late)

ggplot(flights_min_50_60_late) +
  geom_smooth(aes(min, count), se = FALSE) + 
  labs(title = "Count of Late delays during minutes 50 - 60")
```


```{r}

ggplot() +
  geom_smooth(aes(flights_min_50_60_early$min, flights_min_50_60_early$count), se = FALSE, color = "lightblue") + 
  geom_smooth(aes(flights_min_50_60_late$min, flights_min_50_60_late$count), se = FALSE, color = "darkgreen") +
  labs(title = "Distribution of Late Delays & Early departures during minutes 50 - 60.", x = "Flight Minutes by Grouping of Minute", y = "Number of Flights During the Minute Group")
```
```{r}
# From the graphs above, it is clear that the distributions of scheduled flights departing early between the minutes of 20 - 30 and 50 - 60 are not correlated with the distributions of late departures of scheduled flights within the same groups of minutes. Because scheduled flights can only either arrive late, early, or on-time (and given that on-time is defined as not late) then it is safe to infer that the assumption that there is no causal relationship between early departures of flights and scheduled flights leaving early is not true. Given the two possibilities of late or early scheduled flights, one must infer that early departures of flights are due to scheduled flights leaving early as opposed to the opposite conclusion. 
```



## Section 16.4: Time spans

#### Section 16.4.3: Intervals
```{r}
years(1) / days(1)
```


```{r}
# Today plus a year later divided by the duration of days in seconds
(today() %--% (today() + years(1))) # This is the interval of a year from today. 

next_year <- today() + years(1)
(today() %--% next_year) / ddays(1) # This will divide the number of days in a year by the duration of one day.

(today() %--% next_year) / days(1) # This will divide the number of days in an interval by the period of one day. 

# How many periods fall into an interval?
(today() %--% next_year) %/% days(1)

```
#### 16.4.5 Exercises
```{r}
# Quesion 1
# There are months but no dmonths because the duration of months in seconds is inconsistent. 
```

```{r}
# Quesion 2 

flights_dt %>% 
  mutate(
    overnight = arr_time < dep_time,
         ) %>%
  select(sched_arr_time, arr_time, dep_time, overnight)
```


```{r}
# Quesion 2
# Overnight flight arrivals and departures before adding the period of days.
overnight_flights_dt_b4 <-flights_dt %>% mutate(overnight = arr_time < dep_time) %>% select(flight, overnight, arr_time, dep_time, everything()) %>% filter(overnight == TRUE)

overnight_flights_dt_b4$overnight[1]
class(overnight_flights_dt_b4$overnight[1])
days(TRUE)
days(FALSE)
days(TRUE *1)

# Overnight flight arrivals and departures after adding the period of days. 
overnight_flights_dt_after <- flights_dt %>% 
  mutate(
    overnight = arr_time < dep_time,
    arr_time = arr_time + days(overnight),
    sched_arr_time = sched_arr_time + days(overnight)
         ) %>%
  select(flight, overnight, arr_time, dep_time, everything()) %>% filter(overnight == TRUE)

# days(overnight * 1) Uses the logical value of overnight to create a period of one day. This day is added to the arrival times such that the datetime-formatted arrival time's "day" is consistent with the departure time where the departure time is before or less than the arrival time.  
```

```{r}
# Quesion 3
days()
init_year <- ymd(20150101)
class(init_year)
```


```{r}
# Question 3.1
years(1)
class(init_year %--% (init_year + years(1)))
init_year + months(0:11)


```
```{r}
# Question 3.2
year(today())
init_current_year <- make_datetime(year(today()), month(1), day(1))
init_current_year <- ymd(init_current_year)
(init_current_year + months(0:11))

```


```{r}
# Quesion 4
age <- function(b_day){
  return (year(today()) - year(b_day))
}
bday <- make_date(year = 1990, month = 5, day = 29)
age(bday)
```

```{r}
# Quesion 5
# months(1) returns a factor: January

years(1) # period
year(1) # one year



months(1) # period
class(months(1))
class(month(1)) # Value of one month 

# (today() %--% (today() + years(1))) / months(1) returns the number of months during this period; this can work.
# (today() %--% (today() + years(1))) %/% months(1) returns the number of groups of months during this period; 
# (today() %--% (today() + years(1))) %/% month(1) You cannot perform modular arithmetic of an interval by an integer. 

# The numerator and denominator of integer division (%/%) must be of the same type to return the integer quotient. 
# If the numerator is an interval and the denominator is an interval (if the numerator and denominator are the same type) in modular arithmetic, then the numeric integer quotient can be returned from modular arithmetic.

# In arithmetic division, an interval arithmetically divided by an integer will return the interval divided by integer and will result in the first interval from the start of the interval to the length of the interval divided by the integer denominator. For example, an interval of one year arithmetically divided by an integer of 2 will return an interval of six months (a year divided by 2) starting from the start of the interval and ending 6 months later. 

# arithmetic division of an interval divided by a period will return the numeric value of the interval divided by the period. If the period of one year is divided by a period of 1 months, then 12 (the number of months in the interval) will be returned.


# Modular division and arithmetic division of intervals by periods will always return the number of periods within the interval.
# An interval divided by a period will indicate the number of periods within the interval. 

# The interval arithmetically divided by an integer will return a period.
# The interval modularly divided by an integer will not return an integer quotient because there is no integer in the numerator. 

# An interval and a period are the same type. Hence, modular and arithmetic division will both return the number of times a period fits into an interval.

# An interval and an integer are different types. Arithmetic division of an interval will return an interval with a new length. Modular aritmetic of an interval and an integer will not return a value because there is no integer in the numerator with which to divide and return an integer quotient.

# What will alwyas work is arithmetic division of an interval by an integer or dividing by the same type. 

(today() %--% (today() + years(1))) %/% months(1)

(today() %--% (today() + years(1))) / month(1)

(today() %--% (today() + years(2)))

```

## Section 16.5 Time zones
```{r}
# c() will drop the timezone and use the default in R. 
# with_tz will keep the instant of time the same but will alter the timezone
# force_tz will change the instant of time but keep the timezone the same. Fixing an underlying time with an incorrect timezone.
# Coordinated Universal Time (UTC) is the scientific standard and is roughly equivalent to Greenwhich Mean Time (GMT)

# A list of all timezones
head(OlsonNames())
```

# Section 17: Program: Introduction
```{r}
# Advanced R: http://adv-r.had.co.nz/
```

# Section 18: Pipes
```{r}
# T pipe: T pipe will return the left hand side of the pipe rather than the right hand side of the pipe.
```

```{r}
# Pipe
 rnorm(100) %>% matrix(ncol = 2) %>% plot() %>% str()
```

```{r}
# T Pipe
rnorm(100) %>% matrix(ncol = 2) %T>% plot() %>% str()
```


```{r}
if(!require("magrittr")) install.packages("magrittr")
library(magrittr)
```

```{r}
# %$% will expand variables in a dataframe so that you can refer to them explicitly. 
mtcars %$% cor(disp, mpg)
```

```{r}
# Assignment
# original
mtcars <- mtcars %>% transform(cyl = cyl * 2)

# magrittr assignment syntax
mtcars %<>% transform(cyl = cyl * 2)

```


## Section 19: Functions
```{r}

```

#### Section 19.2: Writing Functions
```{r}
df <- tibble::tibble(
  a = rnorm(10),
  b = rnorm(10),
  c = rnorm(10),
  d = rnorm(10)
)
```

```{r}
df$a <- (df$a - min(df$a, na.rm = TRUE)) /
  (max(df$a, na.rm = TRUE) - min(df$a, na.rm = TRUE))
df$b <- (df$b - min(df$b, na.rm = TRUE)) /
  (max(df$b, na.rm = TRUE) - min(df$b, na.rm = TRUE))
df$c <- (df$c - min(df$c, na.rm = TRUE)) /
  (max(df$c, na.rm = TRUE) - min(df$c, na.rm = TRUE))
df$d <- (df$d - min(df$d, na.rm = TRUE)) /
  (max(df$d, na.rm = TRUE) - min(df$d, na.rm = TRUE))
```

```{r}
x <- df$a
(x - min(x, na.rm = TRUE)) / (max(x, na.rm = TRUE) - min(x, na.rm = TRUE))

rng <- range(x , na.rm = TRUE)
(x - rng[1]) / (rng[2] - rng[1])

```


```{r}
rescale01 <- function(x) {
  rng <- range(x, na.rm = TRUE)
  (x - rng[1]) / (rng[2] - rng[1])
}

rescale01(c(0, 5, 10))

```


```{r}
rescale01
```

```{r}
df$a <- rescale01(df$a)
df$b <- rescale01(df$b)
df$c <- rescale01(df$c)
df$d <- rescale01(df$d)
```

```{r}
```




#### Section 19.2.1: Exercises
```{r}
# Quesion 1
# TRUE is not a parameter to rescale01() because it is a constant setting that does not change.
# If x contained a single missing value and na.rm was false, then the missing value would percolate throughout the function. 
```

```{r}
# Quesion 2
x <- c(1:10, Inf)

rescale01 <- function(x) {
  rng <- range(x, na.rm = TRUE, finite = TRUE)
  return_val <- (x - rng[1]) / (rng[2] - rng[1])
  for (value in seq_along(return_val)){
    if(return_val[value] == Inf){
      return_val[value] <- 1
    }
    if(return_val[value] == -Inf){
      return_val[value] <- 0
      # print(return_val[value])
    }
  }
  return(return_val)
}
(rescale01(x))
```

```{r}
# Quesion 3
avg_na <- function(x) {
  return(mean(is.na(x)))  
}
```


```{r}
# Quesion 3
proportion_x <- function(x) {
  x / sum(x, na.rm = TRUE)  
}
```


```{r}
# Quesion 3
sd_divided_by_mean_x <- function(x) {
  sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE)  
}
```

```{r}
# Quesion 4
var_x <- function(x) {
  n <- length(x)
  x_mean <- mean(x)
  intermediate_sum <- 0
  for (x_i in seq_along(x)){
    intermediate_sum <- intermediate_sum + (x[x_i] - mean(x))^2
  }
  return_val <- intermediate_sum * (1/(n-1))
  return(return_val)
}

skew_x <- function(x){
  n <- length(x)
  x_mean <- mean(x)
  intermediate_sum <- 0
  for (x_i in seq_along(x)) {
    intermediate_sum <- intermediate_sum + (x[x_i] - mean(x))^3
  }
  numerator <- intermediate_sum * (1/(n-2))
  denominator <- var_x(x)^(3/2)
  skew_val <- numerator / denominator
  return(skew_val)
}

x <- c(1,2,3,4)
var_x(x)
```


```{r}
# Quesion 5
both_na <- function(x, y) {
  num_positions = 0
  for (index in seq_along(x)){
    if(is.na(x[index]) & is.na(y[index])){
      num_positions <- num_positions + 1
    }
  }
  return(num_positions)
}
```

```{r}
# Quesion 6
# This function will indicate if a given path is a directory.
is_directory <- function(x) file.info(x)$isdir

getwd()
is_directory("/Users/evanwoods/Github/lpa/r-for-data-science")

# This function verifies if access if available to the file at that file path.
is_readable <- function(x) file.access(x, 4) == 0
path <- "/Users/evanwoods/Github/lpa/r-for-data-science"
is_readable(path)

```

```{r eval = FALSE}
# Quesion 7
# Little Bunny Foo Foo,
# Hopping through the forest,
# Scooping up the field mice,
# And bopping them on the head.

# Down came the Good Fairy, and she said,

# "Little Bunny Foo Foo,
# I don't want to see you,
# Scooping up the field mice
# And bopping them on the head."

# "I'll give you three chances,
# And if you don't behave,
# I'm gonna turn you into a goon!"

# The next day...

# Little Bunny Foo Foo,
# Hopping through the forest,
# Scooping up the field mice,
# And bopping them on the head.

# Down came the Good Fairy, and she said,

# "Little Bunny Foo Foo,
# I don't want to see you,
# Scooping up the field mice
# And bopping them on the head."

# "I'll give you three chances,
# And if you don't behave,
# I'm gonna turn you into a goon!"

# That evening...

# Little Bunny Foo Foo,
# Hopping through the forest,
# Scooping up the field mice,
# And bopping them on the head.

# Down came the Good Fairy, and she said,

# "Little Bunny Foo Foo,
# I don't want to see you,
# Scooping up the field mice
# And bopping them on the head."

# "I'll give you three chances,
# And if you don't behave,
# I'm gonna turn you into a goon!"

# Later that night...

# Little Bunny Foo Foo,
# Hopping through the forest,
# Scooping up the field mice,
# And bopping them on the head.

# Down came the Good Fairy, and she said,

# "Little Bunny Foo Foo,
# I don't want to see you,
# Scooping up the field mice
# And bopping them on the head."

# "I'll give you three chances,
# And if you don't behave,
# I'm gonna turn you into a goon!"

# A few moments later...

# "I gave you three chances,
# And you didn't behave,
# And now I'm gonna turn you into a goon. POOF!"

# foo_foo <- little_bunny()
# fairy <- good_fairy()
# 
# foo_foo %>%
#   hop(through = forest) %>%
#   scoop(up = field_mice) %>%
#   bop(on = head)
# 
# fairy %>%
#   came(direction = down) %>%
#   said(to = foo_foo) %>%
#   dontWant(to_see = foo_foo) %>%
#   scoop(up = field_mice) %>%
#   bop(on = head) %>%
#   give(chances = three) %>%
#   dontBehave(you = foo_foo) %>%
#   turn(you = goon) %>%
#   time(when = next_day)
# 
# verses <- c(1:3)
# current_time <- c("that_evening", "later_that_night", "a_few_moments_later")
# 
# for (verse in verses) {
#   foo_foo %>%
#     hop(through = forest) %>%
#     scoop(up = field_mice) %>%
#     bop(on = head)
# 
#   fairy %>%
#     came(direction = down) %>%
#     said(to = foo_foo) %>%
#     dontWant(to_see = foo_foo) %>%
#     scoop(up = field_mice) %>%
#     bop(on = head) %>%
#     give(chances = (three - verse)) %>%
#     dontBehave(you = foo_foo) %>%
#     turn(you = goon) %>%
#     time(when = current_time[verse])
# }
# 
# fairy %>%
#   gave(chances = three) %>%
#   didntBehave(you = foo_foo) %>%
#   turn(you = goon) %>%
#   poof()
```


```{r eval = FALSE}
# animal_sounds <- function(animal) {
#   switch(animal, 
#          cat = "Meow", 
#          cow = "Moo",
#          dog = "Bark",
#          "No Sound Found"
#          )
# }
# animal_sounds(animal)

```


## Seciton 19.3 Functions are for humans and computers
```{r}

```


#### Section 19.3.1: Exercises
```{r}
# Question 1
verify_prefix <- function(string, prefix) {
  substr(string, 1, nchar(prefix)) == prefix
}

return_values_to_penultimate <- function(x) {
  if(length(x) <= 1) return(NULL)
  x[-length(x)]
}

replicate_y_x_times <- function(x, y) {
  rep(y, length.out = length(x))
}

```


```{r}
# Quesion 2
count_shared_na_position <- function(vector_one, vector_two) {
  num_positions = 0
  for (index in seq_along(vector_one)){
    if(is.na(vector_one[index]) & is.na(vector_two[index])){
      num_positions <- num_positions + 1
    }
  }
  return(num_positions)
}

```


```{r}
# Quesion 3
# rnorm 
# Arguments: 
# n = number of observations
# mean = vector of mean averages
# sd = vector of standard deviations

# MASS::mvrnorm()
# n = number of samples required
# mu = vector of the means of the variables
# Sigma = covariance matrix of the variables
# tol = tolerance relative to largest variance for lack of positive-definiteness in Sigma
# empirical = When true, mu & Sigma specify the empirical mean and covariance matrix rather than the population mean and covariance matrix
# EISPACK = Logical values other than FALSE are an error.

# rnorm and MASS::mvrnorm can be more consistent by changing "sd" to "Sigma" in rnorm & "mean" to "mu" in rnorm
```

```{r}
# Quesion 4
# norm_r and norm_d would be better than rnorm() and dnorm() because they have the same prefix which makes the two simpler to look up.
# rnorm() and dnorm() would be better than norm_r() and norm_d() because the type of normal distribution is identified from the beginning of function name meaning that one may circumvent human error when autocompleting to the wrong norm_ function.
```

#### Section 19.4: Conditional Execution

#### Section 19.4.1: Conditions
```{r}
# if conditions: vectors create warning messages
# NA creates errors

# || is a logical or
# && is a logical and

# | is vectorized operation (do not use in `if` condition); applies to multiple values; their use is in filter
# & is a vectorized operation (do not use in `if` condition); applies to multiple values; their use is in filter

# any() or all() can be mapped to a single vector. 

# use `identical` for a single output
# == is a vectorised operation meaning that it will return more than one output
# use dplyr::near() for comparisons to overcome errors in precision when comparing numnerical values

```

#### Section 19.4.2 Multiple conditions
```{r}
# if() {}
# else if() {}
# else {}

```

```{r}
# switch case
# function(x, y, op) {
# switch(op, # variable to switch on 
# plus = x + y, # case 1
# minus = x - y, # case 2
# times = x * y, # case 3
# divide = x / y, # case 4
# stop("Unknown op!") # default case
# )
# }
```

```{r}
# cut is used to break a numeric variable into factors
```

#### Section 19.4.3: Code style
```{r}

```

#### Section 19.4.4: Exercises
```{r}
# Question 1
# The difference between if and ifelse(); if else accepts NA; if will not accept NA values. if else accepts a to verify the truthiness of, the value when the verified value is true, and the value when the verified value is false. 
```

```{r}
# Quesion 2
greet <- function(){
  instant <- lubridate::now()
  today = today()
  
  midnight <- as_datetime(str_c(today, "00:00:00"), tz = "EST")
  noon <- as_datetime(str_c(today, "12:00:00"), tz = "EST")
  evening <- as_datetime(str_c(today, "06:00:00"), tz = "EST")
  
  if(instant >= midnight && instant < noon){
    print("good morning")
  } else if(instant >= noon && instant < evening) {
    print("good afternoon")
  } else if(instant >= evening && instant < midnight) {
    print("good evening")
  }
}
greet()
```

```{r}
# Quesion 3
fizzbuzz <- function(n) {
  if(identical((n %% 3), 0) && identical((n %% 5), 0)) {
    return("fizzbuzz")
  } else if(identical((n %% 3), 0)) {
    return("fizz")
  } else if(identical((n %% 5), 0)) {
    return("buzz")
  } else {
    return(n)
  }
}

fizzbuzz(5)
fizzbuzz(3)
fizzbuzz(15)
fizzbuzz(13)
```

```{r}
# Quesion 4
temp <- 100
if (temp <= 0) {
  "freezing"
} else if (temp <= 10) {
  "cold"
} else if (temp <= 20) {
  "cool"
} else if(temp <= 30) {
  "warm"
} else {
  "hot"
}


# Cut can be used to identify factor levels. 
# 1. Create the levels with a vector: x <- c(0, 30)
# 2. Cut the levels using cut: cut(x, breaks = 3)
# This will create three levels: a level between 0 and 10, a level between 10 and 20, and a level between 20 and 30.

# If cut were to use < instead of <=, right would be set to FALSE in the call to cut(); This will create a closed bracket on the left and use a parenthesis on the right.

# Cut is useful for this problem because it allows for the expedient and programmatic creation of levels using only a range and a constant. Rather than manually hardcoding & specifying the ranges, the ranges of levels can be dynamically defined which is efficient as the number of ranges required reaches toward the limit of infinity.

```

```{r}
# Quesion 5
n <- 3
switch(n,
       "cat" = 1, 
       "dog" = "dog",
       "none")

# Using numeric values on a switch case will allow the case to be selected where 1 is the first case and every case descending afterwards corresponds to the next integer in a sequence following 1.
```

```{r}
# Quesion 6
# This expression will match on "a" or "b" and return "ab" in both cases; This Expression will also match on "c" or "d" and will return "cd" in both cases. "e" does not match in this switch case expression. 

x <- "e"

switch(x, 
  a = ,
  f = "ab",
  c = ,
  d = "cd"
)
```


## Section 19.5: Function Arguments
#### Section 19.5.3: Ellipses
```{r}
# Ellipses are a catch all; It is a special argument that captures any number of arguments that aren't otherwise matched.
# Useful for wrapping str_c() in a helper function
```

```{r}
commas <- function(...) stringr::str_c(..., collapse = ", ")
commas(letters[1:10])
```

```{r}
rule <- function(..., pad = "-"){
  title <- paste0(...)
  width <- (getOption("width") - nchar(title) - 5)
  cat(title, " ", stringr::str_dup(pad, width), "\n", sep = "")
}
rule("Important output")
```

```{r}
# Printing the values of ... by using list(...)
list_ellipses <- function(...){
  # stringr::str_c(..., collapse = ", ")
  list(...)
} 
list_ellipses(letters[1:10])
```


#### Section 19.5.4: Lazy Evaluation
```{r}

```

#### Section 19.5.5: Exercises
```{r}
# Question 1
# commas(letters, collapse = "-")
# This function call will throw an error. The error states 'formal argument "collapse" matched by multiple actual arguments'.
# This is because the code piece 'collapse = "-"' is being passed into the function as below after being captured from the ellipses:
# stringr::str_c(collapse = "-", collapse = ", ")
# Calling the function above will throw the same error.
```
```{r}
# Quesion 2
# This currently doesn't work because the output line is duplicating pad 'width' number of times and presuming pad is a single character. By including nchar(pad), the number of characters used in padding can be known, and a division of the width by the number of characters in the pad can be used to set the appropriate width respective of the number of characters used in the pad. 

rule <- function(..., pad = "-"){
  title <- paste0(...)
  pad_char <- nchar(pad)
  width <- (getOption("width") - nchar(title) - 5) / pad_char
  cat(title, " ", stringr::str_dup(pad, width), "\n", sep = "")
}
rule("Important output")
```

```{r}
# Quesion 3
# The trim argument of mean takes a fraction of the observations to be trimmed from x before the mean is computed. The values outside the range are taken to the nearest endpoint. 
```

```{r}
# Quesion 4
# The default value for the `method` argument to cor() is c("pearson", "kendall", "spearman"). These are three different individuals each of which are associated with a correlation coefficient. The Pearson correlation coefficient is a rank correlation coefficient that measures linear correlation between two sets of data. The Kendall correlation coefficient is a rank coefficient used to measure ordinal association between two quantities. Spearman's rank correlation coefficient results when two variables are monotomically related even if their relationship is non-linear. Pearson is the default method.
```


#### Section 19.6: Return Values
```{r}
# use early returns to return simple conditionals before complex conditionals
```


#### Section 19.6.2: Writing pipeable functions
```{r}
# Two types of pipeable functions:
# Transformations: when a function modifies the object that is returned. 
# Side-effects: When a function performs an action using the object but does not modify the object. Plots or saving the object to disk are examples. The object is returned silently.
# Call `invisible` on the input object to prevent the object from being printed out.

```

```{r}
show_missings <- function(df) {
  n <- sum(is.na(df))
  cat("Missing values: ", n, "\n", sep = "")
  invisible(df)
}

class(show_missings(mtcars))
dim(show_missings(mtcars))
```
## Section 19.7: Environment
```{r}
# Lexical scoping: when a variable is not declared in a function but is found elsewhere in the environment. This is similar to global variables in other languages. 
```

# Section 20: Vectors
```{r}
# Atomic vectors contain: logical, character and numeric; numeric subtypes are integer and double vectors; 
# List vectors are not atomic. Lists are heterogeneous while atomic vectors are homogeneous.
# NULL represents the absence of a vector.
```

```{r}
# Vector properties:
# Type: typeof() indicates the type of vector.
# Length: length() indicates the length of the vector.

```

#### Section 20.3.1: Logical
```{r}
# Possible Values: FALSE, TRUE, NA

```


#### Section 20.3.2: Numeric
```{r}
# numbers are doubles by default. Using an "L" will allow the number to be an integer. 
typeof(1)
typeof(1L)
```

```{r}
# Double Special values: NA, NaN, Inf, -Inf
# Integer Special values: NA
```


#### Section 20.3.3: Character
```{r}
if(!require("pryr")) install.packages("pryr")
library(pryr)
```


```{r}
# y uses pointers to the same object, x. Each pointer is 8 bytes. 
pryr::object_size(x)

y <- rep(x, 1000)
pryr::object_size(y)
```


#### Section 20.3.4: Missing Values
```{r}
# Each type of atomic vector contains its own missing value:
NA # logical
NA_integer_ # integer
NA_real_ # double
NA_character_ # character
```


#### Section 20.3.5: Exercises
```{r}
# Question 1
# The difference between is.finite(x) and !is.infinite(x) is that is.finite(NA) and is.finite(NaN) will present FALSE; is.infinite(NA) and is.infinite(NaN) will also present false; Therefore !is.infinite(NA) & !is.infinite(NaN) will both produce TRUE even though they are not finite. 
```

```{r}
# Quesion 2
# dplyr::near
# dplyr::near() will take the absolute value of the difference between two values and compare the values as if to be less than a tolerance. 
```

```{r}
# Quesion 3
# According to https://stat.ethz.ch/R-manual/R-devel/library/base/html/integer.html, 
# R uses 32-bit integer vectors. This means that R can take integers within the range of +- 2 x 10^9.
# R uses IEEE 754 standard with a precision of 53 bits for doubles. 
# This means the range of doubles is the absolute value of 2 x 10^+-308. Doubles also except NaN, NA, +- Infinity, +-0 (which are treated as the same). The range of values accepted by a double vector include the absolute value of 2 x 10^+-308 plus five more values: NaN, NA, Inf, -Inf, and 0.
```

```{r}
# Quesion 4
# as.integer() may be applied to a function to convert a double to an integer. This function will accept a double and return the return value from `as.integer`.
# as.numeric() may be applied to a function to convert a double to an integer. This function will accept a double and return the return value from `as.numeric`.
# floor() may be applied to a function to convert a double to an integer. This function will accept a double as an argument into floor before performing modular arithmetic on the result. This result will then be used as an input value into either as.integer or as.numeric to return an integer type. 
# ceil() may be applied to a function to convert a double to an integer. This function will accept a double as an argument into ceil before performing modular arithmetic on the result. This result will then be used as an input value into either as.integer or as.numeric to return an ingeter type. 
```

```{r}
# Quesion 5
# The `readr` package includes the parse_double, parse_integer, & parse_logical functions which enable the conversion of character strings to doubles, integers, and logicals.
```


## Section 20.4: Using Atomic Vectors
```{r}

```

#### Section 20.4.4: Naming Vectors
```{r}
c(x = 1, y = 2, z = 4)
set_names(1:3, c("a", "b", "c"))
```
#### Section 20.4.5: Subsetting
```{r}
# Subsetting a named vector with a character vector:
x <- c(abc = 1, def = 2, xyz = 5)
x[c("abc", "def")]

```

```{r}
# Return all of x: x[]
# x[1,] selects the first row and all columns of a matrix.
# x[,1] selects all rows and the first column of a matrix.
# x[, -1] selecta all rows and all columns except the first column of a matrix.
```

```{r}
# "[[" only ever extracts a single element and will always drop names. 
```


#### Section 20.4.6 Exercises
```{r}
# Question 1
# mean(is.na(x)) Will tell you if there are NA values in vector x. It will then attempt to calculate the mean of the result. If there is an NA value, then is.na will be 1 which indicates the mean of that value is 1 which indicates that there is an NA value in the integer vector x. If there is no missing value in x, then is.na will return 0. The mean of zero will be 0 which will indicate that there is no missing value in x.
```

```{r}
# Quesion 2
# is.vector() returns TRUE if x is a vector of the specified mode having no attributes other than names. It tests to see if x is a vector with no other attributes other than names within the vector. 
```

```{r}
# Quesion 3
# Atomic types are not atomic vectors in the sense that individual objects are accepted as 'atomic' without being vectors. NULL is not an atomic vector, but it is atomic, for example. 
```

```{r}
# Question 4.1
# Either "[[" or "[" will work to return the last value. "[[" is explicitly defining a singular return value.
return_last_vector_value <- function(input_vector) {
  return (input_vector[[length(input_vector)]])
}
```

```{r}
# Question 4.2
return_even_numbered_positioned_elements <- function(input_vector) {
  return(input_vector[seq(2, (length(input_vector) - length(input_vector) %% 2), by = 2)])
}
```

```{r}
# Question 4.3
return_elements_first_to_penultimate <- function(input_vector) {
  return(input_vector[-length(input_vector)])
}
```

```{r 4.4}
return_only_even_values <- function(input_vector) {
  return(input_vector[!(x %% 2) & !is.na(x)])
}
```

```{r}
# Quesion 5
# -which(x>0) returns the negative of all values of x that are greater than zero. x<=0 returns a logical. These two have different return types which is why they are not the same. 
```

```{r}
# Quesion 6
# Subsetting with a value that is out of the length of a vector or a name that doesn't exist will return NA when using "[" notation. When using "[[" notation, the error 'subscript out of bounds' will be thrown.
```

## Section 20.5: Recursive vectors (lists)

#### Section 20.5.2: Subsetting
```{r}
# Three ways to subset a list:
a <- list(a = 1:3, b = "a string", c = pi, d = list(-1, -5))
```


```{r}
# extract a sub-list; the results will always be a list.
str(a[1:2])

str(a[4])
```


```{r}
# Extracts a single component from a list. Removes a level of hierarchy.
str(a[[1]])

```

```{r}
# $ is shorthand for extracting named elements of a list. $ functions the same as [[]].
str(a$b)
str(a[["b"]])
```

```{r}
# "[" returns a new smaller list. ("View the list")
# "[[" drills down into the list. ("Access the element in the list")
str(a)

```

```{r}
str(a[1:2])
```
```{r}
str(a[4])
```

```{r}
str(a[[4]])
```

```{r}
str(a[[4]][1])
```
```{r}
str(a[[2]])
```

```{r}
str(a[[4]][[2]])
```

```{r}
str(a[[4]][[2]])
```

#### Section 20.5.4: Exercises
```{r}
# Question 1
# The means of addressing elements of a list are identical to the means of addressing elements of a tibble. A tibble allows one to pipe elements into functions such as filter whereas a list does not allow such functionality. 
```


## Section 20.6: Attributes
```{r}
x <- 1:10
```

```{r}
attr(x, "greeting")
```

```{r}
attr(x, "greeting") <- "Hi!"
```

```{r}
attributes(x)
```

```{r}
# Three important attributes that are used to implement fundamental parts of R:
# Names: used to name the elements of a vector
# Dimensions: make a vector behave like a matrix or array
# Classes: used to implement the S3 object oriented system. 
```

```{r}
# "UseMethod" indicates that a function is generic: it will perform differently depending on the input.
# '[', '[[', & '$' are all generic functions
# List all the functions for a generic with 'methods()'
```

## Section 20.7: Augmented Vectors
```{r}
# Augmented vectors have attributes
# Four augmented vectors:
# Factors
# Dates
# Date-Times
# Tibbles
```

```{r}
# POSIXct stands for 'Portable Operating System Interface', calendar time. 
# Convert POSIXlt (built on top of named lists) to POSIXct with lubridate::as_date_time()
```


#### Section 20.7.4: Exercises
```{r}
# Question 1
attributes(hms::hms(3600))
# This returns 01:00:00. This is 1 hour. It is built on top of a difftime class. It has attributes of units and class.
```
```{r}
# Quesion 2
# tb <- tibble(c(1,2,3), c(1,2,3,4))
# The error "Tibble columns must have compatible sizes" appears when attempting to build a tibble containing columns of differing lengths.
```
```{r eval = FALSE}
# Quesion 3
tb <- tibble(list(1,2,3), list(1,2,3,4))
# Lists are acceptable within a tibble so long as the lists are of the same length. 
```
# Section 21: Iteration
```{r}

```

#### Section 21.2.1: Exercises
```{r}
#  1.1
# Compute the mean of every column in mtcars
for (col in seq_along(mtcars)) {
  print(mean(mtcars[[col]]))
}
```


```{r}
#  1.2
# Determine the type of each column in nycflights13::flights
for(col in seq_along(nycflights13::flights)){
  print(typeof(nycflights13::flights[[col]]))
}
```
```{r}
# Question 1.3
# Compute the number of unique values in each column of iris
for (col in seq_along(iris)){
  print(length(unique(iris[[col]])))
}

```

```{r}
# Question 1.4
# Generate 10 random normals from distributions with means of -10, 0, 10, 100
n = 10
means_vector <- c(-10, 0, 10, 100)
for(i in seq(1,10)){
  dist <- rnorm(n, means_vector[[((i %% length(means_vector)) + 1)]])
  print(dist)
  print(mean(dist))
}
```

```{r}
# Quesion 2
# out <- ""
# for(x in letters) {
#   out <- stringr::str_c(out, x)
# }

out <- str_c(letters, collapse = "")
```

```{r}
# Quesion 2.1
x <- sample(100)
# sd <- 0
# for (i in seq_along(x)) {
#   sd <- sd + (x[i] - mean(x)) ^2
# }
# sd <- sqrt(sd / (length(x) - 1))
# (sd)
sd(x)

```

```{r}
#  2.2
# x <- runif(100)
# out <- vector("numeric", length(x))
# out[1] <- x[1]
# for (i in 2:length(x)) {
#   out[i] <- out[i - 1] + x[i]
# }
# (out)
# cat("\n")

cumsum(x)
```


```{r}
# Question 3.1
# Alice the camel has five humps
# Alice the camel has five humps
# Alice the camel has five humps
# So go Alice go, boom, boom, boom!
# Alice the camel has four humps
# Alice the camel has four humps
# Alice the camel has four humps
# So go Alice go, boom, boom, boom!
# Alice the camel has three humps
# Alice the camel has three humps
# Alice the camel has three humps
# So go Alice go, boom, boom, boom!
# Alice the camel has two humps
# Alice the camel has two humps
# Alice the camel has two humps
# So go Alice go, boom, boom, boom!
# Alice the camel has one hump
# Alice the camel has one hump
# Alice the camel has one hump
# So go Alice go, boom, boom, boom!
# Alice the camel has no humps
# Alice the camel has no humps
# Alice the camel has no humps
# Because Alice is a horse of course!
```


```{r}
# Question 3.1
# Alice the camel variables

# n_repetitions_counting_lyric <- 3
# pre_counting_lyric_string_concatonation_plural <- "Alice the camel has "
# numeric_counts_vector <- c("five", "four", "three", "two", "one", "no")
# post_counting_lyric_string_concatonation_plural <- " humps\n"
# 
# counting_lyric_singular_conditional_string <- "one"
# pre_counting_lyric_string_concatonation_singular <- "Alice the camel has "
# post_counting_lyric_string_concatonation_singular <- " hump\n"
# 
# print_static_string <- "So go Alice go, boom, boom, boom!\n"
# 
# final_count_condition_string <- "no"
# final_result_static_string <- "Because Alice is a horse of course!\n"

print_child_song <- function(
    n_repetitions_counting_lyric = 3,
    
    pre_counting_lyric_string_concatonation_plural = "Alice the camel has ",
    numeric_counts_vector = c("five", "four", "three", "two", "one", "no"),
    post_counting_lyric_string_concatonation_plural = " humps\n",
    
    unique_additional_verse = FALSE,
    unique_additional_verse_pre_counting_lyric_string_concatonation_plural = "Alice the camel has ",
    unique_additional_verse_post_counting_lyric_string_concatonation_plural = " humps\n",
    
    counting_lyric_singular_conditional_string = "one",
    pre_counting_lyric_string_concatonation_singular = "Alice the camel has ",
    post_counting_lyric_string_concatonation_singular = " hump\n",
    
    print_static_string = "So go Alice go, boom, boom, boom!\n",
    
    final_count_condition_string = "no",
    final_result_static_string = "Because Alice is a horse of course!\n"
    
    ){
    for (i in seq_along(numeric_counts_vector)){
      if(!(unique_additional_verse)){
        
      }
      if (!(identical(numeric_counts_vector[[i]], counting_lyric_singular_conditional_string))){
        print_count_lyric <- str_c(pre_counting_lyric_string_concatonation_plural, numeric_counts_vector[[i]], post_counting_lyric_string_concatonation_plural)
      } else {
        print_count_lyric <- str_c(pre_counting_lyric_string_concatonation_singular, numeric_counts_vector[[i]], post_counting_lyric_string_concatonation_singular)
      }
    
      if (identical(numeric_counts_vector[[i]], final_count_condition_string)){
        print_static_string <- final_result_static_string
      } 

      for (j in seq(1,n_repetitions_counting_lyric)){
        cat(print_count_lyric)
      }
      cat(print_static_string)
    }
}
```

```{r}
# Question 3.1
# n_repetitions_counting_lyric <- 3
# pre_counting_lyric_string_concatonation_plural <- "Alice the camel has "
# numeric_counts_vector <- c("five", "four", "three", "two", "one", "no")
# post_counting_lyric_string_concatonation_plural <- " humps\n"
# 
# counting_lyric_singular_conditional_string <- "one"
# pre_counting_lyric_string_concatonation_singular <- "Alice the camel has "
# post_counting_lyric_string_concatonation_singular <- " hump\n"
# 
# print_static_string <- "So go Alice go, boom, boom, boom!\n"
# 
# final_count_condition_string <- "no"
# final_result_static_string <- "Because Alice is a horse of course!\n"

print_child_song()

```

```{r}
# Question 3.2
# There were ten in the bed
# And the little one said, "Roll over, roll over"
# So they all rolled over and one fell out
# There were nine in the bed
# And the little one said, "Roll over, roll over"
# So they all rolled over and one fell out
# There were eight in the bed
# And the little one said, "Roll over, roll over"
# So they all rolled over and one fell out
# There were seven in the bed
# And the little one said, "Roll over, roll over"
# So they all rolled over and one fell out
# There were six in the bed
# And the little one said, "Roll over, roll over"
# So they all rolled over and one fell out
# There were five in the bed
# And the little one said, "Roll over, roll over"
# So they all rolled over and one fell out
# There were four in the bed
# And the little one said, "Roll over, roll over"
# So they all rolled over and one fell out
# There were three in the bed
# And the little one said, "Roll over, roll over"
# So they all rolled over and one fell out
# There were two in the bed
# And the little one said, "Roll over, roll over"
# So they all rolled over and one fell out
# There was one in the bed
# And the little one said, "Goodnight"
# Bravo
```


```{r}
# Question 3.2
n_repetitions_counting_lyric <- 1
pre_counting_lyric_string_concatonation_plural <- "There were "
numeric_counts_vector <- c('ten', 'nine', 'eight', 'seven', 'six', 'five', 'four', 'three', 'two', 'one')
post_counting_lyric_string_concatonation_plural <- " in the bed\n"

counting_lyric_singular_conditional_string <- "one"
pre_counting_lyric_string_concatonation_singular <- "There was "
post_counting_lyric_string_concatonation_singular <- " in the bed\n"

print_static_string <- 'And the little one said, "Roll over, roll over"\nSo they all rolled over and one fell out\n\n'

final_count_condition_string <- "one"
final_result_static_string <- 'And the little one said, "Goodnight"\n\nBravo'

print_child_song(n_repetitions_counting_lyric = n_repetitions_counting_lyric,
                 pre_counting_lyric_string_concatonation_plural = pre_counting_lyric_string_concatonation_plural,
                 numeric_counts_vector = numeric_counts_vector,
                 post_counting_lyric_string_concatonation_plural = post_counting_lyric_string_concatonation_plural,
                 counting_lyric_singular_conditional_string = counting_lyric_singular_conditional_string,
                 pre_counting_lyric_string_concatonation_singular = pre_counting_lyric_string_concatonation_singular,
                 post_counting_lyric_string_concatonation_singular = post_counting_lyric_string_concatonation_singular,
                 print_static_string = print_static_string,
                 final_count_condition_string = final_count_condition_string, 
                 final_result_static_string = final_result_static_string)

print_child_song()

```
```{r}
create_str_vector_from_int <- function(
        least_significant_integer_to_convert = -1,
        most_significant_integer_to_convert = 100,
        reverse_sequence = TRUE,
        zero_synonym = "zero"
    ){
        
        int_to_string_vector_one_to_nine = c('one', 'two', 'three', 'four', 'five','six', 'seven', 'eight', 'nine')
        int_to_string_vector_unique_under_twenty = c('eleven', 'twelve', 'thirteen', 'fourteen', 'fifteen', 'sixteen', 'seventeen', 'eighteen', 'nineteen')
        int_to_string_vector_unique_tens = c('ten','twenty', 'thirty', 'fourty', 'fifty', 'sixty', 'seventy', 'eighty', 'ninety')

        integer_vector_of_numbers_to_convert = seq(least_significant_integer_to_convert, most_significant_integer_to_convert)

        if(reverse_sequence) {
          integer_vector_of_numbers_to_convert <- rev(integer_vector_of_numbers_to_convert)
        }

        return_char_vector <- character()

        for (i in integer_vector_of_numbers_to_convert){
          if (i > 99 || i < 0) {
            next
          }
          if (near(i, 0)){
            return_char_vector <- c(return_char_vector, zero_synonym)
            # cat(zero_synonym)
            # cat('\n')
          } else if (i < 10){
            return_char_vector <- c(return_char_vector, int_to_string_vector_one_to_nine[[i]])
            # cat(int_to_string_vector_one_to_nine[[i]])
            # cat('\n')
          } else if (i > 10 && i < 20) {
            return_char_vector <- c(return_char_vector, int_to_string_vector_unique_under_twenty[[(i %% 10)]])
            # cat(int_to_string_vector_unique_under_twenty[[(i %% 10)]])
            # cat('\n')
          } else if (near((i %% 10), 0)){
            return_char_vector <- c(return_char_vector, int_to_string_vector_unique_tens[[(i %/% 10)]])
            # cat(int_to_string_vector_unique_tens[[(i %/% 10)]])
            # cat('\n')
          } else {
            combined_int_to_str_greater_than_ten <- str_c(int_to_string_vector_unique_tens[[((i %/% 10))]], int_to_string_vector_one_to_nine[[(i %% 10)]], sep = "-")
            return_char_vector <- c(return_char_vector, combined_int_to_str_greater_than_ten)
            # cat(combined_int_to_str_greater_than_ten)
            # cat('\n')
          }
        }
        return(return_char_vector)
}
```

```{r}
vect <- create_str_vector_from_int(        
  least_significant_integer_to_convert = 0,
  most_significant_integer_to_convert = 5,
  reverse_sequence = TRUE,
  zero_synonym = "no"
)
(vect)
```

```{r}
print_child_song(numeric_counts_vector = create_str_vector_from_int(        
  least_significant_integer_to_convert = 0,
  most_significant_integer_to_convert = 5,
  reverse_sequence = TRUE,
  zero_synonym = "no"
))
```
```{r}
n_repetitions_counting_lyric <- 1
pre_counting_lyric_string_concatonation_plural <- "There were "

numeric_counts_vector <- create_str_vector_from_int(        
  least_significant_integer_to_convert = 1,
  most_significant_integer_to_convert = 10,
  reverse_sequence = TRUE,
  zero_synonym = "no"
)

post_counting_lyric_string_concatonation_plural <- " in the bed\n"

counting_lyric_singular_conditional_string <- "one"
pre_counting_lyric_string_concatonation_singular <- "There was "
post_counting_lyric_string_concatonation_singular <- " in the bed\n"

print_static_string <- 'And the little one said, "Roll over, roll over"\nSo they all rolled over and one fell out\n\n'

final_count_condition_string <- "one"
final_result_static_string <- 'And the little one said, "Goodnight"\n\nBravo'

print_child_song(n_repetitions_counting_lyric = n_repetitions_counting_lyric,
                 pre_counting_lyric_string_concatonation_plural = pre_counting_lyric_string_concatonation_plural,
                 numeric_counts_vector = numeric_counts_vector,
                 post_counting_lyric_string_concatonation_plural = post_counting_lyric_string_concatonation_plural,
                 counting_lyric_singular_conditional_string = counting_lyric_singular_conditional_string,
                 pre_counting_lyric_string_concatonation_singular = pre_counting_lyric_string_concatonation_singular,
                 post_counting_lyric_string_concatonation_singular = post_counting_lyric_string_concatonation_singular,
                 print_static_string = print_static_string,
                 final_count_condition_string = final_count_condition_string, 
                 final_result_static_string = final_result_static_string)
```

```{r}
n_repetitions_counting_lyric <- 1
pre_counting_lyric_string_concatonation_plural <- "There were "

numeric_counts_vector <- create_str_vector_from_int(        
  least_significant_integer_to_convert = 0,
  most_significant_integer_to_convert = 99,
  reverse_sequence = TRUE,
  zero_synonym = "no"
)

post_counting_lyric_string_concatonation_plural <- " in the bed\n"

counting_lyric_singular_conditional_string <- "one"
pre_counting_lyric_string_concatonation_singular <- "There was "
post_counting_lyric_string_concatonation_singular <- " in the bed\n"

print_static_string <- 'And the little one said, "Roll over, roll over"\nSo they all rolled over and one fell out\n\n'

final_count_condition_string <- "one"
final_result_static_string <- 'And the little one said, "Goodnight"\n\nBravo'

print_child_song(n_repetitions_counting_lyric = n_repetitions_counting_lyric,
                 pre_counting_lyric_string_concatonation_plural = pre_counting_lyric_string_concatonation_plural,
                 numeric_counts_vector = numeric_counts_vector,
                 post_counting_lyric_string_concatonation_plural = post_counting_lyric_string_concatonation_plural,
                 counting_lyric_singular_conditional_string = counting_lyric_singular_conditional_string,
                 pre_counting_lyric_string_concatonation_singular = pre_counting_lyric_string_concatonation_singular,
                 post_counting_lyric_string_concatonation_singular = post_counting_lyric_string_concatonation_singular,
                 print_static_string = print_static_string,
                 final_count_condition_string = final_count_condition_string, 
                 final_result_static_string = final_result_static_string)
```


```{r}
capitalize_first_letter_in_string <- function(initial_string){
  characters <- str_split_1(initial_string, pattern = "")
  characters[1] <- str_to_upper(characters[1])
  capitalized_string <- str_flatten(characters)
  return(capitalized_string)
}
capitalize_first_letter_in_string("string")
```


```{r}
# Question 3.3

capitalize_first_letter_in_string <- function(initial_string){
  characters <- str_split_1(initial_string, pattern = "")
  characters[1] <- str_to_upper(characters[1])
  capitalized_string <- str_flatten(characters)
  return(capitalized_string)
}

modify_punctuation_in_string <- function(initial_string, replacement_punctuation){
  characters <- str_split_1(initial_string, pattern = "")
  if(identical(characters[length(characters)], "\n")) {
    characters[length(characters) - 1] <- replacement_punctuation  
  } else {
    characters[length(characters)] <- replacement_punctuation
  }
  modified_string <- str_flatten(characters)
  return(modified_string)
}

print_child_song <- function(
 n_repetitions_counting_lyric = 1,
        
    pre_counting_lyric_string_concatonation_plural = "Alice the camel has",
    numeric_counts_vector =  create_str_vector_from_int(
        least_significant_integer_to_convert = 0,
        most_significant_integer_to_convert = 5,
        reverse_sequence = TRUE,
        zero_synonym = "no"
    ),
    post_counting_lyric_string_concatonation_plural = " humps\n",
    
    counting_lyric_singular_conditional_string = "one",
    pre_counting_lyric_string_concatonation_singular = "Alice the camel has ",
    post_counting_lyric_string_concatonation_singular = " hump\n",
    
    print_static_string = "So go Alice go, boom, boom, boom!\n",
    
    final_count_condition_string = "no",
    final_result_static_string = "Because Alice is a horse of course!\n",

    unique_additional_verse = FALSE,
    unique_additional_verse_pre_counting_lyric_string_concatonation_plural = "",
    unique_additional_verse_post_counting_lyric_string_concatonation_plural = "",
    unique_additional_verse_pre_counting_lyric_string_concatonation_singular = "",
    unique_additional_verse_post_counting_lyric_string_concatonation_singular = "",
    
    song = "custom"
    
    ){
    if (str_like(song, "Alice the camel", ignore_case = TRUE)){
        # Parameters for Alice the camel.
        n_repetitions_counting_lyric = 3
        
        pre_counting_lyric_string_concatonation_plural = "Alice the camel has"
        numeric_counts_vector =  create_str_vector_from_int(
            least_significant_integer_to_convert = 0,
            most_significant_integer_to_convert = 5,
            reverse_sequence = TRUE,
            zero_synonym = "no"
        )
        post_counting_lyric_string_concatonation_plural = " humps\n"
        
        counting_lyric_singular_conditional_string = "one"
        pre_counting_lyric_string_concatonation_singular = "Alice the camel has "
        post_counting_lyric_string_concatonation_singular = " hump\n"
        
        print_static_string = "So go Alice go, boom, boom, boom!\n"
        
        final_count_condition_string = "no"
        final_result_static_string = "Because Alice is a horse of course!\n"
    
        unique_additional_verse = FALSE
        unique_additional_verse_pre_counting_lyric_string_concatonation_plural = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_plural = ""
        unique_additional_verse_pre_counting_lyric_string_concatonation_singular = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_singular = ""

    } else if(str_like(song, "Ten in the bed", ignore_case = TRUE)) {
        # Parameters for Ten in the bed.
        n_repetitions_counting_lyric <- 1
        pre_counting_lyric_string_concatonation_plural <- "There were "
        numeric_counts_vector <- create_str_vector_from_int(
                    least_significant_integer_to_convert = 1,
                    most_significant_integer_to_convert = 10,
                    reverse_sequence = TRUE,
                    zero_synonym = "no"
                )
        post_counting_lyric_string_concatonation_plural <- " in the bed\n"

        counting_lyric_singular_conditional_string <- "one"
        pre_counting_lyric_string_concatonation_singular <- "There was "
        post_counting_lyric_string_concatonation_singular <- " in the bed\n"

        print_static_string <- 'And the little one said, "Roll over, roll over"\nSo they all rolled over and one fell out\n\n'

        final_count_condition_string <- "one"
        final_result_static_string <- 'And the little one said, "Goodnight"\n\nBravo'

        unique_additional_verse = FALSE
        unique_additional_verse_pre_counting_lyric_string_concatonation_plural = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_plural = ""
        unique_additional_verse_pre_counting_lyric_string_concatonation_singular = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_singular = ""
      
    } else if(str_like(song, "99 bottles of beer", ignore_case = TRUE)) {
        # Parameters for 99 bottles of beer
        n_repetitions_counting_lyric = 1
    
        pre_counting_lyric_string_concatonation_plural = ""
        numeric_counts_vector =  create_str_vector_from_int(
            least_significant_integer_to_convert = 1,
            most_significant_integer_to_convert = 100,
            reverse_sequence = TRUE,
            zero_synonym = "no"
        )
        post_counting_lyric_string_concatonation_plural = " bottles of beer on the wall,\n"
    
        counting_lyric_singular_conditional_string = "one"
        pre_counting_lyric_string_concatonation_singular = ""
        post_counting_lyric_string_concatonation_singular = " bottle of beer on the wall,\n"
    
        print_static_string = "Take one down,\nPass it around,\n"
    
        final_count_condition_string = "one"
        final_result_static_string = "Take it down,\nPass it around,\nNo more bottles of beer on the wall!\n"

        unique_additional_verse = TRUE
        unique_additional_verse_pre_counting_lyric_string_concatonation_plural = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_plural = " bottles of beer!\n"
        unique_additional_verse_pre_counting_lyric_string_concatonation_singular = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_singular = " bottle of beer!\n"
    } else {
      # custom song; Alice the horse if not set;
      # cat(song)
    }
  
    for (i in seq_along(numeric_counts_vector)){
      if(!(unique_additional_verse)){
          if (!(identical(numeric_counts_vector[[i]], counting_lyric_singular_conditional_string))){
            print_count_lyric <- str_c(pre_counting_lyric_string_concatonation_plural, numeric_counts_vector[[i]], post_counting_lyric_string_concatonation_plural)
          } else {
            print_count_lyric <- str_c(pre_counting_lyric_string_concatonation_singular, numeric_counts_vector[[i]], post_counting_lyric_string_concatonation_singular)
          }

          if (identical(numeric_counts_vector[[i]], final_count_condition_string)){
            print_static_string <- final_result_static_string
          } 

          for (j in seq(1,n_repetitions_counting_lyric)){
            cat(print_count_lyric)
          }
          cat(print_static_string)
        } else {
        if (!(identical(numeric_counts_vector[[i]], counting_lyric_singular_conditional_string))){
            capitalized_numeric_counts_vector <- capitalize_first_letter_in_string(numeric_counts_vector[[i]])
            print_count_lyric <- str_c(pre_counting_lyric_string_concatonation_plural, capitalized_numeric_counts_vector, post_counting_lyric_string_concatonation_plural)
            unique_print_count_lyric <- str_c(unique_additional_verse_pre_counting_lyric_string_concatonation_plural, capitalized_numeric_counts_vector, unique_additional_verse_post_counting_lyric_string_concatonation_plural)
          } else {
            capitalized_numeric_counts_vector <- capitalize_first_letter_in_string(numeric_counts_vector[[i]])
            print_count_lyric <- str_c(pre_counting_lyric_string_concatonation_singular, capitalized_numeric_counts_vector, post_counting_lyric_string_concatonation_singular)
            unique_print_count_lyric <- str_c(unique_additional_verse_pre_counting_lyric_string_concatonation_singular, capitalized_numeric_counts_vector, unique_additional_verse_post_counting_lyric_string_concatonation_singular)
          }

          if (identical(numeric_counts_vector[[i]], final_count_condition_string)){
            print_static_string <- final_result_static_string
          } 


          for (j in seq(1,n_repetitions_counting_lyric)){
           if(unique_additional_verse && !near(i, 1)) {
              print_count_lyrics_modified_punctuation <- modify_punctuation_in_string(print_count_lyric, "!")
              cat(print_count_lyrics_modified_punctuation)
              cat('\n')
              cat(print_count_lyric)
           } else {
              cat(print_count_lyric)  
            }
          }
          cat(unique_print_count_lyric)

          cat(print_static_string)
        }
    }
}

songs <- c("Alice the camel", "99 bottles of beer", "Ten in the bed")

attr(print_child_song, which = "songs") <- songs

attributes(print_child_song)

print_child_song(song = "ten in the bed")
```
```{r 3.4}
capitalize_first_letter_in_string <- function(initial_string){
  characters <- str_split_1(initial_string, pattern = "")
  characters[1] <- str_to_upper(characters[1])
  capitalized_string <- str_flatten(characters)
  return(capitalized_string)
}

modify_punctuation_in_string <- function(initial_string, replacement_punctuation){
  characters <- str_split_1(initial_string, pattern = "")
  if(identical(characters[length(characters)], "\n")) {
    characters[length(characters) - 1] <- replacement_punctuation  
  } else {
    characters[length(characters)] <- replacement_punctuation
  }
  modified_string <- str_flatten(characters)
  return(modified_string)
}

print_child_song <- function(
 n_repetitions_counting_lyric = 1,
        
    pre_counting_lyric_string_concatonation_plural = "Alice the camel has",
    numeric_counts_vector =  create_str_vector_from_int(
        least_significant_integer_to_convert = 0,
        most_significant_integer_to_convert = 5,
        reverse_sequence = TRUE,
        zero_synonym = "no"
    ),
    post_counting_lyric_string_concatonation_plural = " humps\n",
    
    counting_lyric_singular_conditional_string = "one",
    pre_counting_lyric_string_concatonation_singular = "Alice the camel has ",
    post_counting_lyric_string_concatonation_singular = " hump\n",
    
    print_static_string = "So go Alice go, boom, boom, boom!\n",
    
    final_count_condition_string = "no",
    final_result_static_string = "Because Alice is a horse of course!\n",

    unique_additional_verse = FALSE,
    unique_additional_verse_pre_counting_lyric_string_concatonation_plural = "",
    unique_additional_verse_post_counting_lyric_string_concatonation_plural = "",
    unique_additional_verse_pre_counting_lyric_string_concatonation_singular = "",
    unique_additional_verse_post_counting_lyric_string_concatonation_singular = "",
    
    vessel = "",
    vessel_plural = "",
    liquid = "",

    song = "custom"
    
    ){
    if (str_like(song, "Alice the camel", ignore_case = TRUE)){
        # Parameters for Alice the camel.
        n_repetitions_counting_lyric = 3
        
        pre_counting_lyric_string_concatonation_plural = "Alice the camel has"
        numeric_counts_vector =  create_str_vector_from_int(
            least_significant_integer_to_convert = 0,
            most_significant_integer_to_convert = 5,
            reverse_sequence = TRUE,
            zero_synonym = "no"
        )
        post_counting_lyric_string_concatonation_plural = " humps\n"
        
        counting_lyric_singular_conditional_string = "one"
        pre_counting_lyric_string_concatonation_singular = "Alice the camel has "
        post_counting_lyric_string_concatonation_singular = " hump\n"
        
        print_static_string = "So go Alice go, boom, boom, boom!\n"
        
        final_count_condition_string = "no"
        final_result_static_string = "Because Alice is a horse of course!\n"
    
        unique_additional_verse = FALSE
        unique_additional_verse_pre_counting_lyric_string_concatonation_plural = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_plural = ""
        unique_additional_verse_pre_counting_lyric_string_concatonation_singular = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_singular = ""

    } else if(str_like(song, "Ten in the bed", ignore_case = TRUE)) {
        # Parameters for Ten in the bed.
        n_repetitions_counting_lyric <- 1
        pre_counting_lyric_string_concatonation_plural <- "There were "
        numeric_counts_vector <- create_str_vector_from_int(
                    least_significant_integer_to_convert = 1,
                    most_significant_integer_to_convert = 10,
                    reverse_sequence = TRUE,
                    zero_synonym = "no"
                )
        post_counting_lyric_string_concatonation_plural <- " in the bed\n"

        counting_lyric_singular_conditional_string <- "one"
        pre_counting_lyric_string_concatonation_singular <- "There was "
        post_counting_lyric_string_concatonation_singular <- " in the bed\n"

        print_static_string <- 'And the little one said, "Roll over, roll over"\nSo they all rolled over and one fell out\n\n'

        final_count_condition_string <- "one"
        final_result_static_string <- 'And the little one said, "Goodnight"\n\nBravo'

        unique_additional_verse = FALSE
        unique_additional_verse_pre_counting_lyric_string_concatonation_plural = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_plural = ""
        unique_additional_verse_pre_counting_lyric_string_concatonation_singular = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_singular = ""
      
    } else if(str_like(song, "99 bottles of beer", ignore_case = TRUE)) {
        # Parameters for 99 bottles of beer
        n_repetitions_counting_lyric = 1
    
        pre_counting_lyric_string_concatonation_plural = ""
        numeric_counts_vector =  create_str_vector_from_int(
            least_significant_integer_to_convert = 1,
            most_significant_integer_to_convert = 100,
            reverse_sequence = TRUE,
            zero_synonym = "no"
        )
        post_counting_lyric_string_concatonation_plural = " bottles of beer on the wall,\n"
    
        counting_lyric_singular_conditional_string = "one"
        pre_counting_lyric_string_concatonation_singular = ""
        post_counting_lyric_string_concatonation_singular = " bottle of beer on the wall,\n"
    
        print_static_string = "Take one down,\nPass it around,\n"
    
        final_count_condition_string = "one"
        final_result_static_string = "Take it down,\nPass it around,\nNo more bottles of beer on the wall!\n"

        unique_additional_verse = TRUE
        unique_additional_verse_pre_counting_lyric_string_concatonation_plural = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_plural = " bottles of beer!\n"
        unique_additional_verse_pre_counting_lyric_string_concatonation_singular = ""
        unique_additional_verse_post_counting_lyric_string_concatonation_singular = " bottle of beer!\n"

        vessel = ""
        vessel_plural = ""
        liquid = ""

    } else {
      # custom song; Alice the horse if not set;
      # cat(song)
    }
  
    for (i in seq_along(numeric_counts_vector)){
      if(!(unique_additional_verse)){
          if (!(identical(numeric_counts_vector[[i]], counting_lyric_singular_conditional_string))){
            print_count_lyric <- str_c(pre_counting_lyric_string_concatonation_plural, numeric_counts_vector[[i]], post_counting_lyric_string_concatonation_plural)
          } else {
            print_count_lyric <- str_c(pre_counting_lyric_string_concatonation_singular, numeric_counts_vector[[i]], post_counting_lyric_string_concatonation_singular)
          }

          if (identical(numeric_counts_vector[[i]], final_count_condition_string)){
            print_static_string <- final_result_static_string
          } 

          for (j in seq(1,n_repetitions_counting_lyric)){
            cat(print_count_lyric)
          }
          cat(print_static_string)
        } else {
        if (!(identical(numeric_counts_vector[[i]], counting_lyric_singular_conditional_string))){
            capitalized_numeric_counts_vector <- capitalize_first_letter_in_string(numeric_counts_vector[[i]])
            print_count_lyric <- str_c(pre_counting_lyric_string_concatonation_plural, capitalized_numeric_counts_vector, post_counting_lyric_string_concatonation_plural)
            unique_print_count_lyric <- str_c(unique_additional_verse_pre_counting_lyric_string_concatonation_plural, capitalized_numeric_counts_vector, unique_additional_verse_post_counting_lyric_string_concatonation_plural)
            
            if (!(identical(vessel, "")) && !(identical(vessel_plural, ""))){
                # alter vessel
                print_count_lyric <- str_replace_all(print_count_lyric, "bottles", vessel_plural)
                unique_print_count_lyric <- str_replace_all(unique_print_count_lyric, "bottles", vessel_plural)
            } 


            if (!(identical(liquid, ""))){
                # alter bottle
                print_count_lyric <- str_replace_all(print_count_lyric, "beer", liquid)
                unique_print_count_lyric <- str_replace_all(unique_print_count_lyric, "beer", liquid)
            } 
            
          } else {
            capitalized_numeric_counts_vector <- capitalize_first_letter_in_string(numeric_counts_vector[[i]])
            print_count_lyric <- str_c(pre_counting_lyric_string_concatonation_singular, capitalized_numeric_counts_vector, post_counting_lyric_string_concatonation_singular)
            unique_print_count_lyric <- str_c(unique_additional_verse_pre_counting_lyric_string_concatonation_singular, capitalized_numeric_counts_vector, unique_additional_verse_post_counting_lyric_string_concatonation_singular)
            
            if (!(identical(vessel, "")) && !(identical(vessel_plural, ""))){
                # alter vessel
                print_count_lyric <- str_replace_all(print_count_lyric, "bottles", vessel_plural)
                unique_print_count_lyric <- str_replace_all(unique_print_count_lyric, "bottles", vessel_plural)
            } 
            
            if (!(identical(liquid, ""))){
                # alter bottle
                print_count_lyric <- str_replace_all(print_count_lyric, "beer", liquid)
                unique_print_count_lyric <- str_replace_all(unique_print_count_lyric, "beer", liquid)
            } 
          }

          # One bottle of beer lyric
          if (identical(numeric_counts_vector[[i]], final_count_condition_string)){
            if (!(identical(vessel, "")) && !(identical(vessel_plural, ""))){
                  # alter vessel
                  final_result_static_string <- str_replace_all(final_result_static_string, "bottles", vessel_plural)
                  
                  print_count_lyric <- str_replace_all(print_count_lyric, "bottles", vessel_plural)
                  unique_print_count_lyric <- str_replace_all(unique_print_count_lyric, "bottles", vessel_plural)
             } 
                
             if (!(identical(liquid, ""))){
                # alter bottle
                final_result_static_string <- str_replace_all(final_result_static_string, "beer", liquid)
                
                print_count_lyric <- str_replace_all(print_count_lyric, "beer", liquid)
                unique_print_count_lyric <- str_replace_all(unique_print_count_lyric, "beer", liquid)
             } 
            
            print_static_string <- final_result_static_string
          }
          


          for (j in seq(1,n_repetitions_counting_lyric)){
           if(unique_additional_verse && !near(i, 1)) {
              print_count_lyrics_modified_punctuation <- modify_punctuation_in_string(print_count_lyric, "!")
              
              cat(print_count_lyrics_modified_punctuation)
              
              cat('\n')
              cat(print_count_lyric)
           } else {
              cat(print_count_lyric)  
            }
          }
          cat(unique_print_count_lyric)

          cat(print_static_string)
        }
    }
}

songs <- c("Alice the camel", "99 bottles of beer", "Ten in the bed")

attr(print_child_song, which = "songs") <- songs

# attributes(print_child_song)

# print_child_song(song = "ten in the bed")
```


```{r 3.4 Final}
print_child_song(
        n_repetitions_counting_lyric = 1,
    
        pre_counting_lyric_string_concatonation_plural = "",
        numeric_counts_vector =  create_str_vector_from_int(
            least_significant_integer_to_convert = 1,
            most_significant_integer_to_convert = 100,
            reverse_sequence = TRUE,
            zero_synonym = "no"
        ),
        post_counting_lyric_string_concatonation_plural = " bottles of beer on the wall,\n",
    
        counting_lyric_singular_conditional_string = "one",
        pre_counting_lyric_string_concatonation_singular = "",
        post_counting_lyric_string_concatonation_singular = " bottle of beer on the wall,\n",
    
        print_static_string = "Take one down,\nPass it around,\n",
    
        final_count_condition_string = "one",
        final_result_static_string = "Take it down,\nPass it around,\nNo more bottles of beer on the wall!\n",

        unique_additional_verse = TRUE,
        unique_additional_verse_pre_counting_lyric_string_concatonation_plural = "",
        unique_additional_verse_post_counting_lyric_string_concatonation_plural = " bottles of beer!\n",
        unique_additional_verse_pre_counting_lyric_string_concatonation_singular = "",
        unique_additional_verse_post_counting_lyric_string_concatonation_singular = " bottle of beer!\n",

        vessel = "jug",
        vessel_plural = "jugs",
        liquid = "water"
)

```

```{r}
# Quesion 4
x <- seq(1, 100)
growing_vector <- function(x){
  output <- vector("integer", 0)
  for (i in seq_along(x)) {
    output <- c(output, lengths(x[[i]]))
  }
  # print(length(output))
  output
}
growing_vector(x)
```

```{r}
preallocate_vector <- function(x){
  output <- vector("integer", length(x))
  for (i in seq_along(x)) {
    output[i] <- lengths(x[[i]])
  }
  # print(length(output))
  output
}
preallocate_vector(x)
```


```{r}
if(!require("microbenchmark")) install.packages("microbenchmark")
library(microbenchmark)
```


```{r}
# Growing Vector Times Vs. Preallocated Vector Times:

# Growing Vector Vs. Preallocated is Faster on Average under these conditions
# set.seed(42)
# set_unit = "nanoseconds"
# trials  = 1000
# microbenchmark(growing_vector(100), unit = set_unit, times = trials )
# microbenchmark(preallocate_vector(100), unit = set_unit, times = trials )

# set.seed(42)
# set_unit = "nanoseconds"
# trials  = 100000
# microbenchmark(growing_vector(1), unit = set_unit, times = trials )
# microbenchmark(preallocate_vector(1), unit = set_unit, times = trials )


set.seed(42)
set_unit = "nanoseconds"
trials  = 100000

microbenchmark(growing_vector(1), unit = set_unit, times = trials )
microbenchmark(preallocate_vector(1), unit = set_unit, times = trials )

microbenchmark(growing_vector(100), unit = set_unit, times = trials )
microbenchmark(preallocate_vector(100), unit = set_unit, times = trials )

microbenchmark(growing_vector(10000), unit = set_unit, times = trials )
microbenchmark(preallocate_vector(10000), unit = set_unit, times = trials )

microbenchmark(growing_vector(1000000), unit = set_unit, times = trials )
microbenchmark(preallocate_vector(1000000), unit = set_unit, times = trials )

# Comparing a vector that grows versus a vector that preallocates results in average microbenchmark times in which the function which preallocated a vector was faster on average than the function which grew a vector during operation. There were two instances in which this was found to be untrue. In the case that both functions are run 1000 times and the final sizes of the vectors are of length 100, the mean time to complete the function to grow a vector versus preallocate a vector was faster. Likewise, in the case that both functions are run 100000 times and the final sizes of the vectors are of length 1, the mean time to complete the function to grow a vector versus preallocate a vector was faster as well. The mechanics of this behaviour are unexplained, as varying the length of the times a function was computed while holding the final length to 1 persisted the pattern of faster execution times for preallocated vectors versus growing vectors. Furthermore, preallocated vectors versus growing vectors continued the trend of faster execution times when the length of the final vector increased from 1 or varied from 100000 while keeping the numer of times the functions were executed constant. 
```


## Section 21.3 For Loop Variations
```{r}
flip <- function() sample(c("T", "H"), 1)
```

#### Section 21.3.5: Exercises
```{r}
# Question 1
file_path <- str_c(getwd(), "/data/")
files <- dir(file_path, pattern = "\\.csv$", full.names = TRUE)
index <- 1

tbs <- vector(mode = "list", length = length(files))
while (index <= length(files)){
  tbs[index] <- read_csv(files[index])
  index <- index + 1
}
```

```{r eval = FALSE}
# Quesion 2
# When 'for (nm in names(y))' is used and y is an unnamed vector, nothing is returned by the for loop and there are no errors or warnings. 
# When there is an inconsistency in the number of named items in a vector, the names of the named items are accessible to be printed whereas the names of the unnamed items print "". If the unnamed name is used to address inside y, then NA is returned. If the names are not unique, the first instance of the name will be used as the index.

for (nm in names(y)) {
  print(y[nm])
}
```
```{r}
if(!require("DescTools")) install.packages("DescTools")
library(DescTools)
```


```{r}
# Quesion 3
x
show_mean <- function(data) {
  y <- character()
  for (nm in names(data)) {
    if(is.numeric(data[[nm]])){
      
      y <- c(y, sprintf("%s: %f", nm, mean(data[[nm]])))
      # print(typeof(y))
      # str(y)
      
      # y <- str_pad(y, 20, "right")
      # print(y)
      # formatC('print')
      # print(mean(iris[[nm]]))
    }
  }
  cbind(StrAlign(y, sep = "\\r"))
}
show_mean(iris)
```

```{r}
# Quesion 4
# This function will create a list that: 
# 1. scales an input value "x"
# 2. creates a factor of "x" with labels of "auto" and "manual"
# For each name in trans, "disp" & "am", the same name will be used to assign mtcars at the location of each name the value of mtcars at the specified index once transformed by each respective function "disp" & "am" in trans. "am" transforms from values of 0 and 1 into factored levels of "auto" and "manual". This is a list of functions where each function in the list is indexed and the indexes match to the column in mtcars that is desired to be transformed. This function transforms the columns of mtcars with operations that are unique to each column defined in the transformation list names "trans".
trans <- list( 
  disp = function(x) x * 0.0163871,
  am = function(x) {
    factor(x, labels = c("auto", "manual"))
  }
)
for (var in names(trans)) {
  print(var)
  print(trans[[var]])
  mtcars[[var]] <- trans[[var]](mtcars[[var]])
}
```


```{r}
mtcars <- datasets::mtcars
```


## Section 21.4 For loops vs. functionals
```{r}
# It is possible to pass functions into functions.
```

#### Section 21.4.1: Exercises
```{r}
# Question 1
# lappy will return an array of dimension c(n, dim(X) [MARGIN]) if n > 1.
```

```{r}
df <- tibble(0.585731553977938, "string")
```

```{r eval = FALSE}
# Quesion 2
# Adapt col_summary() so that it only applies to numeric columns

# col_summary <- function(df, fun) {
#   out <- vector("double", length(df))
#   for (i in seq_along(df)) {
#     out[i] <- fun(df[[i]])
#   }
#   out
# }
# 
# col_summary(mtcars, summary)

col_summary <- function(df, fun) {
  out <- vector("double", length(df))

  for (i in seq_along(df)) {
    if(is.numeric(df[[i]])) {
      out[i] <- fun(df[[i]])
    }
  }
  out
}
col_summary(mtcars, median)
#> [1] -0.51850298  0.02779864  0.17295591 -0.61163819
col_summary(mtcars, mean)
#> [1] -0.3260369  0.1356639  0.4291403 -0.2498034
```

## Section 21.5: The map functions

```{r}
# purrr functions
# map() makes a list
# map_lgl() makes a logical vector.
# map_int() makes an integer vector.
# map_dbl() makes a double vector.
# map_chr() makes a character vector.
```


```{r}
x<-list(list(1,2,3), list(4,5,6), list(7,8,9))
x %>% map_dbl(2)
```

```{r}
models <- mtcars %>%
  split(.$cyl) %>% # splits mtcars into groups by cylinders; 
  map(~lm(mpg ~ wt, data = .)) 
# After creating groups, the observations in each group will be used to create
# linear models of mpg with respect to weight.
  
```


```{r}
models %>%
  map(summary) %>% # This will create a list of summaries of each model that is created.
  map_dbl("r.squared")
```

#### Section 21.5.3: Exercises
```{r}
#  1.1
mtcars %>% map_dbl(mean)
```

```{r}
#  1.2
# Determine the type of each column in nycflights13::flights
flights <- nycflights13::flights
flights %>% map(typeof)
```

```{r}
# Question 1.3
# Compute the number of unique values in each column of iris
iris %>% map(unique) %>% map(length)
```
```{r}
# Question 1.4 
# Generate 10 random normals from distributions with means of -10, 0, 10, and 100
mu <- list(-10, 0, 10, 100)
mu %>% map(rnorm, n = 10) %>% str()
```

```{r}
# Quesion 2
# This will determine if each column in a dataframe is a factor.

tb <- tibble(c(1,2,3,4))
tb %>% map(is.factor)
```

```{r}
# Quesion 3
# What happens when you use the map functions on vectors that aren't lists?
# What does map(1:5, runif) do? Why?
# When functions are mapped to vectors that are not lists, the values are passed to the function as if the function was called using the values directly. This is becuase the values are being mapped to the function where map uses an ellipses as a catch all to pass values to the function. 
```

```{r}
# Quesion 4

# map(-2:2, rnorm, n = 5) in the previous mapping, n is the number of observations that are created and -2:2 are used to calculate the mean from within that range of values and the number of times the function rnorm is run.

# map_dbl(-2:2, rnorm, n = 5) Will throw an error that the result length must be 1 not 5. This is because will create 5 rnorm distributions with means from -2:2

map_dbl(-1:1, rnorm, n = 1) # This function will create a number of random samples equal to the max of the spread of integers provided minus the min of the spread of the integers provided plus one. R in this case is the number of times a distrubution is created. "Map_dbl" uses -1:1 as the double argument, rnorm as the function, and n as the side effect. In this case, the resultant length is determined by "n" in the mapped double where the resultant length must be 1 rather than 5.

```

```{r}
# Quesion 5
# Rewrite map(x, function(df) lm(mpg ~ wt, data = df))
# df %>% map(~lm(mpg ~ wt, data = df))
```


## Section 21.6 Dealing with failure
```{r}
# possibly always succeeds; uses a default value to return when there is an error.
# safely works with map; safely will return only mappings that are successful.
# quietly works with errors, printed output, messages, and warnings.
```

## Section 21.7 Mapping over multiple arguments
```{r}
# mapping random normals with different means
mu <- list(5, 10, -3)
mu %>% map(rnorm, n = 5) %>% str()
```

```{r}
# creating multiple functions with different paramters using a tribble
sim <- tribble (
  ~f,   ~params,
  "runif", list(min = -1, max = 1),
  "rnorm", list(sd = 5),
  "rpois", list(lambda = 10)
)

sim %>% mutate(sim = invoke_map(f, params, n = 10))
```

## Section 21.8: Walk
```{r}
# Walk is a side effect of print that is used to call a function for its side-effects rather than for its return value.
x <- list(1, "a", 3)
x %>% walk(print)
# There are also walk2 & pwalk functions used to walk multiple arguments.
```

#### Section 21.9.2: Predicate Functions
```{r}
# keep() & discard() keep elements of the input where the predicate is TRUE and FALSE respectively.
# Example: keep only the elements in iris that are factors
iris %>%
  keep(is.factor) %>%
  str() 
```



```{r}
# Example: discard elements of iris that are not factors.
iris %>%
  discard(is.factor) %>%
  str()
```

```{r}
iris %>% map(is.factor)

```

```{r}
# some() & every() determine if the predicate is true for some or all of the elements. For example:
x <- list(1:5, letters, list(10))

x %>% some(is_character)

x %>% every(is_vector)
```

```{r}
x <- sample(10)
x

# detect finds the first element where the predicate is true
x %>% detect(~ . > 5)

# detect_index returns the position of the first element where the predicate is true
x %>% detect_index(~ . > 5)

```

```{r}
# head_while takes elements from the start or end of a vector while a predicate is true. 
x %>% head_while(~ . > 5)
x %>% tail_while(~ . > 5)
```

#### Section 21.9.2: Reduce and accumulate
```{r}
# Reduce will reduce a complex list to a simple list by reducing a pair to a singleton.
# Example:

dfs <- list(
  age = tibble(name = "John", age = 30),
  sex = tibble(name = c("John", "Mary"), sex = c("M", "F")),
  trt = tibble(name = "Mary", treatment = "A")
)

dfs %>% reduce(full_join)
```


```{r}
# finding the intersection among a list of vectors
vect <- list(
  c(1,3,5,6,10),
  c(1,2,3,7,8,10),
  c(1,2,3,4,8,9,10)
)

vect %>% reduce(intersect)

# Reduce takes a binary function (a function with two primary inputs) and repeatedly applies it until there is only a single element left.
```

```{r}
# Accumulate takes a binary function and repeatedly applies it until there is only a single element left while keeping the intermediate results.
# For Example:
x <- sample(10)
(x)
x %>% accumulate(`+`)
x %>% accumulate(`-`)
```

#### Section 21.9.3: Exercises
```{r}
# Question 1
# Implementing every(): This version of every will map an input to a function, and verify that "FALSE" is not in the list of returned values from the mappings. Like every, custom_every will accept both lists and vectors.
x <- seq(1:10)
custom_every <- function(x, func) {
  map_vector <- map(x, func)
  if (FALSE %in% map_vector){
    return(FALSE)
  } else {
    return(TRUE)
  }
} 
custom_every(x, is.factor)
```

```{r}
# Quesion 2
# Create an advanced col_summary that applies a summary function to every column in a data frame.
col_summary <- function(df, fun) {
  out <- vector("double", length(df))
  for (i in seq_along(df)) {
    out[i] <- fun(df[[i]])
  }
  out
}

col_summary(mtcars, summary)
```

```{r}
# Quesion 2
adv_col_summary <- function(df, fun) {
  out <- vector("double", length(df))
  for (i in seq_along(df)) {
    out[i] <- map(df[i], fun)
  }
  out
}
adv_col_summary(mtcars, summary)
```

```{r}
# Quesion 3
col_sum3 <- function(df, f) {
  is_num <- sapply(df, is.numeric)
  df_num <- df[, is_num]

  sapply(df_num, f)
}
```

```{r eval = FALSE}
# Quesion 3
df <- tibble(
  x = 1:3, 
  y = 3:1,
  z = c("a", "b", "c")
)
# OK
col_sum3(df, mean)
# Has problems: don't always return numeric vector
col_sum3(df[1:2], mean)
col_sum3(df[1], mean)
# col_sum3(df[0], mean)
```

```{r}
# Quesion 3
df[0]
is_num_error <- sapply(df[0], is.numeric) # df[0] is an empty tibble containing 3 rows and zero columns. Sapply returns a named list when this tibble is computed using the function "is.numeric" (rather than returning the expected values of either TRUE or FALSE. The "named list()" is next used to index all rows where the columns match "named list()" which results in an error because the subset must be subset with a logical, numeric, or character rather than an empty list. 
is_num_1 <- sapply(df[1], is.numeric)

is_num_error
is_num_1
```
## Section 23: Model Basics
#### Section 23.2 A Simple Model
```{r}
library(tidyverse)
library(modelr)
options(na.action = na.warn)
```

```{r}
# modelr::sim1
```

```{r}
ggplot(sim1, aes(x, y)) +
  geom_point()
```

```{r}
# Creating random intercepst and slopes
models <- tibble(
  a1 = runif(250, -20, 40),
  a2 = runif(250, -5, 5)
)
```

```{r}
ggplot(sim1, aes(x, y)) + 
  geom_abline(aes(intercept = a1, slope = a2), data = models, alpha = 1/4) + 
  geom_point()
```

```{r}
# R function of a model family (predicted values)
model1 <- function(a, data) {
  a[1] + data$x * a[2]
}
model1(c(7, 1.5), sim1)
```

```{r}
# Compute the difference between actual and predicted values
measure_distance <- function(mod, data) {
  diff <- data$y - model1(mod, data)
  sqrt(mean(diff ^ 2))
}
measure_distance(c(7, 1.5), sim1)
```


```{r}
# Compute the distance for all models defined above. 
# Create a helper function to map BOTH a1 intercept and a2 slope into the measure distance function with map2_dbl; passing c(a1, a2) into measure_distance will not map both variables into the measure_distance function.

sim1_dist <- function(a1, a2) {
  measure_distance(c(a1, a2), sim1)
}

# This will map both a1 & a2 into sim1_dist which will then create a vector of both a1 and a2 pairs to calculate a predicted y value before taking the difference from the actual y value in sim1 and returning the square root of the mean of the square of the difference as the distance "dist".
models <- models %>%
  mutate(dist = purrr::map2_dbl(a1, a2, sim1_dist))
models

```

```{r}
# Overlaying the best 10 models on the data
ggplot(sim1, aes(x, y)) +
  geom_point(size = 2, color = "grey30") +
  geom_abline(aes(intercept = a1, slope = a2, color = -dist), data = filter(models, rank(dist) <= 10))
```


```{r}
# Plotting the random intercept and slopes a1 & a2 (which represent models) as points
ggplot(models, aes(a1, a2)) +
  geom_point(data = filter(models, rank(dist) <= 10), size = 4, color = "red") +
  geom_point(aes(color = -dist))
```


```{r}
# Grid Search: Generating evenly spaced points rather than random models based on the 10 best randomly generated points in the plot above.
grid <- expand.grid(
  a1 = seq(-5, 20, length = 25),
  a2 = seq(1, 3, length = 25)
) %>% 
  mutate(dist = purrr::map2_dbl(a1, a2, sim1_dist))

grid %>%
  ggplot(aes(a1, a2)) +
  geom_point(data = filter(grid, rank(dist) <= 10), size = 4, color = "red") + 
  geom_point(aes(color =))

```

```{r}
# Overlaying the 10 best models back on the original data using evenly spaced points.
ggplot(sim1, aes(x, y)) +
  geom_point(size = 2, color = "grey30") +
  geom_abline(
    aes(intercept = a1, slope = a2, color = -dist),
    data = filter(grid, rank(dist) <= 10)
  )
```

```{r}
# Iteratively making the grid finer
# Grid Search: Generating evenly spaced points rather than random models based on the 10 best randomly generated points in the plot above.
grid <- expand.grid(
  a1 = seq(0, 10, length = 25),
  a2 = seq(1.5, 2.5, length = 25)
) %>% 
  mutate(dist = purrr::map2_dbl(a1, a2, sim1_dist))

grid %>%
  ggplot(aes(a1, a2)) +
  geom_point(data = filter(grid, rank(dist) <= 10), size = 4, color = "red") + 
  geom_point(aes(color = -dist))

ggplot(sim1, aes(x, y)) +
  geom_point(size = 2, color = "grey30") +
  geom_abline(
    aes(intercept = a1, slope = a2, color = -dist),
    data = filter(grid, rank(dist) <= 10)
  )
```

```{r}
# Newton-Raphson search
# Select a point, find the steepest slope (tangent to a curve). Search for another point and repeat this process.
# optim() represents this mathematical minimization search
best <- optim(c(0,0), measure_distance, data = sim1)
best$par

ggplot(sim1, aes(x, y)) + 
  geom_point(size = 2, color = "grey30") +
  geom_abline(intercept = best$par[1], slope= best$par[2])
```


#### Section 23.2.1: Exercises
```{r}
# Question 1
# Fit a linear model to the simulated data below, and visualise the results. Rerun a few times to generate different simulated datasets. What do you notice about the model?

sim1a <- tibble(
  x = rep(1:10, each = 3),
  y = x * 1.5 + 6 + rt(length(x), df = 2)
)

# model1 <- lm(y ~ x, data = sim1a)
ggplot(sim1a, aes(x, y)) + 
  geom_point()

```



```{r}
# Process to fit a linear model
# Generate random points
# Compute models from random points

# Generating random points
models <- tibble(
  a1 = runif(250, -20, 40),
  a2 = runif(250, -5, 5)
)

# Compute the difference between actual and predicted values
measure_distance <- function(mod, data) {
  diff <- data$y - model1(mod, data)
  sqrt(mean(diff ^ 2))
}

# Overlaying the best 10 models on the data
sim1a_dist <- function(a1, a2) {
  measure_distance(c(a1, a2), sim1a)
}
# This will map both a1 & a2 into sim1a_dist which will then create a vector of both a1 and a2 pairs to calculate a predicted y value before taking the difference from the actual y value in sim1a and returning the square root of the mean of the square of the difference as the distance "dist".
models <- models %>%
  mutate(dist = purrr::map2_dbl(a1, a2, sim1a_dist))
models
ggplot(sim1a, aes(x, y)) +
  geom_point(size = 2, color = "grey30") +
  geom_abline(aes(intercept = a1, slope = a2, color = -dist), data = filter(models, rank(dist) <= 10))
```

```{r}
# Process to fit a linear model
# Generate random points
# Compute models from random points

# Generating new random points
models <- tibble(
  a1 = runif(250, -20, 40),
  a2 = runif(250, -5, 5)
)

# Compute the difference between actual and predicted values
measure_distance <- function(mod, data) {
  diff <- data$y - model1(mod, data)
  sqrt(mean(diff ^ 2))
}

# Overlaying the best 10 models on the data
sim1a_dist <- function(a1, a2) {
  measure_distance(c(a1, a2), sim1a)
}
# This will map both a1 & a2 into sim1a_dist which will then create a vector of both a1 and a2 pairs to calculate a predicted y value before taking the difference from the actual y value in sim1a and returning the square root of the mean of the square of the difference as the distance "dist".
models <- models %>%
  mutate(dist = purrr::map2_dbl(a1, a2, sim1a_dist))
models
ggplot(sim1a, aes(x, y)) +
  geom_point(size = 2, color = "grey30") +
  geom_abline(aes(intercept = a1, slope = a2, color = -dist), data = filter(models, rank(dist) <= 10))
```


```{r}
# Process to fit a linear model
# Generate random points
# Compute models from random points

# Generating a third set of random points
models <- tibble(
  a1 = runif(250, -20, 40),
  a2 = runif(250, -5, 5)
)

# Compute the difference between actual and predicted values
measure_distance <- function(mod, data) {
  diff <- data$y - model1(mod, data)
  sqrt(mean(diff ^ 2))
}

# Overlaying the best 10 models on the data
sim1a_dist <- function(a1, a2) {
  measure_distance(c(a1, a2), sim1a)
}
# This will map both a1 & a2 into sim1a_dist which will then create a vector of both a1 and a2 pairs to calculate a predicted y value before taking the difference from the actual y value in sim1a and returning the square root of the mean of the square of the difference as the distance "dist".
models <- models %>%
  mutate(dist = purrr::map2_dbl(a1, a2, sim1a_dist))
models
ggplot(sim1a, aes(x, y)) +
  geom_point(size = 2, color = "grey30") +
  geom_abline(aes(intercept = a1, slope = a2, color = -dist), data = filter(models, rank(dist) <= 10))
```



```{r}
# Question 1
# The models will map linearly to outliers. There is not a general trend between the three sets of lines that are visualized with respect to slope. 
```


```{r}
# Quesion 2
# Newton-Raphson search
# Select a point, find the steepest slope (tangent to a curve). Search for another point and repeat this process.
# optim() represents this mathematical minimization search

measure_distance_mean_absolute <- function(mod, data) {
  diff <- data$y - model1(mod, data)
  mean(abs(diff))
}

# Root-Mean-Squared-Distance
best <- optim(c(0,0), measure_distance, data = sim1)
best$par

ggplot(sim1, aes(x, y)) + 
  geom_point(size = 2, color = "grey30") +
  geom_abline(intercept = best$par[1], slope= best$par[2]) +
  labs(title = "Root-Mean-Squared-Distance")

# Mean-Absolute Distance 
best <- optim(c(0,0), measure_distance_mean_absolute, data = sim1)
best$par

ggplot(sim1, aes(x, y)) + 
  geom_point(size = 2, color = "grey30") +
  geom_abline(intercept = best$par[1], slope= best$par[2]) +
  labs(title = "Mean-Absolute-Distance")

# The mean-absolute-distance is a slightly better fit to the sample data than the root-mean-squared-distance. The mean-absolute-distance travels directly through points in the sample that are indirectly traversed by the line fit by the root-mean-squared-distance.
```


```{r}
# Quesion 3

# The problem with optimising a three parameter model is that the global optimal value may never be found. A local optimal value may be identified as the maximum or minimum optimal value, but the true global maximum or minimum is established elsewhere. 
model1 <- function(a, data) {
  a[1] + data$x * a[2] + a[3]
}
```


## Section 23.3: Visualising Models
```{r}
# https://r4ds.had.co.nz/model-basics.html
```


#### Section 23.3.1: Predictions 
```{r}
# Data grid: an evenly spaced grid of values that covers the region where the data lies.
sim1
grid <- sim1 %>% data_grid(x)
grid
```

```{r}
sim1_mod <- lm(y ~ x, data = sim1) 
grid <- grid %>% add_predictions(sim1_mod)
grid
```

```{r}
ggplot(sim1, aes(x)) +
  geom_point(aes(y = y)) +
  geom_line(aes(y = pred), data = grid, color = "red", size = 1)
```

#### Section 23.3.2: Residuals
```{r}
# Predictions indicate the pattern captured by the model, residuals indicate what the model failed to capture.
# Residuals are the differences between the observed and predicted values shown above.
sim1 <- sim1 %>% add_residuals(sim1_mod)
sim1
```

```{r}
# Understanding the spread of the residuals
ggplot(sim1, aes(resid)) +
  geom_freqpoly(binwidth = 0.5)
```


```{r}
# The residuals appear to be random noise. This inidcates that the model appropriately captured the patterns in the dataset.
ggplot(sim1, aes(x, resid)) +
  geom_ref_line(h = 0) + 
  geom_point()
```


#### Section 23.3.3: Exercises
```{r}
# Question 1
# Repeat the process of model fitting, grid generation, predictions, and visualisation on sim1 using loess() instead of lm(). How does the result compare to geom_smooth()?
# Create an evenly spaced grid of values
# fit a model to data using loess

# Create an evenly spaced grid of values (grid generation)
grid_loess <- sim1 %>% data_grid(x)
grid_loess

# Create a model that captures the patterns of the data (model fitting)
sim_loess_mod <- loess(y ~ x , data = sim1)
sim_loess_mod

# Add the predictions of the model (create predictions)
grid_loess <- grid_loess %>% add_predictions(sim_loess_mod)
grid_loess

# Add the residuals of the model 
sim1_loess_residuals <- sim1 %>% add_residuals(sim_loess_mod)
sim1_loess_residuals
```

```{r}
# Question 1
ggplot(sim1, aes(x)) +
  geom_point(aes(y = y)) + 
  geom_line(aes(y = pred), size = 2, color = "red", data = grid_loess)
```

```{r}
# Question 1
ggplot(sim1_loess_residuals) +
  geom_freqpoly(aes(resid))
```

```{r}
# Question 1
# The residuals from the loess model are similar but not identical to the random noise that was shown in the plot of the residuals stemming from the linear model.
ggplot(sim1_loess_residuals, aes(x)) + 
  geom_ref_line(h = 0) + 
  geom_point(aes(y = resid))
```

```{r}
# Question 1
# How do the results compare to geom_smooth?
ggplot(sim1, aes(x)) +
  geom_point(aes(y = y)) + 
  geom_line(aes(y = pred), size = 2, color = "red", data = grid_loess) +
  geom_smooth(aes(y = pred), data = grid_loess, se = FALSE) + 
  labs(title = "Smooth vs. Line Plot of Residuals of Loess model")
  
# These two lines look nearly identical. The "smoothed" line does not have as sharp a change in slope as the geom_line does.
```

```{r}
# Quesion 2
# add_predictions: adds a new single column to the dataframe (default name "pred") to the data.
# gather_predictions: gather_predictions adds two columns (model and pred); repeats the input rows for each model. Adds each prediction as a row.
# spread_predictions: spread predictions adds one column for each model.


```


```{r}
# Quesion 3
# What does geom_ref_line() do? What package does it come from? Why is displaying a reference line in plots showing residuals useful and important?

# geom_ref_line creates a horizontal reference line. This is a space by default. This comes from the "modelr" package. Displaying a reference line in plots showing residuals is usefule because it allows one to identify a common difference between all points with respect to the reference. It is important because with out a reference line, there is no common means with which to compare points at a glance. 

```

```{r}
# Quesion 4
# Why might you want to look at a frequency polygon of absolute residuals? What are the pros and cons compared to looking at the raw residuals?

# A frequency polygon of absolute residuals indicates the number of times the absolute value of a residual occurs. The line of best fit will have the greatest count of residuals at zero. By examining the absolute value of the residuals, the frequency of their occurences are comparable with respect to zero regardless of sign.

```


## Section 23.4: Formulas and model families

#### Section 23.4.4: Transformations
```{r}
sim5 <- tibble(
  x = seq(0, 3.5 * pi, length = 50),
  y = 4 * sin(x) + rnorm(length(x))
)
sim5
```

```{r}
rnorm(50) # 50 random numbers with a mean of zero, a standard deviation of 1 and a normal distribution
```

```{r}
ggplot(sim5, aes(x, y)) +
  geom_point()
```

```{r}
# Approximating a non-linear function:
df <- tribble(
  ~x, ~y,
  1, 1, 
  2, 2, 
  3, 3
)

library(splines)
model_matrix(df, y ~ ns(x, 2)) # polynomial to x^2
```

```{r}
sim5 <- tibble(
  x = seq(0, 3.5 * pi, length = 50),
  y = 4 * sin(x) + rnorm(length(x))
)

# Random normal distribution of 50 points with values from zero to 3.5 * pi added to 4 times the sine of the same values.
ggplot(sim5, aes(x, y))+
  geom_point() 
```



```{r}
# Fitting 5 models to this data
mod1 <- lm(y ~ ns(x, 1), data = sim5)
mod2 <- lm(y ~ ns(x, 2), data = sim5)
mod3 <- lm(y ~ ns(x, 3), data = sim5)
mod4 <- lm(y ~ ns(x, 4), data = sim5)
mod5 <- lm(y ~ ns(x, 5), data = sim5)

grid <- sim5 %>%
  data_grid(x = seq_range(x, n = 50, expand = 0.1)) %>%
  gather_predictions(mod1, mod2, mod3, mod4, mod5, .pred = "y")
```

```{r}
grid
```


```{r}
ggplot(sim5, aes(x, y)) +
  geom_point() +
  geom_line(data = grid, color = "red") +
  facet_wrap(~model)
```


```{r}
seq2 <- tibble(
  x = seq(0, 5 * pi, length = 50),
  y = 4*cos(x) + rnorm(length(x))
)

ggplot(seq2, aes(x, y)) + 
  geom_point()
```


```{r}
mod1 <- lm(y ~ ns(x, 1), data = seq2)
mod2 <- lm(y ~ ns(x, 2), data = seq2)
mod3 <- lm(y ~ ns(x, 3), data = seq2)
mod4 <- lm(y ~ ns(x, 4), data = seq2)
mod5 <- lm(y ~ ns(x, 5), data = seq2)

# grid <- sim5 %>% data_grid(x, range(x, n = 50, expand(0.1))
                           
                           
# grid <- sim5 %>% data_grid(x = seq_range(x, n = 50, expand = 0.1))
# grid <- sim3 %>% data_grid(x = seq_range(x, n = 50, expand = 0.1))
# grid <- sim4 %>% data_grid(x = seq_range(x, n = 50, expand = 0.1)) 
# a sequence of 50 points using sim2 as input. expanded by 0.1 to emphasize the effect of a Taylor polynomial beyond the bounds of the data.

# grid <- sim1 %>% data_grid(x = seq_range(x, n = 50, expand = 0.1)) %>% gather_predictions(mod1, mod2, mod3, mod4, mod5, .pred = "y")

grid <- seq2 %>% data_grid(x = seq_range(x, n = 50, expand = 0.1)) %>% gather_predictions(mod1, mod2, mod3, mod4, mod5, .pred = "y")
(grid)
```


```{r}
ggplot(seq2, aes(x,y)) +
  geom_point() +
  geom_line(data = grid, color = "red") +
  facet_wrap(~model)

```


#### Section 23.4.5: Exercises
```{r}
# Question 1
# What happens if you repeat the analysis of sim2 using a model without an intercept. 

# What happens to the model equation? What happens to the predictions?

# Removing the intercept will force the model to add a variable. All variables in the new model will be considered significant. The estimates of each model differ. However, the residuals between both models remain identical. The Adjusted R-squared value increases when the Intercept is removed. However, this is a superficial means of inflating the adjusted r-squared.
# The model equation changes to for variables: xa, xb, xc, and xd. The predictions remain unchanged. 

# Plot of sim2
ggplot(sim2) + 
  geom_point(aes(x, y))

# Model & plot of sim2
mod2 <- lm(y ~ x, data = sim2)

summary(mod2)

model_matrix(sim2, y~x)

grid <- sim2 %>% 
  data_grid(x) %>% 
  add_predictions(mod2)
grid

ggplot(sim2, aes(x)) + 
  geom_point(aes(y = y)) +
  geom_point(data = grid, aes(y = pred), colour = "red", size = 4)
```


```{r}
# Question 1
# Model & Plot of sim2 without Intercept
mod2_no_intercept <- lm(y ~ x - 1, data = sim2)
summary(mod2_no_intercept)
model_matrix(sim2, y~x-1)
grid_no_intercept <- sim2 %>% data_grid(x) %>% add_predictions(mod2_no_intercept)

ggplot(sim2, aes(x)) + 
  geom_point(aes(y = y)) +
  geom_point(data = grid_no_intercept, aes(y = pred), color = "red", size = 4)
```


```{r}
# Question 1
# Predictions: Intercept vs. No intercept.
grid_no_intercept$pred
grid$pred
```

```{r}
# Quesion 2
# Use model_matrix() to explore the equations generated for the models I fit to sim3 and sim4. Why is * a good shorthand for interaction?
# * is a good shorthand for interaction because + indicates the inclusion of another variable in a given equation. * indicates the interaction between the two variables.


# Sim3 models
# sim3_mod1 <- lm(y ~ x1 + x2, data = sim3)
# sim3_mod2 <- lm(y ~ x1 * x2, data = sim3)

model_matrix(sim3, y ~ x1 + x2)
model_matrix(sim3, y ~ x1 * x2)

# Sim4 models
# sim4_mod1 <- lm(y ~ x1 + x2, data = sim4)
# sim4_mod2 <- lm(y ~ x1 * x2, data = sim4)

model_matrix(sim4, y ~ x1 + x2)
model_matrix(sim4, y ~ x1 * x2)
```

```{r}
# Using basic principles, convert the formulas in the following two functions into models. (Hint: start by converting the categorical variables into 0-1 variables)
sim3 %>% mutate(x2 = as.numeric(x2)) %>% count(x2)

mod1 <- lm(y ~ x1 + x2, data = sim3)

model_matrix(sim3, y ~ x1 + x2)

# mod1 is expressed as y = a_0 + a_1 * x1 + a_2 * x2b + a_3 * x2c + a_4 * x2d
```


```{r}
# Quesion 3
mod2 <- lm(y ~ x1 * x2, data = sim3)
model_matrix(sim3, y ~ x1 * x2)
sim3 %>% mutate(x2 = as.numeric(x2)) %>% count(x2)

# y = a_0 + a_1 * x1 + a_2 * x2b + a_3 * x2c + a_4 * x2d + a_5 * x1 * x2b + a_6 * x1 * x2c + a_7 * x1 * x2d
```

```{r}
# Quesion 4
# For sim4, which of mod1 and mod2 is better? I think mod2 does a slightly better job at removing patterns, but it’s pretty subtle. Can you come up with a plot to support my claim?

# Gathering predictions:
mod1 <- lm(y ~ x1 + x2, data = sim4)
mod2 <- lm(y ~ x1 * x2, data = sim4)

grid <- sim4 %>% 
  data_grid(
    x1 = seq_range(x1, 5), 
    x2 = seq_range(x2, 5) 
  ) %>% 
  gather_predictions(mod1, mod2)
grid

# Gathering Residuals
sim3
sim4

grid_residuals <- sim4 %>% gather_residuals(mod1, mod2)
grid_residuals
```

```{r 4 Answer}
# Plot residuals
# The residuals are dependent upon two continuous variables (x1, x2). Each observation is coordinated with a third variable "rep" and each observation contains a unique value for y. Semi-joining the rows to reduce the number of x1 and x2 variables to a finite grid of 25 combinations would force either a selection or combination of the values of y. To prevent loss of data, the observations were retained. This, however, creates a plot with a facet-wrap that is not clear with respect to the pattern of residuals when comparing model1 and model2. 

# Mathematically, how does one precisely tell which of two models are better based on their residuals?
ggplot(grid_residuals, aes(x1, resid, color = x2)) +
  geom_point() +
  facet_grid(model ~ x2) +
  coord_flip()

# grid_residuals_model1
grid_residuals_mod1 <- grid_residuals %>% filter(model == 'mod1')
grid_residuals_mod2 <- grid_residuals %>% filter(model == 'mod2')

ggplot(grid_residuals_mod1) +
  geom_freqpoly(aes(resid)) +
  labs(title = "Freqpoly of Model 1 Residuals")

ggplot(grid_residuals_mod2) +
  geom_freqpoly(aes(resid)) +
  labs(title = "Freqpoly of Model 2 Residuals")

# Sum of the squares of the residuals (RSS)
grid_residuals_mod1_rss <- sum((grid_residuals_mod1$resid ^ 2))
grid_residuals_mod2_rss <- sum((grid_residuals_mod2$resid ^ 2))

# The smaller the residual sum of squares, the better the model fits the data.
cat("RSS Model 1: ")
(grid_residuals_mod1_rss)
cat("\nRSS Model 2: ")
(grid_residuals_mod2_rss)

# The frequency poly of the residuals of model 2 holds the greatest maximum count about 0 when compared to the frequency poly of the model 1 residuals. Furthermore, model 2 has a lower residual-sum-of-squares which indicates less variance and a better fit of the model to the data. Therefore, between the two models, model 2 is the model that best fits the data.
```


## Section 23.5: Missing Values
```{r }
df <- tribble(
  ~x, ~y,
  1, 2.2,
  2, NA,
  3, 3.5,
  4, 8.3,
  NA, 10
)

mod <- lm(y ~ x, data = df)
```


```{r }
# Exclude warning of dropping missing values
mod <- lm(y ~ x, data = df, na.action = na.exclude)

```

```{r}
# nobs(): How many observations were used in the model.
nobs(mod)
```


## Section 23.6: Other model families
```{r}
# Generalised linear models: stats::glm()
# Generalised additive models: mgcv::gam()
# Penalised linear models: glmnet::glmnet()
# Robust linear models: MASS::rlm()
# Trees: rpart::rpart()
# Random forests: randomForest::randomForest()
# Gradient Boosting Machines: xgboost::xgboost()
```


# Section 24: Model Building
## Section 24.1: Introduction
#### Section 24.1.1: Prerequisites
```{r}
if(!require("tidyverse")) install.packages("tidyverse")
if(!require("modelr")) install.packages("modelr")
if(!require("nycflights13")) install.packages("nycflights13")
if(!require("lubridate")) install.packages("lubridate")

library(tidyverse)
library(modelr)
options(na.action = na.warn)

library(nycflights13)
library(lubridate)
```


## Section 24.2: Why are low quality diamonds more expensive?
```{r}
# By looking at the prediction (price with respect to the weight) the residual reflects the differrence in price solely. Plotting against the color presents the adjusted price removing the bias of the price vs the weight.

ggplot(diamonds, aes(cut, price)) +
         geom_boxplot()
ggplot(diamonds, aes(color, price)) +
         geom_boxplot()
ggplot(diamonds, aes(clarity, price)) + 
         geom_boxplot()
```

```{r}
ggplot(diamonds, aes(carat, price)) +
  geom_hex(bins = 50)
```

```{r}
diamonds2 <- diamonds %>% filter(carat <= 2.5) %>% mutate(lprice = log2(price), lcarat = log2(carat))
diamonds2
```
```{r}
ggplot(diamonds2, aes(lcarat, lprice)) + 
  geom_hex(bins = 50)
```

```{r}
# create a linear model of the data. 
mod_diamond <- lm(lprice ~ lcarat, data = diamonds2)
```

```{r}
grid <- diamonds2 %>% 
  data_grid(carat = seq_range(carat,20)) %>%
  mutate(lcarat = log2(carat)) %>%
  add_predictions(mod_diamond, "lprice") %>%
  mutate(price = 2 ^ lprice)
ggplot(diamonds2, aes(carat, price)) + 
  geom_hex(bins = 50) + 
  geom_line(data = grid, aes(carat, price), color = "red")
```


```{r}
ggplot(diamonds2, aes(carat, price)) + 
  geom_hex(bins = 50) + 
  geom_line(data = grid, aes(carat, price), color = "red")
```

```{r}
# The pattern of the price with respect to the weight has been removed 
diamonds2 <- diamonds2 %>%
  add_residuals(mod_diamond, "lresid")

ggplot(diamonds2, aes(lcarat, lresid)) +
  geom_hex(bins = 50)
```
```{r}
# What are the residuals of the carat and price alone? This requires a model to create residuals. The model would not be linear based on the data. 
mod_diamond_no_log <- lm(price ~ carat, data = diamonds2)
diamonds2 <- diamonds2 %>% add_residuals(mod_diamond_no_log, "resid")

ggplot(diamonds2, aes(carat, resid)) +
  geom_hex(bins = 50)
# Notice that the residuals are heteroscedastic. The model is a poor fit to the data. Take the transformation of the data. 
```

```{r}
library(EnvStats)

# This is the boxcox analysis of the model created without log transformations. The optimal value of lambda is 1.127617 which indicates the data should be squared.
boxcox.list <- boxcox(mod_diamond_no_log, optimize = TRUE)
boxcox.list
plot(boxcox.list, plot.type = "Q-Q Plot", same.window = FALSE)
```


```{r}
mod_diamond_transformed <- lm(((price) ^2 ~ ((carat) ^2)), data = diamonds2)
boxcox.list <- boxcox(mod_diamond_transformed, optimize = TRUE) # Lambda is much closer to zero. 
boxcox.list
plot(boxcox.list, plot.type = "Q-Q Plot", same.window = FALSE) # The residuals show a better fit of the model to the data.
```

```{r}
mod_diamonds_log_transformation <- lm(log2(price) ~ log2(carat), data = diamonds)
(mod_diamonds_log_transformation)
```


```{r}
# This is the boxcox plot of the ideal transformation.
# boxcox.list <- boxcox(mod_diamond, optimize = TRUE)
boxcox.list <- boxcox(mod_diamonds_log_transformation, optimize = TRUE)
boxcox.list
plot(boxcox.list, plot.type = "Q-Q Plot", same.window = FALSE)
```
```{r}
# Transformation with an optimal value of lambda. This is not the ideal transformation in reality. 
lambda <- 1.127617
diamonds_optimal <- diamonds %>% filter(carat == 2.5) %>% mutate(pprice = (price ^ lambda), pcarat = (price ^ lambda))
```


```{r}
mod_diamond_optimal_lamda_transformation <- lm(pprice ~ pcarat, data = diamonds_optimal)
boxcox.list <- boxcox(mod_diamond_optimal_lamda_transformation, optimize = TRUE)
boxcox.list
plot(boxcox.list, plot.type = "Q-Q Plot", same.window = FALSE)
```
```{r}
# After creating four different models and examining the plot of the residuals with a critical eye, the model with the plot of the best residuals is the model comprising the log transformed price with respect to the log transformed carat. 
```


```{r}
ggplot(diamonds2, aes(lcarat, lprice)) + 
  geom_hex(bins = 50)
```

```{r}
# After transforming the carat and price variables in alignment with the suggested transformation, This is clearly the incorrect graph. The distribution is still exponential, not linear. 
# names(diamonds3)
# ggplot(diamonds3, aes((carat^2), (price^2))) +
#   geom_hex(bins = 50)
```

```{r}
# This is the ideal transformation of the variables "carat" & "price. The relationship is linear. This linear relationship is now suitable for use with a linear model. As shown above. 
names(diamonds2)
ggplot(diamonds2, aes(log2(carat), log(price))) +
  geom_hex(bins = 50)
```
```{r}
# Returning lresid back to its original log transformation.
diamonds2 <- diamonds2 %>%
  add_residuals(mod_diamond, "lresid")
```


```{r}

# Recreating the motivating plots of the cut, color, and clarity with respect to the residual of the price with respect to the predicted price with respect to the carat

ggplot(diamonds2, aes(cut, lresid))+
  geom_boxplot()

ggplot(diamonds2, aes(color, lresid)) + 
  geom_boxplot()

ggplot(diamonds2, aes(clarity, lresid)) + 
  geom_boxplot()

# The confounding variable of carat has been removed. The plots below allow the diamonds to be compared by price without considering the factor of the weight of the diamond. Ideal cuts have the highest price. "G" color diamonds have the highest price. "IF" clarity have the highest price. 
```
```{r}
mod_diamond2 <- lm(lprice ~ lcarat + color + cut + clarity, data = diamonds2)
summary(mod_diamond2)
```

```{r}
diamonds2
```


```{r}
# Data grid includes variables from .model such that predictions can be created implementing all variables of the model. The most common values are chosen if the variables are categorical and the median is chosen if the variables are continuous.
grid <- diamonds2 %>%
  data_grid(cut, .model = mod_diamond2) %>%
  add_predictions(mod_diamond2)
```

```{r}
grid
```


```{r}
grid <- diamonds2 %>%
  data_grid(cut, .model = mod_diamond2) %>%
  add_predictions(mod_diamond2)

ggplot(grid, aes(cut, pred)) + 
  geom_point()
```
```{r}
diamonds2 <- diamonds2 %>% add_residuals(mod_diamond2, "lresid2")

ggplot(diamonds2, aes(lcarat, lresid2)) + 
  geom_hex(bins = 50)
```


```{r}
# Examining unique values
diamonds2 %>% filter(abs(lresid2) > 1) %>%
  add_predictions(mod_diamond2) %>%
  mutate(pred = round(2 ^ pred)) %>%
  select(price, pred, carat:table, x:z) %>%
  arrange(price)
```
#### Section 24.2.3: Exercises
```{r}
# Question 1
# In plot of lcarat vs. lprice, the bright vertical strips represent a greater number of diamonds present at that combination of lcarat and lprice.
```

```{r}
# Quesion 2
# log(price) = a_0 + a_1 * log(carat) is a linear relationship.
```

```{r}
filtered_diamonds2 <- diamonds2 %>% filter((lresid2 > 1) | (lresid2 < -1)) %>% select(lresid2, everything())
(filtered_diamonds2)
```

```{r}
# Comparison of Cuts
count_filtered_diamonds2 <- filtered_diamonds2 %>% count(cut)
grouped_filtered_diamonds2 <- filtered_diamonds2 %>% group_by(cut) %>% summarise(median(price))

# diamonds2

diamonds2_without_extreme_lresid2 <- anti_join(diamonds2, filtered_diamonds2, by = "lresid2")
# (diamonds2_without_extreme_lresid2)

grouped_diamonds2_without_extreme_lresid2 <- diamonds2_without_extreme_lresid2 %>% group_by(cut) %>% summarise(median(price))
grouped_diamonds2_without_extreme_lresid2 <- semi_join(grouped_diamonds2_without_extreme_lresid2, filtered_diamonds2)

count_filtered_diamonds2 <- count_filtered_diamonds2 %>% rename(count_n = 'n')
grouped_filtered_diamonds2 <- grouped_filtered_diamonds2 %>% rename(outlier_median_price = `median(price)`)
grouped_diamonds2_without_extreme_lresid2 <- grouped_diamonds2_without_extreme_lresid2 %>% rename(original_median_price = `median(price)`)

cut_comparison <- left_join(count_filtered_diamonds2, grouped_filtered_diamonds2, by = 'cut')
cut_comparison <- left_join(cut_comparison, grouped_diamonds2_without_extreme_lresid2, by = 'cut')
(cut_comparison)

# (count_filtered_diamonds2)
# (grouped_filtered_diamonds2)
# (grouped_diamonds2_without_extreme_lresid2)

# The price with respect to the cut has a median price that is half the median price of normal diamonds of the same cut. There are 10 diamonds with this cut with low prices.
```


```{r}
# Examine price with respect to color 
count_filtered_diamonds2 <- filtered_diamonds2 %>% count(color)
grouped_color_filtered_diamonds2 <- filtered_diamonds2 %>% group_by(color) %>% summarise(median(price))
grouped_color_diamonds2_without_extreme_lresid2 <- diamonds2_without_extreme_lresid2 %>% group_by(color) %>% summarise(median(price))

grouped_color_diamonds2_without_extreme_lresid2 <- semi_join(grouped_color_diamonds2_without_extreme_lresid2, filtered_diamonds2)

# (count_filtered_diamonds2)
# (grouped_color_filtered_diamonds2)
# (grouped_color_diamonds2_without_extreme_lresid2)

count_filtered_diamonds2 <- count_filtered_diamonds2 %>% rename(count_n = 'n')
grouped_color_filtered_diamonds2 <- grouped_color_filtered_diamonds2 %>% rename(outlier_median_price = `median(price)`)
grouped_color_diamonds2_without_extreme_lresid2 <- grouped_color_diamonds2_without_extreme_lresid2 %>% rename(original_median_price = `median(price)`)

color_comparison <- left_join(count_filtered_diamonds2, grouped_color_filtered_diamonds2, by = 'color')
color_comparison <- left_join(color_comparison, grouped_color_diamonds2_without_extreme_lresid2, by = 'color')
(color_comparison)

# Summary
# There are two D color diamonds, two E color diamonds, eight F color diamonds, and four G color diamonds with incorrect prices. There is approximately a three times markup in price when compared to typical D color diamonds. 

# There is a markup in the median price by a factor of two for E color diamonds.

# There is a markup in the median price of F color diamonds by approximately a quarter. 

# There is a markdown in price for G color diamonds by approximately two-thirds the price.  

```

```{r}
# Examine price with respect to clarity 
count_filtered_diamonds2 <- filtered_diamonds2 %>% count(clarity)
summary_filtered_diamonds2 <- filtered_diamonds2 %>% group_by(clarity) %>% summarise(median(price))
grouped_diamonds2_without_extreme_lresid2 <- diamonds2_without_extreme_lresid2 %>% group_by(clarity) %>% summarise(median(price))
grouped_diamonds2_without_extreme_lresid2 <- semi_join(grouped_diamonds2_without_extreme_lresid2, filtered_diamonds2)

# (count_filtered_diamonds2)
# (summary_filtered_diamonds2)
# (grouped_diamonds2_without_extreme_lresid2)

count_filtered_diamonds2 <- count_filtered_diamonds2 %>% rename(count_n = 'n')
summary_filtered_diamonds2 <- summary_filtered_diamonds2 %>% rename(outlier_median_price = `median(price)`)
grouped_diamonds2_without_extreme_lresid2 <- grouped_diamonds2_without_extreme_lresid2 %>% rename(original_median_price = `median(price)`)

clarity_comparison <- left_join(count_filtered_diamonds2, summary_filtered_diamonds2, by = 'clarity')
clarity_comparison <- left_join(clarity_comparison, grouped_diamonds2_without_extreme_lresid2, by = 'clarity')
(clarity_comparison)

# All clarities I1, SI2, SI1, & VS2 are significantly marked down. 
# Clarity VVS2 has a markup median price of over double. 
```

```{r}
# Clarity, color, & cut comparison
(clarity_comparison)
(color_comparison)
(cut_comparison)
```



```{r}
# Summary: Overpriced
# Fair F VVS2
(filtered_diamonds2)
# filtered_diamonds2 %>% filter(cut == "Fair", color == "F") %>% select(everything()) %>% arrange(color, clarity) 

fair_f_vvs2 <- filtered_diamonds2 %>% filter(cut == "Fair", color == "F", clarity == 'VVS2') %>% select(everything()) %>% arrange(color, clarity) # These diamonds are high clarity and good color but poor cuts (VVS2, F, Fair) There is a markup on the clarity; There is a markup on diamonds with color F, cut of Fair, and clarity of VVS2. The median price is much higher than the price of diamonds with fair cuts, and the median prices for diamonds with the same clarity and color are typically much lower.  Furthermore, the same type of diamond at a similar carat is significantly cheaper. 

(fair_f_vvs2 %>% select(price, everything()))

diamonds2 %>% filter(cut == "Fair", color == "F", clarity == "VVS2") %>% group_by(carat) %>% arrange(price) %>% select(price, carat, everything())
```


```{r}
reduced_filtered_diamonds2 <- anti_join(filtered_diamonds2, fair_f_vvs2)
(reduced_filtered_diamonds2)

```
```{r}
# Summary: Overpriced
premium_g_si2 <- reduced_filtered_diamonds2 %>% filter(cut == "Premium", color == "G", clarity == "SI2") %>% select(price, everything()) %>% arrange(color, clarity)
diamonds2 %>% filter(cut == "Premium", color == "G", clarity == "SI2") %>% group_by(carat) %>% arrange(price) %>% select(price, carat, everything())
# There is a markdown in price of diamonds with cuts of Premium, color of G, and clarity of SI2 with respect to the median price. However, there is a significant markup in price for diamonds of a similar carat and same cut, color, and clarity. These diamonds are overpriced. 

```

```{r}

reduced_filtered_diamonds2 <- anti_join(reduced_filtered_diamonds2, premium_g_si2)
(reduced_filtered_diamonds2)

```

```{r}
reduced_filtered_diamonds2 %>% filter(cut == "Premium")
```


```{r}
# Summary: Overpriced
# Premium F SI1
premium_f_si1 <- reduced_filtered_diamonds2 %>% filter(cut == "Premium", color == "F", clarity == "SI1") %>% select(price, everything()) %>% arrange(color, clarity)
(premium_f_si1)

diamonds2 %>% filter(cut == "Premium", color == "F", clarity == "SI1") %>% filter(carat >= 0.50) %>% group_by(carat) %>% arrange(price) %>% select(price, carat, everything())
# The markup for this diamond is significantly higher than a diamond of the comparable carat, cut, color, and clarity.  The diamonds will start at prices of $1063 for the same carat, cut, color, and clarity and increase in price along with the carat. At the same price, there are diamonds available that are 0.31 carat greater in value. 
```

```{r}
reduced_filtered_diamonds2 <- anti_join(reduced_filtered_diamonds2, premium_f_si1)
```



```{r}
(reduced_filtered_diamonds2) 
```



```{r}
# Summary: Underpriced
# Premium E SI2

premium_E_si2 <- reduced_filtered_diamonds2 %>% filter(cut == "Premium", color == "E", clarity == "SI2") %>% select(price, everything()) %>% arrange(color, clarity)
(premium_E_si2)

diamonds2 %>% filter(cut == "Premium", color == "E", clarity == "SI2") %>% filter(carat >= 0) %>% group_by(carat) %>% arrange(price) %>% select(price, carat, everything())

# This diamond is underpriced. Diamonds of the same color, clarity, and cut increase in price from 12,987 to 18,477 from carats that have an approximate weight of 2.0. This diamond is priced with diamonds that are approximately 1.5 carats, but is greater by nearly a carat. This is a great deal. 
```
```{r}
reduced_filtered_diamonds2 <- anti_join(reduced_filtered_diamonds2, premium_E_si2)
```

```{r}
reduced_filtered_diamonds2
```

```{r}
# Clarity, color, & cut comparison
(clarity_comparison)
(color_comparison)
(cut_comparison)
```

```{r}
# Quesion 3
# Answer

# These diamonds vary by price. Diamonds in this set of diamonds are incorrectly priced. There exists at least one diamond in this set that is underpiced and more than a few diamonds that are overpriced in this set of outliers. I believe these are pricing errors. 

```

```{r}
# mod_diamond2
# create a linear model of the data. 
# mod_diamond <- lm(lprice ~ lcarat, data = diamonds2)

# diamonds2 <- diamonds2 %>% add_residuals(mod_diamond2, "lresid2")

diamonds2
mod_diamond2


```

```{r}
diamonds2 %>% select("lresid2", everything())
```


```{r}
mod_diamond2
```

```{r}

# # diamonds2$lcarat
# # plot_diamonds2
# diamonds2 <- diamonds2 %>% add_predictions(mod_diamond2, "lprice2")
# diamonds2 %>% select(lprice, lprice2, lcarat, everything())
# plot_diamonds2 <- diamonds2 %>% select(lprice2, carat)
# plot_diamonds2
```
```{r}
# # plot_diamonds2$lprice2
# 
# diamonds2
```


```{r}
# (plot_diamonds2)
```


```{r}
# grid2 <- diamonds2 %>% 
#   data_grid(carat = seq_range(carat,20)) %>%
#   mutate(lcarat = log2(carat)) %>%
#   add_predictions(mod_diamond2, "lprice2")
# # %>%
#   # mutate(price = 2 ^ lprice2)

```

```{r}
# ggplot(diamonds2, aes(carat, price)) + 
#   geom_hex(bins = 50) 
#   geom_line(data = grid, aes(carat, price), color = "red")

```

```{r}

```


```{r}
# Quesion 4
# Does the final model do a good job of predicting diamond prices? 
# Would you trust it to tell you how much to spend if you were buying a diamond?

# Comparison of AIC
cat("Model 2 AIC:")
AIC(mod_diamond2)
cat("Model 1 AIC:")
AIC(mod_diamond)


# Model 2
grid <- diamonds2 %>%
  data_grid(cut, .model = mod_diamond2) %>%
  add_predictions(mod_diamond2)

ggplot(grid, aes(cut, pred)) + 
  geom_point()

grid <- diamonds2 %>%
  data_grid(color, .model = mod_diamond2) %>%
  add_predictions(mod_diamond2)

ggplot(grid, aes(color, pred)) + 
  geom_point()

grid <- diamonds2 %>%
  data_grid(clarity, .model = mod_diamond2) %>%
  add_predictions(mod_diamond2)

ggplot(grid, aes(clarity, pred)) + 
  geom_point()

diamonds2 <- diamonds2 %>% add_residuals(mod_diamond2, "lresid2")

ggplot(diamonds2, aes(lcarat, lresid2)) + 
  geom_hex(bins = 50)

# The residuals of model 2 are a better fit to the data. The residuals of model 2 have less variance from zero. The AIC score of model 2 is lower than that of model 1. There is no heteroscedasticity in model 2. The predictions are in alignment with the expectations of the price with respect to the order of the variables within cut, color, and clarity when compared to the ordering of the same variables with respect to residuals in model 1. Because of this alignment, it is safe to infer that the predictions explain the variables contained within cut, color, and clarity appropriately with respect to real-world expectations. After comparing Model 1 and Model 2 (given that model 1 makes accurate predictions based on the data) I trust model 2 to make accurate predictions knowing that model 2 is a better fit to the data, incorporates more variables, and makes representations of those variables that are in alignment with real world expectations.
```

```{r}
# Model 1
diamonds2 <- diamonds2 %>%
  add_residuals(mod_diamond, "lresid")

ggplot(diamonds2, aes(lcarat, lresid)) +
  geom_hex(bins = 50)

ggplot(diamonds2, aes(cut, lresid))+
  geom_boxplot()

ggplot(diamonds2, aes(color, lresid)) + 
  geom_boxplot()

ggplot(diamonds2, aes(clarity, lresid)) + 
  geom_boxplot()

grid <- diamonds2 %>% 
  data_grid(carat = seq_range(carat,20)) %>%
  mutate(lcarat = log2(carat)) %>%
  add_predictions(mod_diamond, "lprice") %>%
  mutate(price = 2 ^ lprice)
ggplot(diamonds2, aes(carat, price)) + 
  geom_hex(bins = 50) + 
  geom_line(data = grid, aes(carat, price), color = "red")
```


## Section 24.3: What affects the number of daily flights?
```{r}
daily <- flights %>%
  mutate(date = make_date(year, month, day)) %>%
  group_by(date) %>%
  summarise(n = n())

```

```{r}
ggplot(daily, aes(date, n)) + 
  geom_line()
```

#### Section 24.3.1: Day of the week
```{r}
daily <- daily %>%
  mutate(wday = wday(date, label = TRUE))
ggplot(daily, aes(wday, n)) + 
  geom_boxplot()
```


```{r}
mod <- lm(n ~ wday, data = daily)

grid <- daily %>%
  data_grid(wday) %>%
  add_predictions(mod, "n")

ggplot(daily, aes(wday, n)) + 
  geom_boxplot() +
  geom_point(data = grid, color = "red", size = 4)
```

```{r}
daily <- daily %>%
  add_residuals(mod)
daily %>%
  ggplot(aes(date, resid)) + 
  geom_ref_line(h = 0) + 
  geom_line()
```

```{r}
ggplot(daily, aes(date, resid, color = fct_reorder2(wday,date, resid))) + 
  geom_ref_line(h = 0) + 
  geom_line() +
  labs(color = "Weekday")
```

```{r}
daily %>% filter(resid < -100)
```

```{r}
daily %>% ggplot(aes(date, resid)) + 
  geom_ref_line(h = 0) + 
  geom_line(color = "grey50") + 
  geom_smooth(se = FALSE, span = 0.20)

```

```{r}
daily %>%
  filter(wday == "Sat") %>%
  ggplot(aes(date, n)) + 
  geom_point() + 
  geom_line() + 
  scale_x_date(NULL, date_breaks = "1 month", date_labels = "%b")
```


```{r}
daily %>% select(date)
```


```{r}
term <- function(date) {
  cut(date,
      breaks = ymd(20130101, 20130605,20130825, 20140101), 
      labels = c("spring", "summer", "fall"))
}

daily <- daily %>%
  mutate(term = term(date))

daily %>%
  filter(wday == "Sat") %>%
  ggplot(aes(date, n, color = term)) +
  geom_point(alpha = 1/3) +
  geom_line() +
  scale_x_date(NULL, date_breaks = "1 month", date_labels = "%b")
```


```{r}
daily %>% 
  ggplot(aes(wday, n, color = term)) +
  geom_boxplot()
```




```{r}
mod1 <- lm(n ~ wday, data = daily) 
mod2 <- lm(n ~ wday * term, data = daily)

daily %>%
  gather_residuals(without_term = mod1, with_term = mod2) %>%
  ggplot(aes(date, resid, color = model)) + 
  geom_line(alpha = 0.75)
```

```{r}
grid
```



```{r}
grid <- daily %>%
  data_grid(wday, term) %>%
  add_predictions(mod2, "n")

ggplot(daily, aes(wday, n)) +
  geom_boxplot() + 
  geom_point(data = grid, color = "red") + 
  facet_wrap(~ term)
```


```{r}

# rlm reduces the impact of outliers on the predictions
mod3 <- MASS::rlm(n ~ wday * term, data = daily)

daily %>%
  add_residuals(mod3, "resid") %>%
  ggplot(aes(date, resid)) + 
  geom_hline(yintercept = 0, size = 2, color = "white") +
  geom_line()
```

#### Section 24.3.3: Computed Variables
```{r}
compute_vars <- function(data) {
  data %>%
    mutate(
      term = term(date),
      wday = wday(date, label = TRUE)
    )
}

wday2 <- function(x) wday(x, label = TRUE)
mod3 <- lm(n ~ wday2(date) * term(date), data = daily)
```

```{r}
# Using a non-linear model to fit to the data
library(splines)
mod <- MASS::rlm(n ~ wday * ns(date, 5), data = daily)

daily %>%
  data_grid(wday, date = seq_range(date, n = 13)) %>%
  add_predictions(mod) %>%
  ggplot(aes(date, pred, color = fct_reorder2(wday, date, pred))) + 
  geom_line() + 
  geom_point() + 
  labs(color = "Weekday", title = "Predicted flights from NYC by day of week over the course of the year")
```

```{r}
(daily)
```


#### Section 24.3.5: Exercises
```{r}
# Question 1
# jan 20, may 26, sept 1st

# On the days of January 20th 2013, May 26th 2013, and September 1st 2013 There were windspeeds that peaked at 39mph, 30mph, and 16 mph at the hottest times of the days which include 54, 66, and 84 degrees respectively. According to the National Weather Service, these wind speeds are categorized as moderate, low, and very low threat to life and property from High Wind. According to skyscanner.com, crosswinds at about 34 - 40 mph are generally prohibitive of take-off and landing. Tropical Storms are categorized by the Saffir-Simpson scale to hvae 39-73 mph winds and form in warm weather. I believe the evidence suggests that on these days preventative measures were taken to prevent takeoffs and landings during strong crosswinds and possible tropical storms. These conditions can generalize to another year by categorizing the wind speeds and temperature and factoring these variables into further models. 


```

```{r}
# Quesion 2
# What do the three days with high positive residuals represent? How would these days generalise to another year?

# These are days when the actual number of flights were much greater than the predicted number of flights. These flights appear to be seasonal given that they are during the same Thanksgiving and Christmas season. I believe these flights are return trips from Thanksgiving and Christmas. These could be generalised by creating a term that includes the period after Thanksgiving and the period after Christmas in order to break the dates into terms that include spring, summer, fall, Thanksgiving, and Christmas before fitting a model.

daily %>%
  slice_max(n = 3, resid)

```



```{r}
# Quesion 3
# Split the wday variable into terms but only for Saturdays. Include Thurs, Fri, Sat-summer, Sat-spring, Sat-fall.
# How does this model compare with the model with every combination of wday and term?
# 
# Term for Sun, Mon, Tues, Wed, Thurs, Friday, Saturday

# term <- function(date) {
#   cut(date,
#       breaks = ymd(20130101, 20130605,20130825, 20140101), 
#       labels = c("spring", "summer", "fall"))
# }
# 
# daily <- daily %>%
#   mutate(term = term(date))
# 
# daily %>%
#   filter(wday == "Sat") %>%
#   ggplot(aes(date, n, color = term)) +
#   geom_point(alpha = 1/3) +
#   geom_line() +
#   scale_x_date(NULL, date_breaks = "1 month", date_labels = "%b")
```

```{r}
# Question 3.1
# ymd(20130101, 20130605,20130825, 20140101)

# Sun: 1
# Mon: 2
# Tue: 3
# Wed: 4
# Thur:5
# Fri: 6
# Sat: 7

daily
offset_week_number = 0
day_of_week_number = 1
daily[["date"]][[offset_week_number + day_of_week_number]]
daily[["wday"]][[offset_week_number + day_of_week_number]]
wday(daily[["date"]][[offset_week_number + day_of_week_number]])

# breaks = ymd(20130101, 20130605,20130825, 20140101), 
# wday(daily[["date"]])
 
wterm <- function(date) {
  cut(wday(date),
      breaks = c(0,1,2,3,4,5,6,7),
      labels = c("Sun", "Mon", "Tues", "Wed", "Thurs", "Fri", "Sat")
  )
}

daily_wterm <- daily %>% mutate(wterm = wterm(date))
```


```{r}
# Question 3.1



daily_wterm_Sat_spring <- daily_wterm %>% filter(wterm == "Sat") %>% filter(term == "spring") %>% mutate(wterm = "Sat-spring")
daily_wterm_Sat_summer <- daily_wterm %>% filter(wterm == "Sat") %>% filter(term == "summer") %>% mutate(wterm = "Sat-summer")
daily_wterm_Sat_fall <- daily_wterm %>% filter(wterm == "Sat") %>% filter(term == "fall") %>% mutate(wterm = "Sat-fall")
daily_wterm_not_Sat <- daily_wterm %>% filter(wterm != "Sat")

# (daily_wterm_not_Sat)
# (daily_wterm_Sat_spring)
# (daily_wterm_Sat_summer)
# (daily_wterm_Sat_fall)

daily_wterm_final <- add_row(daily_wterm_not_Sat, daily_wterm_Sat_spring)
daily_wterm_final <- daily_wterm_final %>% arrange(date)

daily_wterm_final <- add_row(daily_wterm_final, daily_wterm_Sat_summer)
daily_wterm_final <- daily_wterm_final %>% arrange(date)

daily_wterm_final <- add_row(daily_wterm_final, daily_wterm_Sat_fall)
daily_wterm_final <- daily_wterm_final %>% arrange(date)

(daily_wterm_final)

```

```{r}
# daily_wterm_final %>% mutate(wterm_numeric = as.numeric(as.factor(wterm))) %>% group_by(wterm_numeric) %>% summarise()
daily_wterm_final %>% mutate(wterm_numeric = as.numeric(as.factor(wterm)))

```

```{r}
# daily_wterm_final %>% add_residuals(mod4) %>%
#   ggplot(aes(date, resid)) + 
#   geom_line(alpha = 0.75)
```


```{r}
# These are not residuals are not correct. The predictions are the default predictions that are are added from daily_wterm_final based upon a change in date and a constant in wterm. Hence they are all the same. 


# # Comparing model 2: mod2 <- lm(n ~ wday * term, data = daily)
# Comparing model 4: mod4 <- lm(n ~ as.numeric(as.factor(wterm)), data = daily_wterm_final)

# daily_wterm_final 
# 
# daily_wterm_final %>%
#   data_grid(wterm, date = seq_range(date, n = 13)) %>%
#   add_predictions(mod4)
# 
# daily_wterm_final %>%
#   data_grid(wterm, date = seq_range(date, n = 13)) %>%
#   add_predictions(mod4) %>%
#   ggplot(aes(date, pred, color = fct_reorder2(wterm, date, pred))) +
#   geom_line() +
#   geom_point()
```


```{r}
# daily %>%
#   gather_residuals(without_term = mod1, with_term = mod2, with_new_term = mod4) %>%
#   ggplot(aes(date, resid, color = model)) + 
#   geom_line(alpha = 0.75)

# daily %>%
#   data_grid(term, date = seq_range(date, n = 13)) %>%
#   add_predictions(mod3) %>%
#   ggplot(aes(date, pred, color = fct_reorder2(term, date, pred))) +
#   geom_line() +
#   geom_point()

# mod4 <- lm(n ~ wday2(date) * as.numeric(as.factor(wterm)), data = daily_wterm_final)
```


```{r}
daily_wterm_final
```





```{r}
mod1 <- lm(n ~ wday, data = daily) 
mod2 <- lm(n ~ wday * term, data = daily)
# mod4 <- lm(n ~ wday * as.numeric(as.factor(wterm)), data = daily_wterm_final)
mod4 <- lm(n ~ wterm, data = daily_wterm_final)

daily %>%
  gather_residuals(without_term = mod1, with_term = mod2) %>%
  ggplot(aes(date, resid, color = model)) + 
  geom_line(alpha = 0.75)

daily_gather_residuals <- daily %>%
  gather_residuals(without_term = mod1, with_term = mod2) %>% filter(model == "with_term")
(daily_gather_residuals)


daily_wterm_final_mod4_pred_resid <- daily_wterm_final %>% add_predictions(mod4, "n_pred") %>% add_residuals(mod4) %>% select(date, n, n_pred, resid, everything())
(daily_wterm_final_mod4_pred_resid)

ggplot() + 
  geom_jitter(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid), color = "darkblue") + 
  geom_line(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid), color = "darkblue") +
  geom_jitter(aes(daily_gather_residuals$date, daily_gather_residuals$resid), color = "red") + 
  geom_line(aes(daily_gather_residuals$date, daily_gather_residuals$resid), color = "red") 

ggplot() +
  geom_jitter(aes(daily_gather_residuals$date, daily_gather_residuals$resid), color = "red") +
  geom_line(aes(daily_gather_residuals$date, daily_gather_residuals$resid), color = "red")

ggplot() + 
  geom_jitter(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid), color = "darkblue") + 
  geom_line(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid), color = "darkblue") 




# Summary: I had anticipated that creating a model where the Saturdays where separated into Sat-spring, Sat-summer, & Sat-fall would have grouped the residuals tighter about zero based upon the trend of the residuals varying less in model 2 when a term was added to the weekday versus the lone model predicting the count based upon the weekday alone. However, after successfully creating an appropriate naming scheme where each date corresponds to a day of the week and each Saturday corresponds to every combination of Saturday and term (spring, summer, & fall), the residuals are greater in amplitude from zero than that in model 2 about the periods following July and January. However, there is a tighter grouping of residuals that cluster closer in amplitude to zero from the periods prior to April to approximately June and from approximately September to the end of the 2013 year. Significant outliers still remain in the residuals of both model 2 and model 4, however.
```

```{r}
# Question 4.1
public_holidays_labels <- c("New Year's Day", "Martin Luther King Jr. Day", "President's Day", "Memorial Day", "Independence Day", "Labor Day", "Columbus Day", "Veterans Day", "Thanksgiving Day", "Christmas Day")
public_holidays <- c("2013-01-01", "2013-01-21", "2013-02-18", "2013-05-27", "2013-07-04", "2013-09-02", "2013-10-14", "2013-11-11", "2013-11-28", "2013-12-25")
daily_wterm_final[1,]


mutate_public_holidays <- function(data, public_holidays, public_holidays_labels) {
  
  return_data = tibble(data[1,])
  for (holiday in seq_along(public_holidays)) {
    
    # cat(public_holidays[[holiday]])
    # cat("\n")
    # cat(public_holidays_labels[[holiday]])
    # cat("\n")
    
    # print( data %>% filter(date %in% public_holidays) %>% filter(date == public_holidays[[holiday]]) %>% mutate(wterm = public_holidays_labels[[holiday]]))
    
    return_data <- add_row(return_data, data %>% filter(date %in% public_holidays) %>% filter(date == public_holidays[[holiday]]) %>% mutate(wterm = public_holidays_labels[[holiday]]))
    if (near(holiday, 1)){
      return_data <- anti_join(return_data, data[1,])  
    }
    # print(return_data[holiday,])
    data <- anti_join(data, return_data[holiday, ], by = "date")
    data <- add_row(data, return_data[holiday,])
    data <- data %>% arrange(date)
    
    # print(return_data)
    
    
    # data <- data %>% filter(date %in% public_holidays) %>% filter(date == public_holidays[[holiday]] %>% mutate(wterm = public_holidays_labels[[holiday]]))
  }
  # print(anti_join(daily_wterm_final, return_data, by = "date"))
  
  # daily_wterm_final_drop_public_holidays <- anti_join(daily_wterm_final, return_data, by = "date")
    
    # print(semi_join(daily_wterm_final_drop_public_holidays, return_data))
  print(return_data)
  return(data)
}

# daily_wterm_final %>% filter( date %in% public_holidays) %>% filter(date == public_holidays[[1]]) %>% mutate(wterm = public_holidays_labels[[1]])

daily_wterm_public_holidays_final <- mutate_public_holidays(daily_wterm_final, public_holidays, public_holidays_labels)


daily_wterm_public_holidays_final %>% filter( date %in% public_holidays)
(daily_wterm_public_holidays_final)
```

```{r}
# Question 4.2
mod1 <- lm(n ~ wday, data = daily) 
mod2 <- lm(n ~ wday * term, data = daily)
# mod4 <- lm(n ~ wday * as.numeric(as.factor(wterm)), data = daily_wterm_final)
mod4 <- lm(n ~ wterm, data = daily_wterm_final)
mod5 <- lm(n ~ wterm, data = daily_wterm_public_holidays_final)

# daily %>%
#   gather_residuals(without_term = mod1, with_term = mod2) %>%
#   ggplot(aes(date, resid, color = model)) + 
#   geom_line(alpha = 0.75)

daily_gather_residuals <- daily %>%
  gather_residuals(without_term = mod1, with_term = mod2) %>% filter(model == "with_term")
(daily_gather_residuals)

daily_wterm_final_mod4_pred_resid <- daily_wterm_final %>% add_predictions(mod4, "n_pred") %>% add_residuals(mod4) %>% select(date, n, n_pred, resid, everything())
(daily_wterm_final_mod4_pred_resid)

daily_wterm_public_holidays_final_mod5_pred_resid <- daily_wterm_public_holidays_final %>% add_predictions(mod5, "n_pred") %>% add_residuals(mod5) %>% select(date, n, n_pred, resid, everything())

alpha_level = 1
jitter_level = 2

ggplot() + 
  geom_jitter(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid, alpha = alpha_level), color = "darkblue", width = jitter_level, show.legend = FALSE) + 
  geom_line(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid, alpha = alpha_level), color = "darkblue", show.legend = FALSE) +
  geom_jitter(aes(daily_gather_residuals$date, daily_gather_residuals$resid), color = "red", alpha = alpha_level,  width = jitter_level, show.legend = FALSE) + 
  geom_line(aes(daily_gather_residuals$date, daily_gather_residuals$resid), color = "red", alpha = alpha_level, show.legend = FALSE) +
  geom_jitter(aes(daily_wterm_public_holidays_final_mod5_pred_resid$date, daily_wterm_public_holidays_final_mod5_pred_resid$resid, alpha = alpha_level), color = "darkgreen",  width = jitter_level, show.legend = FALSE) +
  geom_line(aes(daily_wterm_public_holidays_final_mod5_pred_resid$date, daily_wterm_public_holidays_final_mod5_pred_resid$resid, alpha = alpha_level), color = "darkgreen", show.legend = FALSE) +
  labs(title = "A Collection of Model Residuals From Count of Daily NYC Flight Predictions", subtitle = "Models: 2, 4, & 5\nRespective Colors: Blue, Red, Green", x = "Date", y = "Residual", show.legend = FALSE)

ggplot() +
  geom_jitter(aes(daily_gather_residuals$date, daily_gather_residuals$resid), color = "red") +
  geom_line(aes(daily_gather_residuals$date, daily_gather_residuals$resid), color = "red") +
  labs(title = "Model 2 Residuals From Count of Daily NYC Flight Predictions", x = "Date", y = "Residual")

ggplot() + 
  geom_jitter(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid), color = "darkblue") + 
  geom_line(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid), color = "darkblue") +
  labs(title = "Model 4 Residuals From Count of Daily NYC Flight Predictions", x = "Date", y = "Residual")

ggplot() +
  geom_jitter(aes(daily_wterm_public_holidays_final_mod5_pred_resid$date, daily_wterm_public_holidays_final_mod5_pred_resid$resid), color = "darkgreen") +
  geom_line(aes(daily_wterm_public_holidays_final_mod5_pred_resid$date, daily_wterm_public_holidays_final_mod5_pred_resid$resid), color = "darkgreen") +
  labs(title = "Model 5 Residuals From Count of Daily NYC Flight Predictions", x = "Date", y = "Residual")

```
```{r}
# Question 4.3
# Summary: The addition of public holidays reduced the residuals to zero during those public holidays in comparison to models 4 & 2 which don't include holidays or seasonal Saturdays respectively. The clustering of residuals, the amplitude of residuals, & the presence of significant outliers remains otherwise unchanged between models 4 & 5. Model 5 appears to be the strongest predictor of the number of daily nyc flights.
```

```{r}
# Quesion 5

daily
offset_week_number = 0
day_of_week_number = 200

daily[["date"]][[offset_week_number + day_of_week_number]]
# daily[["wday"]][[offset_week_number + day_of_week_number]]

month(daily[["date"]][[offset_week_number + day_of_week_number]])

```


```{r 5.1 }
wterm <- function(date) {
  cut(month(date),
      breaks = c(0,1,2,3,4,5,6,7,8,9,10,11,12),
      labels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
  )
}

daily_wterm_month <- daily %>% mutate(wterm = wterm(date))
(daily_wterm_month)
```


```{r 5.2}
mod6 <- lm(n ~ wday * wterm, data = daily_wterm_month)

daily_wterm_month_mod6_pred_resid <- daily_wterm_month %>% add_predictions(mod6, "n_pred") %>% add_residuals(mod6) %>% select(date, n, n_pred, resid, everything())
(daily_wterm_month_mod6_pred_resid)

alpha_level = 1
jitter_level = 2

ggplot() +
  geom_jitter(aes(daily_wterm_month_mod6_pred_resid$date, daily_wterm_month_mod6_pred_resid$resid), color = "gold") +
  geom_line(aes(daily_wterm_month_mod6_pred_resid$date, daily_wterm_month_mod6_pred_resid$resid), color = "gold") +
  labs(title = "Model 6 Residuals From Count of Daily NYC Flight Predictions", x = "Date", y = "Residual")

```
```{r 5.3}
ggplot() + 
  geom_jitter(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid, alpha = alpha_level), color = "darkblue", width = jitter_level, show.legend = FALSE) + 
  geom_line(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid, alpha = alpha_level), color = "darkblue", alpha = alpha_level, show.legend = FALSE) +
  geom_jitter(aes(daily_gather_residuals$date, daily_gather_residuals$resid, alpha = alpha_level), color = "red", width = jitter_level, show.legend = FALSE) + 
  geom_line(aes(daily_gather_residuals$date, daily_gather_residuals$resid, alpha = alpha_level), color = "red", show.legend = FALSE) +
  geom_jitter(aes(daily_wterm_public_holidays_final_mod5_pred_resid$date, daily_wterm_public_holidays_final_mod5_pred_resid$resid, alpha = alpha_level), color = "darkgreen",  width = jitter_level, show.legend = FALSE) +
  geom_line(aes(daily_wterm_public_holidays_final_mod5_pred_resid$date, daily_wterm_public_holidays_final_mod5_pred_resid$resid, alpha = alpha_level), color = "darkgreen", show.legend = FALSE) +
  geom_jitter(aes(daily_wterm_month_mod6_pred_resid$date, daily_wterm_month_mod6_pred_resid$resid, alpha = alpha_level), color = "gold", width = jitter_level, show.legend = FALSE) +
  geom_line(aes(daily_wterm_month_mod6_pred_resid$date, daily_wterm_month_mod6_pred_resid$resid, alpha = alpha_level), color = "gold", show.legend = FALSE) +
  labs(title = "Collection of Model Residuals From Count of Daily NYC Flight Predictions", subtitle = "Models: 2, 4, & 5\nRespective Colors: Blue, Red, Green", x = "Date", y = "Residual", show.legend = FALSE)

ggplot() +
  geom_jitter(aes(daily_gather_residuals$date, daily_gather_residuals$resid), color = "red") +
  geom_line(aes(daily_gather_residuals$date, daily_gather_residuals$resid), color = "red") +
  labs(title = "Model 2 Residuals From Count of Daily NYC Flight Predictions", x = "Date", y = "Residual")

ggplot() + 
  geom_jitter(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid), color = "darkblue") + 
  geom_line(aes(daily_wterm_final_mod4_pred_resid$date, daily_wterm_final_mod4_pred_resid$resid), color = "darkblue") +
  labs(title = "Model 4 Residuals From Count of Daily NYC Flight Predictions", x = "Date", y = "Residual")

ggplot() +
  geom_jitter(aes(daily_wterm_public_holidays_final_mod5_pred_resid$date, daily_wterm_public_holidays_final_mod5_pred_resid$resid), color = "darkgreen") +
  geom_line(aes(daily_wterm_public_holidays_final_mod5_pred_resid$date, daily_wterm_public_holidays_final_mod5_pred_resid$resid), color = "darkgreen") +
  labs(title = "Model 5 Residuals From Count of Daily NYC Flight Predictions", x = "Date", y = "Residual")

ggplot() +
  geom_jitter(aes(daily_wterm_month_mod6_pred_resid$date, daily_wterm_month_mod6_pred_resid$resid), color = "gold") +
  geom_line(aes(daily_wterm_month_mod6_pred_resid$date, daily_wterm_month_mod6_pred_resid$resid), color = "gold") +
  labs(title = "Model 6 Residuals From Count of Daily NYC Flight Predictions", x = "Date", y = "Residual")
```
```{r 5 Answer}
# It is not very helpful to fit a day of week effect that varies by month (i.e. n ~ wday * month) because the effect of the number of flights per month is already captured within the predictions based on the number of flights per weekday. This model has the tightest groupings with respect to the residuals. However, this indicates that the model is overfit to the data and will not generalize well to days beyond those that do not appear in the current dataset. 
```

```{r}
# Quesion 6
# What would you expect the model n ~ wday + ns(date, 5) to look like? Knowing what you know about the data, why would you expect it to be not particularly effective?
# I expect the model n ~ wday + ns(date, 5) to look like smooth polynomial lines separated by weekday with a 5th degree polynomial. I expect it not to be particularly effective because outside the bounds of the data, a Taylor Series polynomial will spread towards the limits of negative and positive infinity. This dillutes accurate predictions. Furthermore, this model does not take into account the effects of seasonality within the data nor trends that are present due to pubilc holidays which require prior domain knowledge to incorporate into the model.

mod7 <- lm(n ~ wday * ns(date, 5), data = daily)

daily %>%
  data_grid(wday, date = seq_range(date, n = 13)) %>%
  add_predictions(mod7) %>%
  ggplot(aes(date, pred, color = fct_reorder2(wday, date, pred))) + 
  geom_line() + 
  geom_point() + 
  labs(color = "Weekday", title = "Predicted flights from NYC by day of week over the course of the year")

```


```{r}
# Quesion 7
# We hypothesised that people leaving on Sundays are more likely to be business travellers who need to be somewhere on Monday. Explore that hypothesis by seeing how it breaks down based on distance and time: if it’s true, you’d expect to see more Sunday evening flights to places that are far away.

nycflights13::flights
```
```{r 7.1}
wday2 <- function(x) wday(x, label = TRUE)

daily_business <- nycflights13::flights
daily_business <- daily_business %>% mutate(date = make_date(year, month, day)) %>% select(date, everything())
# (daily_business)

daily_business <- daily_business %>% mutate(wday = wday2(date)) %>% select(date, wday, everything())

# daily_business <- daily_business %>% filter(wday == "Sun") %>% mutate(flight_id = row_number()) %>% select(flight_id, date, wday, flight, tailnum, distance, everything())

daily_business <- daily_business %>% select(date, wday, flight, tailnum, distance, everything())
daily_business %>% count(wday)
```

```{r 7.2}
daily_business[1,]
```




```{r 7.3}
daily_business_sun <- daily_business %>% filter(wday == "Sun")
daily_business_sun <- daily_business_sun %>% mutate(flight_id = row_number()) %>% select(flight_id, everything())
(daily_business_sun)
```


```{r 7.4}
# daily_business_mon
# daily_business_tues
# daily_business_wed
# daily_business_thurs
# daily_business_fri
# daily_business_sat



# ggplot(daily_business) +
#   geom_point(aes(date, distance)) + 
  # facet_wrap(~wday)

daily_business_flight_id <- daily_business %>% mutate(flight_id = row_number()) %>% select(flight_id, everything())
daily_business_thousand <- daily_business_flight_id %>% filter(flight_id <= 1000)

# (daily_business)
(daily_business_thousand)

```


```{r 7.5}
ggplot(daily_business_thousand) +
  geom_point(aes(flight_id, distance)) + 
  facet_wrap(~wday)
  
```


```{r 7.6}
weekday <- c("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")
weekday[[1]]
separate_wday_and_mutate_row_number <- function(flight_data, day) {
    current_day <- day
    return_flight_data <- flight_data %>% filter(wday == current_day) %>% mutate(flight_id = row_number()) %>% select(flight_id, everything())
    return(return_flight_data)
}
daily_business_sun <- separate_wday_and_mutate_row_number(daily_business, "Sun")
daily_business_mon <- separate_wday_and_mutate_row_number(daily_business, "Mon")
daily_business_tue <- separate_wday_and_mutate_row_number(daily_business, "Tue")
daily_business_wed <- separate_wday_and_mutate_row_number(daily_business, "Wed")
daily_business_thu <- separate_wday_and_mutate_row_number(daily_business, "Thu")
daily_business_fri <- separate_wday_and_mutate_row_number(daily_business, "Fri")
daily_business_sat <- separate_wday_and_mutate_row_number(daily_business, "Sat")

number_of_flights <- 100

daily_business_sun <- daily_business_sun %>% filter(flight_id < number_of_flights)
daily_business_mon <- daily_business_mon %>% filter(flight_id < number_of_flights)
daily_business_tue <- daily_business_tue %>% filter(flight_id < number_of_flights)
daily_business_wed <- daily_business_wed %>% filter(flight_id < number_of_flights)
daily_business_thu <- daily_business_thu %>% filter(flight_id < number_of_flights)
daily_business_fri <- daily_business_fri %>% filter(flight_id < number_of_flights)
daily_business_sat <- daily_business_sat %>% filter(flight_id < number_of_flights)

alpha_level = 0.6

ggplot() +
  geom_jitter(aes(daily_business_sun$flight_id, daily_business_sun$distance), color = "red") 



daily_business %>% group_by(wday) %>% summarise(mean(distance), count = n())
# The mean distance of flights on Sundays is 1056.966 miles with a count of 46,357 flights. Except for Saturday, the mean distance is greater with fewer flights than any other day of the week. This means that the flights on Sunday were traveling farther on average per flight. 
```


```{r}
# Examine the distance of Sunday Evening flights. 
daily_business_sun_hour <- daily_business %>% filter(wday == "Sun") %>% select(distance, hour, everything()) %>% arrange(hour)
daily_business_sun_hour_id <- daily_business_sun_hour %>% mutate(flight_id = row_number()) %>% select(flight_id, distance, hour, everything())
(daily_business_sun_hour)
```

```{r}
ggplot(daily_business_sun_hour_id) +
  geom_freqpoly(aes(distance))
```

```{r}
daily_business_sun_hour_distance_greater_than_1000 <- daily_business_sun_hour %>% filter(distance > 1000)
```

```{r}
# daily_business_sun_hour$flight_id
ggplot(daily_business_sun_hour_id) + 
  geom_point(aes(flight_id, distance)) + 
  facet_wrap(~hour)

ggplot(daily_business_sun_hour_id) +
  geom_freqpoly(aes(distance))

ggplot(daily_business_sun_hour_distance_greater_than_1000) + 
  geom_freqpoly(aes(hour), bins = 12)
```
```{r 7 Answer}
# From the facet-wrapped graph above, it is clear that there are high-distance flights during the hours of 9, 10, & 13 on Sundays during the year of 2013 from NYC.
# After closer inspection, their is a significant impulse in the number of flights for distances that are greater than 1000 miles. Considering flights that are greater than 1000 miles are long-distance flights, and upon examining the frequency of long-distance flights with respect to hour of the day, it is clear that there is a bi-modal distribution of flights with peaks before and after evening. I cannot suggest that the distribution is right-skewed, which would indicate that the majority of long-distance flights are evening flights. Although the presence of a significant portion of long-distance flights during evening hours does exist, this portion is not greater than the number of flights during other hours on the same day. 
```

```{r}
# Quesion 8
# It’s a little frustrating that Sunday and Saturday are on separate ends of the plot. Write a small function to set the levels of the factor so that the week starts on Monday.
reorder_wday <- function(data) {
  new_order <- c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")
  data$wday <- ordered(data$wday, levels = new_order)
  return(data)
}
daily <- reorder_wday(daily)
```
```{r}
# Ordering factors
# ---------------- #
# x1 <- c("Dec", "Apr", "Jan", "Mar")
# 
# month_levels <- c(
#   "Jan", "Feb", "Mar", "Apr", "May", "Jun", 
#   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
# )
# y1 <- factor(x1, levels = month_levels)
# y1
# factor(x1) %>% fct_inorder()
# wdays_reordered <- ordered(daily$wday, levels = new_order)
# wdays_reordered
```


## Section 24.5: Learning more about models
```{r}
library(modelr)
library(tidyverse)
if(!require("gapminder")) install.packages("gapminder")
library(gapminder)
```


## Section 25.2: gapminder
```{r}
gapminder
```

```{r}
# How does life expectancy change over time for each country?
gapminder %>%
  ggplot(aes(year, lifeExp, group = country)) + 
  geom_line(alpha = 1/3)
```
```{r}
nz <- filter(gapminder, country == "New Zealand")
nz %>%
  ggplot(aes(year, lifeExp)) +
  geom_line() + 
  ggtitle("Full data = ")

nz_mod <- lm(lifeExp ~ year, data = nz)
nz %>%
  add_predictions(nz_mod) %>%
  ggplot(aes(year, pred)) + 
  geom_line() + 
  ggtitle("Linear trend + ")

nz %>%
  add_residuals(nz_mod) %>%
  ggplot(aes(year, resid)) +
  geom_hline(yintercept = 0, color = "white", size = 3) + 
  geom_line() + 
  ggtitle("Remaining pattern")

```

#### Section 25.2.1: Nested Data

```{r}
gapminder
```


```{r}
by_country <- gapminder %>%
  group_by(country, continent) %>%
  nest()
```

```{r}
by_country
```

```{r}
by_country$data[[1]]
```


#### Section 25.2.2: List-columns
```{r}
country_model <- function(df) {
  lm(lifeExp ~ year, data = df)
}
```

```{r}
models <- map(by_country$data, country_model)
```


```{r}
by_country <- by_country %>%
  mutate(model = map(data, country_model))
by_country
```

```{r}
by_country %>%
 filter(continent == "Europe")
```

```{r}
by_country %>%
  arrange(continent, country)
```


#### Section 25.2.3: Unnesting
```{r}
by_country <- by_country %>%
  mutate(
    resids = map2(data, model, add_residuals)
  )
```

```{r}
resids <- unnest(by_country, resids)
resids
```

```{r}
resids %>%
  ggplot(aes(year, resid)) +
  geom_line(aes(group = country ),alpha = 1/3) +
  geom_smooth(se = FALSE) + 
  facet_wrap(~continent)
```

#### Section 25.2.4: Model Quality


```{r}
broom::glance(nz_mod)
test_tb <- by_country %>% mutate(glance = map(model, broom::glance)) 
test_tb
# %>% unnest(glance)
```




```{r}
broom::glance(nz_mod)
```
```{r}
by_country
```


```{r}
by_country %>%
  mutate(glance = map(model, broom::glance)) %>%
  unnest(glance)
```

```{r}
glance <- by_country %>%
  mutate(glance = map(model, broom::glance)) %>%
  unnest(glance, .drop = TRUE)
(glance)
```

```{r}
glance %>%
  arrange(r.squared)
```

```{r}
glance %>%
  ggplot(aes(continent, r.squared)) +
  geom_jitter(width = 0.5)
```

```{r}
bad_fit <- filter(glance, r.squared < 0.25)

gapminder %>%
  semi_join(bad_fit, by = "country") %>%
  ggplot(aes(year, lifeExp, color = fct_reorder2(country, year, lifeExp))) +
  geom_line() + 
  labs(color = "Country")
```

#### Section 25.2.5: Exercises
```{r}
# A linear trend seems to be slightly too simple for the overall trend. Can you do better with a quadratic polynomial? How can you interpret the coefficients of the quadratic? (Hint you might want to transform year so that it has mean zero.)

# zero out the year

# Add a "zeroed-year" column to each data tibble: This is a hinted suggestion. I do not yet see the purpose.
by_country_unnested <- by_country %>% unnest(data)
```


```{r}
by_country_unnested %>% group_by(country, continent) %>% mutate(mean_zero_year = mean((year - mean(year - min(year))) - min(year))) # Proof that mean of the year is zero
by_country_mean_zero_year_nest <- by_country_unnested %>% group_by(country, continent) %>% mutate(mean_zero_year = (year - mean(year - min(year))) - min(year)) %>% nest()
(by_country_mean_zero_year_nest$data[[1]])
# %>% mutate(mean_zero_year = mean(year))
```


```{r}
library(splines)

power = 3

qmod <- MASS::rlm(lifeExp ~ ns(mean_zero_year, power), by_country_mean_zero_year_nest$data[[1]])

by_country_mean_zero_year_nest

# create a function for MASS::rlm
quadratic_model <- function(df) {
  MASS::rlm(lifeExp ~ ns(mean_zero_year, power), df)  
}

by_country_mean_zero_year_nest_qmod <- by_country_mean_zero_year_nest %>% mutate(qmod = map(data, quadratic_model))

```

```{r}
by_country_mean_zero_year_nest_qmod_qresids <- by_country_mean_zero_year_nest_qmod %>% mutate(qresids = map2(data, qmod, add_residuals))
(by_country_mean_zero_year_nest_qmod_qresids)
```

```{r}
# Question 1
qresids <- by_country_mean_zero_year_nest_qmod_qresids %>% unnest(country, qresids)
qresids$qmod[[1]]
# The coefficients are providing a weight to the Taylor Series polynomial for each degree of the variable mean_zero_year.
```
```{r}
# Question 1
ggplot(qresids) +
  geom_line(aes(year, resid)) + 
  geom_smooth(aes(year, resid), se = FALSE)
```

```{r}
# Quesion 2
# if(!require("ggbeeswarm")) install.packages("ggbeeswarm")
# library(ggbeeswarm)



```

```{r}
# Quesion 3

```





## Section 25.3: List-columns
```{r}
# stringr::str_split() takes an atomic vector and returns a list
df <- tribble(
  ~x1,
  "a,b,c",
  "d,e,f,g"
)

df_new <- df %>% mutate(x2 = stringr::str_split(x1, ","))
(df_new)
df_new$x2
```

```{r}
# Unnest
df_new %>% unnest(x2)
```

```{r}
sim <- tribble(
  ~f, ~params,
  "runif", list(min = -1, max = 1),
  "rnorm", list(sd = 5),
  "rpois", list(lambda = 10)
)

sim %>%
  mutate(sims = invoke_map(f, params, n = 10))
```
```{r}
mtcars %>%
  group_by(cyl) 
```


#### Section 25.4.5: Exercises
```{r}
# Question 1
# Invokemap will take a tribble and return a list;
# stringr::split will take an atomic vector and return a list;
# list() will take an atomic vector and return a list.

```

```{r}
# Quesion 2
# quantile will return multiple values
# glance will return multiple values
```

```{r}
# Quesion 3
# What's missing from the following dataframe? How does quantile() return that missing piece? Why isn't that helpful here?
# The probabilities are missing from this dataframe. This is not helpful because the probability of the mpg given the cylinder is a fixed listed quantity. 

mtcars %>%
  group_by(cyl) %>%
  summarise(q = list(quantile(mpg))) %>%
  unnest(q)
```

```{r}
# Quesion 4
# Grouping on a column then summarising all into a list of list will create an series of rows where each observation contains one unique element from the group and every column on the same row contains a list of all elements that relate to the unique variable in the group on the same row. This is a helpful way to view individual column values that are grouped in reference to another column (i.e. all values of horsepower that relate to 4 or six cylinders)

summarise_all_cylinders <- mtcars %>%
  group_by(cyl) %>%
  summarise_all(list(list))


(summarise_all_cylinders)
summarise_all_cylinders$mpg

mtcars %>% group_by(cyl) %>% filter( cyl == 6)
```

## Section 25.5: Simplifying list-columns
```{r}

```

#### Section 25.5.1: List to vector
```{r}
df <- tribble(
  ~x,
  letters[1:5],
  1:3,
  runif(5)
)

df %>% mutate(
  type = typeof(x),
  length = length(x)
)
```

```{r}
# Extract individual elements from a list:
# mutate(variable = func); where "func" implements an atomic vector: map_dbl(), map_chr(), map_lgl(), or map_int()


df <- tribble(
  ~x, 
  list(a = 1, b = 2),
  list(a = 2, c = 4)
)

df %>% mutate(
  a = map_dbl(x , "a"),
  b = map_dbl(x, "b", .null = NA_real_),
  c = map_dbl(x, "c", .null = NA_real_)
)
```
#### Section 25.5.2: Unnesting
```{r}
tibble(x = 1:2, y = list(1:4, 1)) %>% unnest(y)
```

```{r}
df1 <- tribble(
  ~x, ~y, ~z,
  1, c("a", "b"), 1:2,
  2, "c", 3
)
df1
```

```{r}

df1 %>% unnest(c(y,z))


```

```{r}
df2 <- tribble(
  ~x, ~y, ~z,
  1, "a", 1:2,
  2, c("b", "c"), 3
)
df2
```

```{r}
# y & z do not have the same number of rows. This unnest will not display properly. 
df2 %>% unnest(c(y, z))
```


#### Section 25.5.3: Exercises
```{r}
# Question 1
# Why might the lengths() function be useful for creating atomic vector columns from list-columns?
# The ".f" function must return a lengths - 1 vector of the appropriate type when creating atomic vector columns from list-columns. lengths() can be used to verify the correct return length. 


```

```{r}
# Quesion 2
# List the most common types of vector found in a data frame. What makes lists different?
# character vectors
# double vectors
# logical vectors
# integer vectors

# Lists are different because they can be comprised of many different types of atomic vectors. Not all elements within a list need to be homogeneous. 

```


## Section 25.6: Making tidy data with broom
```{r}
# Returns a row for each model where each column gives a summary
broom::glance(nz_mod)
```




```{r}
# Returns a row for each coefficient in the model. 
broom::tidy(nz_mod)
```

```{r}
# broom::augment will add columns that describe summary statistics to each row in the data.
broom::augment(nz_mod, nz)
```
# Section 26: Introduction


#### Section 27.2.1: Exercises
```{r}
# Quesion 3
# The R notebook contains a header file. The output of the cells in the R Notebook and the R Markdown file are both the same. Copying the output from the R Notebook to the R Markdown file allows the R Markdown file to behave as an R Notebook. 
```


## Section 27.3 Text formatting with Markdown
```{r}
# See "text-formatting-with-r-markdown.rmd"

```

#### Section 27.4.2: Chunk options
```{r}
# options include: 
# eval = FALSE: prevents code from being evaluated
# include = FALSE: runs the code, doesn't show the code or the results in the final document
# echo = FALSE: prevents the code but not the results from appearing in the final file. 
# message = FALSE or warnings = FALSE: prevents messages or warnings from appearing in the finished file.
# results = 'hide': hides printed output;
# fig.show = 'hide': hides plots;
# error = TRUE: causes knitting to fail if there is a single error in the document. 
```


#### Section 27.4.3: Table
```{r}
mtcars[1:5,]
```

```{r}
# Creating tables:
knitr::kable(
  mtcars[1:5, ],
  caption = "A knitr kable"
)
```

```{r}
# Other options for tables:
# Xtable
# stargazer
# pander
# tables
# ascii
if(!require("xtable")) install.packages("xtable")
library(xtable)
xtable(mtcars[1:5, ])
```

```{r}
# Xtable
if(!require("xtable")) install.packages("xtable")
library(xtable)
xtable(mtcars[1:5, ], type = 'html')
```

```{r}
# stargazer
if(!require("stargazer")) install.packages("stargazer")
library(stargazer)
stargazer(mtcars, type = 'text')
```
```{r}
# pander
if(!require("pander")) install.packages("pander")
library(pander)
pander(mtcars)

```

```{r}
# ascii
if(!require("ascii")) install.packages("ascii")
library(ascii)
ascii(mtcars)
```
#### 27.4.4: Caching
```{r raw_data}
getwd()
rawdata <- readr::read_csv("/Users/evanwoods/Github/lpa/r-for-data-science/data/EEG_Eye_State_Classification.csv")
```
```{r processed_data, cache = TRUE}
# Example processing data based on "rawdata" which is cached. 
# processed_data <- rawdata %>%
#   filter(!is.na(import_var)) %>%
#   mutate(new_variable = complicated_transformation(x,y,z))
```
```{r}
# Track changes to the file: use "cache.extra" option
```


#### Section 27.4.5: Global Options
```{r}
# Set the global options for chunks
knitr::opts_chunk$set(
  comment = "#>",
  collapse = TRUE
)
```

```{r}
# Preparing a report
knitr::opts_chunk$set(
  echo = FALSE
)
```


#### Section 27.4.6: Inline code
```{r}
comma <- function(x) format(x, digits = 2, big.mark = ",")
comma(3452345)
comma(.12358124331)
```


#### Section 27.4.7: Exercises
```{r}
# Question 1
knitr::opts_chunk$set(
  echo = FALSE
)
# How do diamond sizes vary by cut, color, and clarity?

# Dodge will show the bars side by side
ggplot(diamonds, aes(cut, fill = clarity)) + 
  geom_bar(position = "dodge")

```

```{r}
# Quesion 4
# Set up a network of chunks where d depends on c and b, and both b and c depend on a. Have each chunk print lubridate::now(), set cache = TRUE, then verify your understanding of caching. 
```


## Section 27.5 Troubleshooting
```{r}

```


# Section 28: Graphics for communication
```{r}

```

## Section 28.4: Scales
```{r}
# Default scales shown behind the scenes.
ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  scale_x_continuous() + 
  scale_y_continuous() + 
  scale_color_discrete()
```

```{r}
# Overriding the default breaks: Notice the change on the y-axis.
ggplot(mpg, aes(displ, hwy)) +
  geom_point() + 
  scale_y_continuous(breaks = seq(15, 40, by = 5))
```

```{r}
# Changing the x-axis
ggplot(mpg, aes(displ, hwy)) +
  geom_point() + 
  scale_y_continuous(breaks = seq(15, 40, by = 5)) + 
  scale_x_continuous(breaks = seq(0, 10, by = 2)) # Altered the x-axis; 0 to 10 by 2.
```

```{r}
# Removing numbers from the axes:
ggplot(mpg, aes(displ, hwy)) + 
  geom_point() + 
  scale_x_continuous(labels = NULL) + 
  scale_y_continuous(labels = NULL) 
```

```{r}
# Note: axes and legends are called: guides
# breaks and labels enable the control of legends.
```

```{r}
presidential %>% 
  mutate(id = 33 + row_number()) %>%
  ggplot(aes(start, id)) + 
  geom_point() +
  geom_segment(aes(xend = end, yend = id)) +
  scale_x_date(NULL, breaks = presidential$start, date_labels = "'%y") # breaks are set to a specific value. 
# date_labels takes a format specification like parse_datetime()
# date_breaks takes a string such as "2 years" or "2 days" or "1 month"
```


#### Section 28.4.2: Legend Layout
```{r}
# Use legend.position to change the position of the legend. 
base <- ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class))

base + theme(legend.position = "left")
base + theme(legend.position = "right")
base + theme(legend.position = "top")
base + theme(legend.position = "bottom")

# Suppress the display of the legend with legend.position = "none"
# base + theme(legend.position = "none")

# Suppress all: legend, x-axis label, y-axis label, x-axis scale-ticks, y-axis scale-ticks
base + theme(legend.position = "none") + scale_x_continuous(NULL, labels = NULL) + scale_y_continuous(NULL, labels = NULL)
```

```{r}
# To control the display of individual legends use guides() with guide_legend() or guide_colorbar()
# Example: 
# Controlling the number of rows the legend uses with nrow: guides(color = guide_legend(nrow = 1))
# Changing the legend point sizes: guides(guide_legend(override.aes = list(size = 4)))

ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth(se = FALSE) + 
  theme(legend.position = "bottom") +
  guides(color = guide_legend(nrow = 1, override.aes = list(size = 4)))

```

#### Section 28.4.3: Replacing a scale
```{r}
# scale_x_log10 will modify the data by multiplying by log10 of the x variable whilst keeping the x-axis label the same. 
ggplot(diamonds, aes(carat, price)) + 
  geom_bin2d() +
  scale_x_log10() + 
  scale_y_log10()

ggplot(diamonds, aes(log10(carat), log10(price))) + 
  geom_bin2d() 

```

```{r}
# scale_color_brewer will change the color palette to accommodate readers with color blindness
# Color brewer scales: https://colorbrewer2.org/#type=sequential&scheme=BuGn&n=3
ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = drv))

ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = drv)) + 
  scale_color_brewer(palette = "Set1")
```

```{r}
# Using a predefined mapping between values and colors
# Setting custom colors on the legend
presidential %>%
  mutate(id = 33 + row_number()) %>%
  ggplot(aes(start, id, color = party)) + 
  geom_point() + 
  geom_segment(aes(xend = end, yend = id)) +
  scale_color_manual(values = c(Republican = "red", Democratic = "blue"))
```

```{r}
# A continuous analogue of the ColorBrewer Scales
if(!require("viridis")) install.packages("viridis")
library(viridis)
```


```{r}
df <- tibble(
  x = rnorm(10000), 
  y = rnorm(10000)
)

ggplot(df, aes(x, y)) + 
  geom_hex() + 
  coord_fixed()

ggplot(df, aes(x, y)) + 
  geom_hex() +
  viridis::scale_fill_viridis() + 
  coord_fixed() 
```
#### Section 28.4.4: Exercises
```{r eval = FALSE}
# Question 1
# Why doesn't the following code override the default scale?

# geom_point is not implementing a color scale to be modified. No color scale is applied.
ggplot(df, aes(x, y)) + 
  geom_point() + 
  scale_color_gradient(low = "white", high = "red") +
  coord_fixed()


ggplot(df, aes(x, y)) +
  geom_point(aes(color = z2)) +
  scale_color_gradient(low = "white", high = "red") +
  coord_fixed()
```


```{r}
#  1.1
# Working Example
df <- data.frame(
  x = runif(100),
  y = runif(100),
  z1 = rnorm(100),
  z2 = abs(rnorm(100))
)

ggplot(df, aes(x, y)) +
  geom_point(aes(colour = z2)) +
  scale_colour_gradient(low = "white", high = "black")
```

```{r}
# Quesion 2
# The first argument to every scale is the color or palette that you want to assign to the scale. "labs" will allow a variety of choices for the first argument including title, x, etc.
```

```{r}
# Quesion 3

# Change the display of the presidential terms by:
# 
#     Combining the two variants shown above.
#     Improving the display of the y axis.
#     Labelling each term with the name of the president.
#     Adding informative plot labels.
#     Placing breaks every 4 years (this is trickier than it seems!).

```

```{r}
# Quesion 4
# Use override.aes to make the legend on the following plot easier to see.
ggplot(diamonds, aes(carat, price)) + 
  geom_point(aes(color = cut), alpha = 1/20)
```

## Section 28.5: Zooming
```{r}
ggplot(mpg, mapping = aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth() + 
  coord_cartesian(xlim = c(5, 7), ylim = c(10, 30))

mpg %>%
  filter(displ >= 5, displ <= 7, hwy >= 10, hwy <= 30) %>%
  ggplot(aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth()

```


```{r}
suv <- mpg %>% filter(class == "suv")

compact <- mpg %>% filter(class == "compact")

ggplot(suv, aes(displ, hwy, color = drv)) +
  geom_point()

ggplot(compact, aes(displ, hwy, color = drv)) +
  geom_point()
```

```{r}
# Sharing scales across multiple plots; set the values as limits.
x_scale <- scale_x_continuous(limits = range(mpg$displ))
y_scale <- scale_y_continuous(limits = range(mpg$hwy))
col_scale <- scale_color_discrete(limits = unique(mpg$drv))

ggplot(suv, aes(displ, hwy, color = drv)) + 
  geom_point() + 
  x_scale + 
  y_scale +
  col_scale

ggplot(compact, aes(displ, hwy, color = drv)) + 
  geom_point() + 
  x_scale + 
  y_scale +
  col_scale

```
## Section 28.6: Themes
```{r}
# Customize the non-data elements of your plot with a theme
# Example of changing the background

# Default: No theme
ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth(se = FALSE) +
  labs(title = "Default: no theme")

# Black & White Theme
ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth(se = FALSE) +
  theme_bw() + 
  labs(title = "theme_bw()")

ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth(se = FALSE) +
  theme_classic() + 
  labs(title = "theme_classic()")
  
ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth(se = FALSE) +
  theme_dark() + 
  labs(title = "theme_dark()")

ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth(se = FALSE) +
  theme_gray() +
  labs(title = "theme_gray()")

ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth(se = FALSE) +
  theme_light() + 
  labs(title = "theme_light()")
  
ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth(se = FALSE) +
  theme_linedraw() + 
  labs(title = "theme_linedraw()")

ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth(se = FALSE) +
  theme_minimal() + 
  labs(title = "theme_minimal()")

ggplot(mpg, aes(displ, hwy)) + 
  geom_point(aes(color = class)) + 
  geom_smooth(se = FALSE) +
  theme_void() +
  labs(title = "theme_void()") 

```

## Seciton 28.7: Saving your plots
```{r }
ggplot(mpg, aes(displ, hwy)) + geom_point()  
```

```{r}
ggsave("my-plot.pdf") # Saves the most recent plot to disk. 
```


### Section 28.7.1: Figure Sizing
```{r}
# Options to set in the chunk:

# fig.width
# fig.height
# fig.asp
# out.width
# out.height

# Optimal values; set in defaults: 
# fig.width = 6 # 6 inches; contsant width amongst plots
# fig.asp = 0.618 # golden ratio

# fig.show = "hold" # this will allow plots to be shown after the code.
# Add a caption to the plot: fig.cap will set the figure from inline to floating. 
# When creating many plots that don't require high quality graphics, speed up plot creation by forcing the use of PNGs with dev = "png".
# The chunk label is used to create the file name on disk; name code chunks that produce figures.

# fig.width will change the size of the figure axis lines and figure axis tick-marks
# Set out.width = 70% & fig.align = "center"
# 
```

# Section 29: R Markdown Formats
```{r}

```

## Section 29.7: Interactivity
```{r}

```

### Section 29.7.1 htmlwidgets

```{r}
if(!require("leaflet")) install.packages("leaflet")
library(leaflet)
leaflet() %>%
  setView(174.764, -36.877, zoom = 16) %>%
  addTiles() %>%
  addMarkers(174.764, -36.877, popup = "Maungawhau")
```


```{r}
# htmlwidgets
# - dygraphs
# - diagrammeR
# - rthreejs
# - DT
```

```{r}
# Shiny

# Call Shiny code from R Markdown: Add runtime: shiny to the header
# title: "Shiny Web App"
# output: html_document
# runtime: shiny
```