```{r echo = TRUE, message = FALSE, warning = FALSE, include = FALSE}

#install.packages("lubridate")

library(tidyverse)
library(lubridate)

help(package = lubridate)

```

![Make Dealing with Dates a Little Easier!](hex.png)

# Introduction

In this computing club mini session, we will cover the lubridate package and learn how to better work with dates and times in R. Lubridate was developed by Garrett Grolemund and Hadley Wickham, and is maintained by Vitalie Spinu. Oftentimes, investigators will provide time/date data in raw form, making it difficult to work with these variables. Conversions to the desirable form are tricky, and time-consuming. The functions in the lubridate package help to streamline and facilitate this process. Lubridate is not part of the tidyverse core (only need it when working with dates/times).


**Three possible date/time formats**

`Date` tibbles print this as `<date>`

`Time` tibbles print this as `<time>`

`Date-time` instant in time, tibbles print this as `<dttm>` (also called POSIXct in R)

# Basics

## Parsing

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

ymd(20190116)

mdy("1/16/2019")

today()

now()
```

## Simple functions

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

exdate <- dmy("16/1/2019")

# Extract month
month(exdate)

# Extract day of week, set label = TRUE to get actual day in words
wday(exdate, label = T)

# Change year of example date, and get new day of the week
year(exdate) <- 2016
wday(exdate, label = T)


```

# Applications 

## Creation {.tabset .tabset-fade .tabset-pills}

Let's use the `nycflights13` data

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

#install.packages(nycflights13)
library(nycflights13)

```


**Three scenarios of creating a date/time variable:**

### String

Must specify correct input and parsing will convert to standard date format
```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

# Covered earlier in the parsing section
ymd("2018-04-08")
mdy("April 8th, 2018")
dmy("08-April-2018")

# Can also work without quotes
ymd(20180408)

# Create date-time
ymd_hms("2017-01-31 20:11:59")
mdy_hm("01/31/2017 08:01")

# Force with timezone
ymd(20170131, tz = "UTC")
```


### Individual date-time components

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

flights %>% 
  select(year, month, day, hour, minute)

```


```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

# Create new variable that combines the five columns using make_datetime
flights %>% 
  select(year, month, day, hour, minute) %>% 
  mutate(departure = make_datetime(year, month, day, hour, minute))

```


```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

# Combine and create variables for departure, arrival, scheduled departure, scheduled arrival

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

depart <- 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"))

depart

```

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

# Visualize departure times

depart %>% 
  ggplot(aes(dep_time)) + 
  geom_freqpoly(binwidth = 86400) 

```



### Existing date/time object

`Switch between a date-time and a date --> as_datetime() and as_date()`

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

as_datetime(today())

as_date(now())

```

`Date/times as numeric offsets from Unix Epoch 1970-01-01`

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

#Seconds
as_datetime(60 * 60 * 10)

#Days
as_date(365 * 10 + 2)

```


## Date-time

### Graphical exploration

`Lets revist the wday() function and the nycflights13 dataset`

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

depart %>% 
  mutate(wday = wday(dep_time, label = TRUE)) %>% 
  ggplot(aes(x = wday)) +
    geom_bar()

```

`And the minute() function`
```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

depart %>% 
  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()

```

### Rounding options {.tabset .tabset-fade .tabset-pills}

#### floor_date()

`Takes a date-time object and rounds it down to the nearest boundary of the specified time unit`

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}
depart %>% 
  count(week = floor_date(dep_time, "week")) %>% 
  ggplot(aes(week, n)) +
    geom_line()
```


#### round_date()

`Takes a date-time object and rounds it to the nearest value of the specified time unit. Exactly halfway --> round up`

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}
depart %>% 
  count(week = round_date(dep_time, "week")) %>% 
  ggplot(aes(week, n)) +
    geom_line()
```

#### ceiling_date()

`Takes a date-time object and rounds it up to the nearest boundary of the specified time unit`

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}
depart %>% 
  count(week = ceiling_date(dep_time, "week")) %>% 
  ggplot(aes(week, n)) +
    geom_line()
```

### update() function

`Set multiple values at once `

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

datetime <- ymd_hms("2019-06-20 11:44:39")
update(datetime, year = 2018, month = 8, mday = 10, hour = 5)

```

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

depart %>% 
  mutate(dep_hour = update(dep_time, yday = 1)) %>% 
  ggplot(aes(dep_hour)) +
    geom_freqpoly(binwidth = 300)

```

## Time spans {.tabset .tabset-fade .tabset-pills}

`durations:` measure the exact amount of time between two points

`periods:` track clock times despite leap years, leap seconds, and day light savings time

`intervals:` protean summary of the time information between two points


### Durations

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

#Subtraction of two dates --> difftime object (seconds, minutes, hours, days, or weeks)

vicky_age <- today() - ymd(19940819)
vicky_age

```

Let's convert `vicky_age` to a duration using the `lubridate` package

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

vicky_age <- as.duration(vicky_age)
vicky_age

```

We can use the built in features of associated functions to extract the relevant information that we need:

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

dseconds(25)

dminutes(50)

dhours(23)

ddays(10)
           
dweeks(34)

dyears(12)

```
`Durations: give time span in seconds`

Adding, subtracting, and multiplying

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

dyears(50) + dweeks(30) + dhours(10) + dminutes(13)

2 * dyears(25)

#Tomorrow
today() + ddays(1)

#Last year
today() - dyears(1)

```

### Periods

Motivation

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

ex <- ymd_hms("2017-02-10 14:00:00", tz = "America/New_York")
ex

ex + ddays(40)

```


`Like time spans, but without fixed length in seconds`


```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

seconds(25)

minutes(45)

hours(16)

days(40)

months(7)

weeks(23)

years(30)

```

Adding, subtracting, and multiplying

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

20 * months(10)

days(30) + hours(4) + minutes(10)

#Leap year
ymd("2016-01-01") + dyears(1)

#Without taking leap year into account
ymd("2016-01-01") + years(1)

#DST
ex + ddays(40)

#Does not take into account DST
ex + days(40)

```

Application to the `nycflights13` dataset 


```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

#Extract overnight flights that appear to have arrived before they departed
depart %>% 
  filter(arr_time < dep_time) 


depart %>% 
  mutate(
    overnight = arr_time < dep_time,
    arr_time = arr_time + days(overnight * 1),
    sched_arr_time = sched_arr_time + days(overnight * 1)
  )

```

### Intervals

Basic examples

```{r echo = TRUE, message = FALSE, warning = FALSE, include=TRUE, results='markup'}

#Interesting result with decimals
years(1) / days(1)

next_year <- today() + years(1)
(today() %--% next_year) / ddays(1)


#Periods in an interval --> integer division

(today() %--% next_year) %/% days(4)

```

## Selecting between duration, periods, and intervals


*Simplest = ideal

*Duration --> physical time

*Period --> human times

*Interval --> length of time span in human units 

![Permitted operations](datetimes-arithmetic.png)


# Further topics

Time zones! 

# Resouces utilized 

https://lubridate.tidyverse.org

https://www.r-statistics.com/2012/03/do-more-with-dates-and-times-in-r-with-lubridate-1-1-0/

https://r4ds.had.co.nz/dates-and-times.html#time-spans
