Tidy Data and the next 4 chapters

In this notebook we will try out using a jupyter notebook and try out some code related to chapters 12 through 16. The topics are

• Tidy Data
• Relational Data
• Strings
• Factors
• Dates and Time

library(tidyverse)

Chapter 12 Tidy Data

The datasets have four variables: Country, Year, Population, and Cases.

Tidy data looks like this!

In this chapter 5 datasets are discussed. The first one is a tidy dataset.

table1

table2

table3

table4a

table4b

table5

Add a new column to table1.

# Compute rate per 10,000
table1 %>% 
  mutate(rate = cases / population * 10000)

# Compute cases per year
table1 %>% 
  count(year, wt = cases)

library(ggplot2)
ggplot(table1, aes(year, cases)) + 
  geom_line(aes(group = country), colour = "grey50") + 
  geom_point(aes(colour = country))

Gathering

table4a

table4a %>% 
  gather(`1999`, `2000`, key = "year", value = "cases")

table4b

table4b %>% 
  gather(`1999`, `2000`, key = "year", value = "population")

Left Join

tidy4a <- table4a %>% 
  gather(`1999`, `2000`, key = "year", value = "cases")
tidy4b <- table4b %>% 
  gather(`1999`, `2000`, key = "year", value = "population")
left_join(tidy4a, tidy4b)

Joining, by = c("country", "year")

Spreading

table2

spread(table2, key = type, value = count)

Separate

table3

table3 %>% 
  separate(rate, into = c("cases", "population"))

table3 %>% 
  separate(rate, into = c("cases", "population"), convert = TRUE)

table3 %>% 
  separate(year, into = c("century", "year"), sep = 2)

Unite

table5

table5 %>% 
  unite(new, century, year)

table5 %>% 
  unite(new, century, year, sep = "")

Missing Data

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)
)
stocks

stocks %>% 
  spread(year, return)

stocks %>% 
  spread(year, return) %>% 
  gather(year, return, `2015`:`2016`, na.rm = TRUE)

stocks %>% 
  complete(year, qtr)

Case Study

who

who1 <- who %>% 
  gather(new_sp_m014:newrel_f65, key = "key", value = "cases", na.rm = TRUE)
who1 %>% 
  count(key)

who2 <- who1 %>% 
  mutate(key = stringr::str_replace(key, "newrel", "new_rel"))
who2

who3 <- who2 %>% 
  separate(key, c("new", "type", "sexage"), sep = "_")
who3

who3 %>% 
  count(new)

who4 <- who3 %>% 
  select(-new, -iso2, -iso3)
who5 <- who4 %>% 
  separate(sexage, c("sex", "age"), sep = 1)
who5

who %>%
  gather(code, value, new_sp_m014:newrel_f65, na.rm = TRUE) %>% 
  mutate(code = stringr::str_replace(code, "newrel", "new_rel")) %>%
  separate(code, c("new", "var", "sexage")) %>% 
  select(-new, -iso2, -iso3) %>% 
  separate(sexage, c("sex", "age"), sep = 1)

Chapter 13 Relational data

library(tidyverse)
library(nycflights13)

Four datasets

airlines

airports

planes

weather

Keys

The variabled that are used to connect pairs of tables are called keys.

• primary key
• foreign key

Check that the key is unique. None greater than 1.

planes %>% 
  count(tailnum) %>% 
  filter(n > 0)

weather %>% 
  count(year, month, day, hour, origin) %>% 
  filter(n > 1)

Sometimes no primary key. Some greater than 1.

flights %>% 
  count(year, month, day, flight) %>% 
  filter(n > 1)

flights %>% 
  count(year, month, day, tailnum) %>% 
  filter(n > 1)

Mutating joins

flights2 <- flights %>% 
  select(year:day, hour, origin, dest, tailnum, carrier)
flights2

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

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

Understanding joins

Be sure to read this section in the book to understand joins!!! Great images to think about.

Defining the key column

flights2 %>% 
  left_join(weather)

Joining, by = c("year", "month", "day", "hour", "origin")

flights2 %>% 
  left_join(planes, by = "tailnum")

flights2 %>% 
  left_join(airports, c("dest" = "faa"))

flights2 %>% 
  left_join(airports, c("origin" = "faa"))

Other implementations

Try to run the code that uses the merge() function and try sqldf() to do the same.

Chapter 14 Strings

library(tidyverse)
library(stringr)

string1 <- "This is a string"
string2 <- 'If I want to include a "quote" inside a string, I use single quotes'
string1

[1] "This is a string"

string2

[1] "If I want to include a \"quote\" inside a string, I use single quotes"

x <- c("\"", "\\")
writeLines(x)

"
\

x <- "\u00b5"
x

[1] "µ"

String length

str_length(c("a", "R for data science", NA))

[1]  1 18 NA

Combind string

str_c("x", "y")

[1] "xy"

str_c("x", "y", "z")

[1] "xyz"

str_c("x", "y", sep = ", ")

[1] "x, y"

name <- "Hadley"
time_of_day <- "morning"
birthday <- FALSE
str_c(
  "Good ", time_of_day, " ", name,
  if (birthday) " and HAPPY BIRTHDAY",
  "."
)

[1] "Good morning Hadley."

str_c(c("x", "y", "z"), collapse = ", ")

[1] "x, y, z"

Subsetting strings

x <- c("Apple", "Banana", "Pear")
str_sub(x, 1, 3)

[1] "App" "Ban" "Pea"

str_sub(x, 1, 1) <- str_to_lower(str_sub(x, 1, 1))
x

[1] "apple"  "banana" "pear"  

x <- c("apple", "eggplant", "banana")
str_sort(x, locale = "en")  # English

[1] "apple"    "banana"   "eggplant"

Matching patterns with regular expressions

x <- c("apple", "banana", "pear")
str_view(x, "an")

str_view(x, ".a.")

Anchors

• ^ to match the start of the string.
• $ to match the end of the string.

x <- c("apple", "banana", "pear")
str_view(x, "^a")

str_view(x, "a$")

x <- c("apple pie", "apple", "apple cake")
str_view(x, "apple")

str_view(x, "^apple$")

str_view(c("grey", "gray"), "gr(e|a)y")

x <- "1888 is the longest year in Roman numerals: MDCCCLXXXVIII"
str_view(x, "CC?")

str_view(x, "CC+")

str_view(x, 'C[LX]+')

str_view(x, "C{2}")

str_view(x, "C{2,}")

str_view(x, "C{2,3}")

str_view(x, 'C{2,3}?')

str_view(x, 'C[LX]+?')

str_view(fruit, "(..)\\1", match = TRUE)

x <- c("apple", "banana", "pear")
str_detect(x, "e")

[1]  TRUE FALSE  TRUE

sum(str_detect(words, "^t"))

[1] 65

mean(str_detect(words, "[aeiou]$"))

[1] 0.2765306

no_vowels_1 <- !str_detect(words, "[aeiou]")
no_vowels_2 <- str_detect(words, "^[^aeiou]+$")
identical(no_vowels_1, no_vowels_2)

[1] TRUE

words[str_detect(words, "x$")]

[1] "box" "sex" "six" "tax"

str_subset(words, "x$")

[1] "box" "sex" "six" "tax"

df <- tibble(
  word = words, 
  i = seq_along(word)
)
df %>% 
  filter(str_detect(words, "x$"))

#> # A tibble: 4 × 2
#>    word     i
#>   <chr> <int>
#> 1   box   108
#> 2   sex   747
#> 3   six   772
#> 4   tax   841

df %>% 
  mutate(
    vowels = str_count(word, "[aeiou]"),
    consonants = str_count(word, "[^aeiou]")
  )

Exact matches

length(sentences)

[1] 720

head(sentences)

[1] "The birch canoe slid on the smooth planks." 
[2] "Glue the sheet to the dark blue background."
[3] "It's easy to tell the depth of a well."     
[4] "These days a chicken leg is a rare dish."   
[5] "Rice is often served in round bowls."       
[6] "The juice of lemons makes fine punch."      

colours <- c("red", "orange", "yellow", "green", "blue", "purple")
colour_match <- str_c(colours, collapse = "|")
colour_match

[1] "red|orange|yellow|green|blue|purple"

has_colour <- str_subset(sentences, colour_match)
matches <- str_extract(has_colour, colour_match)
head(matches)

[1] "blue" "blue" "red"  "red"  "red"  "blue"

has_colour <- str_subset(sentences, colour_match)
matches <- str_extract(has_colour, colour_match)
head(matches)

[1] "blue" "blue" "red"  "red"  "red"  "blue"

more <- sentences[str_count(sentences, colour_match) > 1]
str_view_all(more, colour_match)

str_extract(more, colour_match)

[1] "blue"   "green"  "orange"

str_extract_all(more, colour_match)

[[1]]
[1] "blue" "red" 

[[2]]
[1] "green" "red"  

[[3]]
[1] "orange" "red"   

str_extract_all(more, colour_match, simplify = TRUE)

     [,1]     [,2] 
[1,] "blue"   "red"
[2,] "green"  "red"
[3,] "orange" "red"

