Skip to content

Instantly share code, notes, and snippets.

@jalapic
Created July 12, 2015 18:33
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jalapic/a0d269730f18252e592f to your computer and use it in GitHub Desktop.
Save jalapic/a0d269730f18252e592f to your computer and use it in GitHub Desktop.
grand slam data
library("rvest")
html=html("https://en.wikipedia.org/wiki/List_of_Grand_Slam_women%27s_singles_champions")
tmp <- html_table(html_nodes(html, "table")[[1]], fill=T)
library(tidyr)
tmp <- tmp %>% gather(key,value,2:5)
tmp <- tmp[!grepl("tournament", tmp$value),]
tmp <- tmp[!grepl("started", tmp$value),]
tmp <- tmp[!grepl("Evonne Goolagong Cawley", tmp$Year),]
tmp <- rbind(tmp,data.frame(Year='1977', key = 'Australian Open', value='Evonne Goolagong Cawley'))
tmp$value <- gsub('\\(.*\\)', '', tmp$value)
tmp <- tmp[!grepl("competition", tmp$value),]
tmp$value <- gsub(".*:","",tmp$value) #remove country codes
tmp$value <- gsub(".*\\,","",tmp$value)
tmp <- tmp[!grepl("\\*", tmp$value),]
tmp <- tmp[!grepl("\u2020\u2020\u2020", tmp$value),]
tmp$value <- gsub('\u2020', "", tmp$value)
tmp$value <- gsub('Amateur era tennis ends', "", tmp$value)
tmp$value <- gsub('Open era tennis begins\n', "", tmp$value)
trim <- function (x) gsub("^\\s+|\\s+$", "", x)
tmp$value <- trim(tmp$value)
tmp <- tmp[-424,]
library(dplyr)
tmp <- tmp %>% arrange(value)
tmp$Year <- as.numeric(as.character(tmp$Year))
tmp0 <- tmp %>% group_by(value) %>% arrange(Year) %>% filter(row_number()==1) %>% mutate(Year=Year-0.5, title=0)
tmp <- tmp %>% group_by(value) %>% arrange(Year) %>% mutate(title = row_number())
tmpx <- rbind(tmp0,tmp) %>% arrange(value,title) %>% select(year=Year, comp=key, name=value, title)
# for each player breakdown of each title type
tmpx <-
tmpx %>% group_by(name) %>% mutate(TOT = n(),
AUS = sum(comp=="Australian Open"),
FRA = sum(comp=="French Open"),
WIM = sum(comp=="Wimbledon"),
US = sum(comp=="US Open"))
setwd("C:/MAMP/htdocs/data")
write.table(tmpx, "tennis.csv", sep=",", row.names=F)
#### update: change format of accented letters
df <- read.csv("tennis1.csv",stringsAsFactors = F)
unwanted_array = list( 'Š'='S', 'š'='s', 'Ž'='Z', 'ž'='z', 'À'='A', 'Á'='A', 'Â'='A', 'Ã'='A', 'Ä'='A', 'Å'='A', 'Æ'='A', 'Ç'='C', 'È'='E', 'É'='E',
'Ê'='E', 'Ë'='E', 'Ì'='I', 'Í'='I', 'Î'='I', 'Ï'='I', 'Ñ'='N', 'Ò'='O', 'Ó'='O', 'Ô'='O', 'Õ'='O', 'Ö'='O', 'Ø'='O', 'Ù'='U',
'Ú'='U', 'Û'='U', 'Ü'='U', 'Ý'='Y', 'Þ'='B', 'ß'='Ss', 'à'='a', 'á'='a', 'â'='a', 'ã'='a', 'ä'='a', 'å'='a', 'æ'='a', 'ç'='c',
'è'='e', 'é'='e', 'ê'='e', 'ë'='e', 'ì'='i', 'í'='i', 'î'='i', 'ï'='i', 'ð'='o', 'ñ'='n', 'ò'='o', 'ó'='o', 'ô'='o', 'õ'='o',
'ö'='o', 'ø'='o', 'ù'='u', 'ú'='u', 'û'='u', 'ý'='y', 'ý'='y', 'þ'='b', 'ÿ'='y' )
df$player<-chartr(paste(names(unwanted_array), collapse=''),
paste(unwanted_array, collapse=''),
df$player)
write.table(df, "tennis1.csv", sep=",", row.names=F)
############## Men's
library("rvest")
html=html("https://en.wikipedia.org/wiki/List_of_Grand_Slam_men%27s_singles_champions")
tmp <- html_table(html_nodes(html, "table")[[1]],fill=T)
library(tidyr)
tmp <- tmp %>% gather(key,value,2:5)
tmp <- tmp[!grepl("tournament",tmp$value),]
tmp <- tmp[!grepl("started",tmp$value),]
tmp <- tmp[!grepl("Vitas Gerulaitis", tmp$Year),]
tmp <- rbind(tmp,data.frame(Year='1977', key = 'Australian Open', value='Vitas Gerulaitis'))
tmp$value <- gsub('\\(.*\\)', '', tmp$value)
tmp <- tmp[!grepl("competition", tmp$value),]
tmp$value <- gsub(".*:","",tmp$value) #remove country codes
tmp$value <- gsub(".*\\,","",tmp$value)
tmp <- tmp[!grepl("\\*\\*\\*", tmp$value),] #remove 3 stars
tmp$value <- gsub("\\*\\*","",tmp$value) #2stars ok
tmp <- tmp[!grepl("\\*", tmp$value),] #remove remaining one stars
tmp$value <- gsub('\u2020', "", tmp$value)
tmp$value <- gsub('\nAmateur era tennis ends', "", tmp$value)
tmp$value <- gsub('Open era tennis begins\n ', "", tmp$value)
trim <- function (x) gsub("^\\s+|\\s+$", "", x)
tmp$value <- trim(tmp$value)
tmp <- tmp[-451,]
library(dplyr)
tmp <- tmp %>% arrange(value)
tmp$Year <- as.numeric(as.character(tmp$Year))
tmp0 <- tmp %>% group_by(value) %>% arrange(Year) %>% filter(row_number()==1) %>% mutate(Year=Year-0.5, title=0)
tmp <- tmp %>% group_by(value) %>% arrange(Year) %>% mutate(title = row_number())
tmpx <- rbind(tmp0,tmp) %>% arrange(value,title) %>% select(year=Year, comp=key, name=value, title)
# for each player breakdown of each title type
tmpx <-
tmpx %>% group_by(name) %>% mutate(TOT = n(),
AUS = sum(comp=="Australian Open"),
FRA = sum(comp=="French Open"),
WIM = sum(comp=="Wimbledon"),
US = sum(comp=="US Open"))
#### update: change format of accented letters
unwanted_array = list( 'Š'='S', 'š'='s', 'Ž'='Z', 'ž'='z', 'À'='A', 'Á'='A', 'Â'='A', 'Ã'='A', 'Ä'='A', 'Å'='A', 'Æ'='A', 'Ç'='C', 'È'='E', 'É'='E',
'Ê'='E', 'Ë'='E', 'Ì'='I', 'Í'='I', 'Î'='I', 'Ï'='I', 'Ñ'='N', 'Ò'='O', 'Ó'='O', 'Ô'='O', 'Õ'='O', 'Ö'='O', 'Ø'='O', 'Ù'='U',
'Ú'='U', 'Û'='U', 'Ü'='U', 'Ý'='Y', 'Þ'='B', 'ß'='Ss', 'à'='a', 'á'='a', 'â'='a', 'ã'='a', 'ä'='a', 'å'='a', 'æ'='a', 'ç'='c',
'è'='e', 'é'='e', 'ê'='e', 'ë'='e', 'ì'='i', 'í'='i', 'î'='i', 'ï'='i', 'ð'='o', 'ñ'='n', 'ò'='o', 'ó'='o', 'ô'='o', 'õ'='o',
'ö'='o', 'ø'='o', 'ù'='u', 'ú'='u', 'û'='u', 'ý'='y', 'ý'='y', 'þ'='b', 'ÿ'='y' )
head(tmpx)
tmpx$name<-chartr(paste(names(unwanted_array), collapse=''),
paste(unwanted_array, collapse=''),
tmpx$name)
setwd("C:/MAMP/htdocs/data")
write.table(tmpx, "tennis2.csv", sep=",", row.names=F)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment