Tweet
Tweet

Slide 1

Slide 1 text

webscraping with rvest & purrr @maxhumber useR!2017 2017-07-06

Slide 2

Slide 2 text

how to make money* with rvest & purrr**

Slide 3

Slide 3 text

how to make money* with rvest & purrr**

Slide 4

Slide 4 text

* *probably not. and i’m not liable if you lose money. disclaimer. disclaimer. disclaimer.

Slide 5

Slide 5 text

* *probably not. and i’m not liable if you lose money. disclaimer. disclaimer. disclaimer.

Slide 6

Slide 6 text

whoami

Slide 7

Slide 7 text

No content

Slide 8

Slide 8 text

No content

Slide 9

Slide 9 text

No content

Slide 10

Slide 10 text

No content

Slide 11

Slide 11 text

No content

Slide 12

Slide 12 text

https://github.com/hadley/rvest https://github.com/tidyverse/purrr

Slide 13

Slide 13 text

fake money

Slide 14

Slide 14 text

No content

Slide 15

Slide 15 text

No content

Slide 16

Slide 16 text

$143.09 $334.64

Slide 17

Slide 17 text

No content

Slide 18

Slide 18 text

$143.09 $334.64 H$59.91 H$709.32

Slide 19

Slide 19 text

H$709.32

Slide 20

Slide 20 text

No content

Slide 21

Slide 21 text

moviestock ticker starbond price (in $m) that market thinks movie will make in first 4 weeks @ B/O

Slide 22

Slide 22 text

H$720.33 H$812.73

Slide 23

Slide 23 text

No content

Slide 24

Slide 24 text

No content

Slide 25

Slide 25 text

starbond ticker

Slide 26

Slide 26 text

starbond ticker

Slide 27

Slide 27 text

arbitrage

Slide 28

Slide 28 text

1 2 3 4 5

Slide 29

Slide 29 text

1 2 3 4 5 6.82 1.98 3.71 812.73 6.91

Slide 30

Slide 30 text

1 2 3 4 5 6.82 1.98 3.71 812.73 6.91

Slide 31

Slide 31 text

1 2 3 4 5 46.35 6.82 1.98 3.71 812.73 6.91

Slide 32

Slide 32 text

1 2 3 4 5 6.82 1.98 3.71 812.73 6.91 46.35

Slide 33

Slide 33 text

automate

Slide 34

Slide 34 text

chrome extension: http://selectorgadget.com/

Slide 35

Slide 35 text

library(tidyverse) library(rvest) library(stringr) url <- "https://www.hsx.com/security/view/ADRIV" movie <- read_html(url) %>% html_nodes(".credit a") %>% html_text() link <- read_html(url) %>% html_nodes(".credit a") %>% html_attr("href") date <- read_html(url) %>% html_nodes("strong") %>% html_text() %>% .[1:length(link)] df <- tibble(date, movie, link)

Slide 36

Slide 36 text

library(tidyverse) library(rvest) library(stringr) url <- "https://www.hsx.com/security/view/ADRIV" movie <- read_html(url) %>% html_nodes(".credit a") %>% html_text() link <- read_html(url) %>% html_nodes(".credit a") %>% html_attr("href") date <- read_html(url) %>% html_nodes("strong") %>% html_text() %>% .[1:length(link)] df <- tibble(date, movie, link) text value selector

Slide 37

Slide 37 text

library(tidyverse) library(rvest) library(stringr) url <- "https://www.hsx.com/security/view/ADRIV" movie <- read_html(url) %>% html_nodes(".credit a") %>% html_text() link <- read_html(url) %>% html_nodes(".credit a") %>% html_attr("href") date <- read_html(url) %>% html_nodes("strong") %>% html_text() %>% .[1:length(link)] df <- tibble(date, movie, link) text value underlying link ticker garbage selector

Slide 38

Slide 38 text

library(tidyverse) library(rvest) library(stringr) url <- "https://www.hsx.com/security/view/ADRIV" movie <- read_html(url) %>% html_nodes(".credit a") %>% html_text() link <- read_html(url) %>% html_nodes(".credit a") %>% html_attr("href") date <- read_html(url) %>% html_nodes("strong") %>% html_text() %>% .[1:length(link)] df <- tibble(date, movie, link) text value underlying link ticker garbage selector

Slide 39

Slide 39 text

get_movies <- function(ticker) { url <- str_c( "https://www.hsx.com/security/view/", toupper(ticker)) movie <- read_html(url) %>% html_nodes(".credit a") %>% html_text() link <- read_html(url) %>% html_nodes(".credit a") %>% html_attr("href") date <- read_html(url) %>% html_nodes("strong") %>% html_text() %>% .[1:length(link)] return(df) } wrap in function

Slide 40

Slide 40 text

View(adam_driver) adam_driver <- get_movies('adriv')

Slide 41

Slide 41 text

No content

Slide 42

Slide 42 text

No content

Slide 43

Slide 43 text

No content

Slide 44

Slide 44 text

get_price <- function(link) { if (substr(link, 0, 1) == '/') { url <- str_c('https://www.hsx.com', link) } else { url <- str_c('https://www.hsx.com/security/view/',toupper(link)) } df <- read_html(url) %>% html_nodes(".value") %>% html_text() %>% as_tibble() %>% mutate(value = parse_number( str_extract(., "(?<=\\$)[^\\s]+"))) %>% rename(price = value) %>% bind_cols(link = tibble(link)) return(df) } get_price('/security/view/STAR8') get_price('adriv')

Slide 45

Slide 45 text

get_price <- function(link) { if (substr(link, 0, 1) == '/') { url <- str_c('https://www.hsx.com', link) } else { url <- str_c('https://www.hsx.com/security/view/',toupper(link)) } df <- read_html(url) %>% html_nodes(".value") %>% html_text() %>% as_tibble() %>% mutate(value = parse_number( str_extract(., "(?<=\\$)[^\\s]+"))) %>% rename(price = value) %>% bind_cols(link = tibble(link)) return(df) } get_price('/security/view/STAR8') get_price('adriv')

Slide 46

Slide 46 text

get_price <- function(link) { if (substr(link, 0, 1) == '/') { url <- str_c('https://www.hsx.com', link) } else { url <- str_c('https://www.hsx.com/security/view/',toupper(link)) } df <- read_html(url) %>% html_nodes(".value") %>% html_text() %>% as_tibble() %>% mutate(value = parse_number( str_extract(., "(?<=\\$)[^\\s]+"))) %>% rename(price = value) %>% bind_cols(link = tibble(link)) return(df) } get_price('/security/view/STAR8') get_price('adriv')

Slide 47

Slide 47 text

get_price <- function(link) { if (substr(link, 0, 1) == '/') { url <- str_c('https://www.hsx.com', link) } else { url <- str_c('https://www.hsx.com/security/view/',toupper(link)) } df <- read_html(url) %>% html_nodes(".value") %>% html_text() %>% as_tibble() %>% mutate(value = parse_number( str_extract(., "(?<=\\$)[^\\s]+"))) %>% rename(price = value) %>% bind_cols(link = tibble(link)) return(df) } get_price('/security/view/STAR8') get_price('adriv')

Slide 48

Slide 48 text

> get_price(‘/security/view/STAR8') # A tibble: 1 x 2 price link 1 720.33 /security/view/STAR8 > get_price(‘adriv') # A tibble: 1 x 2 price link 1 59.91 adriv

Slide 49

Slide 49 text

> get_price(‘/security/view/STAR8') # A tibble: 1 x 2 price link 1 720.33 /security/view/STAR8 > get_price(‘adriv') # A tibble: 1 x 2 price link 1 59.91 adriv

Slide 50

Slide 50 text

No content

Slide 51

Slide 51 text

get_prices <- function(df) { params <- df %>% select(link) prices <- pmap(params, get_price) %>% bind_rows() df <- prices %>% left_join(df, by = "link") return(df) } adam_driver <- get_movies('adriv') %>% get_prices(.)

Slide 52

Slide 52 text

get_prices <- function(df) { params <- df %>% select(link) prices <- pmap(params, get_price) %>% bind_rows() df <- prices %>% left_join(df, by = "link") return(df) } adam_driver <- get_movies('adriv') %>% get_prices(.)

Slide 53

Slide 53 text

get_prices <- function(df) { params <- df %>% select(link) prices <- pmap(params, get_price) %>% bind_rows() df <- prices %>% left_join(df, by = "link") return(df) } adam_driver <- get_movies('adriv') %>% get_prices(.)

Slide 54

Slide 54 text

clean

Slide 55

Slide 55 text

forward_tag <- function(df) { tag <- df %>% mutate(date = as.Date(date, "%b %d, %Y")) %>% drop_na() %>% mutate(days = date - Sys.Date()) %>% mutate(future = ifelse(days >= 0, 'Yes', 'No')) %>% mutate(days = abs(days)) %>% group_by(future) %>% arrange(desc(future), days) %>% mutate(idx = row_number()) %>% ungroup() %>% filter((idx == 1 & future == 'Yes') | (future == "No" & idx <= 5)) forward <- tag %>% filter(idx <= 4) %>% pull(price) %>% mean(.) %>% round(., 2) return(forward) }

Slide 56

Slide 56 text

adam_driver <- get_movies('adriv') %>% get_prices(.) get_price('adriv') %>% pull(price) [1] 59.91 forward_tag(adam_driver) [1] 173.89

Slide 57

Slide 57 text

adam_driver <- get_movies('adriv') %>% get_prices(.) get_price('adriv') %>% pull(price) [1] 59.91 forward_tag(adam_driver) [1] 173.89