Chapter 15 Factors

library(tidyverse)
library(forcats)

x1 <- c("Dec", "Apr", "Jan", "Mar")
x2 <- c("Dec", "Apr", "Jam", "Mar")
sort(x1)

[1] "Apr" "Dec" "Jan" "Mar"

month_levels <- c(
  "Jan", "Feb", "Mar", "Apr", "May", "Jun", 
  "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
)
y1 <- factor(x1, levels = month_levels)
y1

[1] Dec Apr Jan Mar
Levels: Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec

sort(y1)

[1] Jan Mar Apr Dec
Levels: Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec

y2 <- factor(x2, levels = month_levels)
y2

[1] Dec  Apr  <NA> Mar 
Levels: Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec

y2 <- parse_factor(x2, levels = month_levels)

1 parsing failure.
row # A tibble: 1 x 4 col     row   col           expected actual expected   <int> <int>              <chr>  <chr> actual 1     3    NA value in level set    Jam

factor(x1)

[1] Dec Apr Jan Mar
Levels: Apr Dec Jan Mar

f1 <- factor(x1, levels = unique(x1))
f1

[1] Dec Apr Jan Mar
Levels: Dec Apr Jan Mar

f2 <- x1 %>% factor() %>% fct_inorder()
f2

[1] Dec Apr Jan Mar
Levels: Dec Apr Jan Mar

levels(f2)

[1] "Dec" "Apr" "Jan" "Mar"

Chapter 16 Dates and times

library(tidyverse)
library(lubridate)
library(nycflights13)

today()

[1] "2017-11-03"

now()

[1] "2017-11-03 09:44:08 PDT"

ymd("2017-01-31")

[1] "2017-01-31"

mdy("January 31st, 2017")

[1] "2017-01-31"

dmy("31-Jan-2017")

[1] "2017-01-31"

ymd(20170131)

[1] "2017-01-31"

ymd_hms("2017-01-31 20:11:59")

[1] "2017-01-31 20:11:59 UTC"

mdy_hm("01/31/2017 08:01")

[1] "2017-01-31 08:01:00 UTC"

ymd(20170131, tz = "UTC")

[1] "2017-01-31 UTC"

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

flights %>% 
  select(year, month, day, hour, minute) %>% 
  mutate(departure = make_datetime(year, month, day, hour, minute))

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

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

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

as_datetime(today())

[1] "2017-11-03 UTC"

as_date(now())

[1] "2017-11-03"

datetime <- ymd_hms("2016-07-08 12:34:56")
year(datetime)

[1] 2016

#> [1] 2016
month(datetime)

[1] 7

#> [1] 7
mday(datetime)

[1] 8

#> [1] 8
yday(datetime)

[1] 190

#> [1] 190
wday(datetime)

[1] 6

#> [1] 6

month(datetime, label = TRUE)

[1] Jul
Levels: Jan < Feb < Mar < Apr < May < Jun < Jul < Aug < Sep < Oct < Nov < Dec

#> [1] Jul
#> 12 Levels: Jan < Feb < Mar < Apr < May < Jun < Jul < Aug < Sep < ... < Dec
wday(datetime, label = TRUE, abbr = FALSE)

[1] Friday
Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday

#> [1] Friday
#> 7 Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < ... < Saturday

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

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

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

ggplot(sched_dep, aes(minute, n)) +
  geom_line()

Setting components

(datetime <- ymd_hms("2016-07-08 12:34:56"))

[1] "2016-07-08 12:34:56 UTC"

year(datetime) <- 2020
datetime

[1] "2020-07-08 12:34:56 UTC"

month(datetime) <- 01
datetime

[1] "2020-01-08 12:34:56 UTC"

hour(datetime) <- hour(datetime) + 1
datetime

[1] "2020-01-08 13:34:56 UTC"

update(datetime, year = 2020, month = 2, mday = 2, hour = 2)

[1] "2020-02-02 02:34:56 UTC"

ymd("2015-02-01") %>% 
  update(mday = 30)

[1] "2015-03-02"

ymd("2015-02-01") %>% 
  update(hour = 400)

[1] "2015-02-17 16:00:00 UTC"

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

Time spans

h_age <- today() - ymd(19791014)
h_age

Time difference of 13900 days

as.duration(h_age)

[1] "1200960000s (~38.06 years)"

flights_dt

flights_dt %>% 
  filter(arr_time < dep_time) 

These are overnight flights. We used the same date information for both the departure and the arrival times, but these flights arrived on the following day. We can fix this by adding days(1) to the arrival time of each overnight flight.

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

flights_dt %>% 
  filter(overnight, arr_time < dep_time)