Slide 58

Slide 58 text

real money**

Slide 59

Slide 59 text

No content

Slide 60

Slide 60 text

No content

Slide 61

Slide 61 text

run the ball throw the ball catch the ball hybrid +kick the ball +entire defence catch the ball

Slide 62

Slide 62 text

data

Slide 63

Slide 63 text

No content

Slide 64

Slide 64 text

No content

Slide 65

Slide 65 text

fetch_espn <- function(position = 0, offset = 0) { url <- str_c(sep = "", "http://games.espn.com/ffl/tools/projections?", "&slotCategoryId=", position, "&startIndex=", offset) page <- read_html(url) df <- page %>% html_node("#playertable_0") %>% html_table() return(df) } df <- fetch_espn(position = 16, offset = 0)

Slide 66

Slide 66 text

fetch_proj <- function(position = 0, offset = 0) { url <- str_c(sep = "", "http://games.espn.com/ffl/tools/projections?", "&slotCategoryId=", position, "&startIndex=", offset) page <- read_html(url) df <- page %>% html_node("#playertable_0") %>% html_table() return(df) } df <- fetch_proj(position = 0, offset = 0)

Slide 67

Slide 67 text

df <- fetch_proj(position = 0, offset = 0) View(df)

Slide 68

Slide 68 text

params <- expand.grid( position = c(0, 2, 4, 6, 16, 17), offset = seq(0, 320, 40)) espn_raw <- pmap(params, fetch_espn) %>% bind_rows()

Slide 69

Slide 69 text

params <- expand.grid( position = c(0, 2, 4, 6, 16, 17), offset = seq(0, 320, 40)) espn_raw <- pmap(params, fetch_espn) %>% bind_rows()

Slide 70

Slide 70 text

params <- expand.grid( position = c(0, 2, 4, 6, 16, 17), offset = seq(0, 320, 40)) espn_raw <- pmap(params, fetch_espn) %>% bind_rows() fetch_espn(position = __, offset = __ )

Slide 71

Slide 71 text

No content

Slide 72

Slide 72 text

params <- expand.grid( position = c(0, 2, 4, 6, 16, 17), offset = seq(0, 320, 40)) raw <- pmap(params, fetch_proj) %>% bind_rows()

Slide 73

Slide 73 text

View(raw)

Slide 74

Slide 74 text

clean

Slide 75

Slide 75 text

proj <- raw %>% mutate(PLAYERS = ifelse(is.na(PLAYERS), `DEFENSIVE PLAYERS`, PLAYERS)) %>% select(name = PLAYERS, points = TOTAL) %>% mutate(points = parse_number(points)) %>% drop_na() %>% separate(name, into = c("name", "metadata"), sep = ", ", fill = "right") %>% mutate(name = str_replace(name, "D\\/ST\\sD\\/ST|\\*$","")) %>% mutate(metadata = str_replace(metadata, "^[^\\s]*\\s","")) %>% mutate(metadata = str_replace(metadata, "IR|Q$|O|SSPD|D", "")) %>% mutate(metadata = str_trim(metadata)) %>% mutate(position = ifelse(is.na(metadata), "DEF", metadata)) %>% select(position, name, points)

Slide 76

Slide 76 text

View(proj)

Slide 77

Slide 77 text

bad <- proj %>% group_by(position) %>% mutate(avg = mean(points)) %>% mutate(vorp = points - avg) %>% select(position, name, points, vorp) %>% arrange(desc(vorp))

Slide 78

Slide 78 text

x2 x1 x3 x1 K x1 DEF x1 10 people

Slide 79

Slide 79 text

params <- tribble( ~pos, ~slots, "QB", 1, "WR", 3, "RB", 2, "TE", 1, "K", 1, "DEF", 1 ) %>% mutate(slots = slots * 10) replacement_player <- function(pos, slots) { rp <- proj %>% filter(position == pos) %>% arrange(desc(points)) %>% filter(row_number() <= slots) %>% group_by(position) %>% summarise(rp = mean(points)) return(rp) } rp <- pmap(params, replacement_player) %>% bind_rows()

Slide 80

Slide 80 text

rp <- pmap(params, replacement_player) %>% bind_rows() proj_vorp <- proj %>% left_join(rp, by = "position") %>% mutate(vorp = points - rp) %>% select(position, name, points, vorp) %>% arrange(desc(vorp))

Slide 81

Slide 81 text

No content

Slide 82

Slide 82 text

* *probably not. and i’m not liable if you lose money. disclaimer. disclaimer. disclaimer.

Slide 83

Slide 83 text

preferably with rvest & purrr

Slide 84

Slide 84 text

obey robots.txt

Slide 85

Slide 85 text

thanks!!

Slide 86

Slide 86 text

maxhumber