#' @export
current_season <- function() {
dplyr::if_else(as.double(substr(Sys.Date(), 6, 7)) >= 10,
as.double(substr(Sys.Date(), 1, 4)) + 1, as.double(substr(Sys.Date(),
1, 4)))
}
#' @export
bart_tourney_sheets <- function(year=current_season()) {
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2019)) {
cli::cli_abort('Enter a valid year as a number (YYYY). Data only goes back to 2019!')
}
else {
x <- httr::GET(paste0('https://barttorvik.com/teamsheets.php?year=',year)) %>%
httr::content(as = "text") %>%
rvest::read_html() %>%
rvest::html_table() %>%
purrr::pluck(1) %>%
janitor::row_to_names(row=1) %>%
janitor::clean_names() %>%
tidyr::separate(team, into=c('team','seed'), sep='(?<=\\D) (?=[0-9])')
x <- x %>%
dplyr::select(-1) %>%
dplyr::mutate(across(c(2:10), as.numeric)) %>%
dplyr::rename('res_avg'=6, 'qual_avg'=10)
return(x) }
})}
#' @export
bart_season_schedule <- function(year=current_season()) {
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)) {
cli::cli_abort("Enter a valid year as a number (YYYY). Data only goes back to 2008!") }
else{
names <- c('date', 'type','neutral','home','away','game_id')
x <- utils::read.csv(paste0('https://barttorvik.com/',year,'_master_sked.csv'), header=FALSE) %>%
dplyr::select(c(2,3,4,6,5,3,1))
colnames(x) <- names
x <- x %>% dplyr::mutate(date=lubridate::mdy(date),
type=dplyr::case_when(type==0~'nc',
type==1~'conf',
type==2~'conf_t',
type==3~'post',
TRUE~'nond1'),
neutral=dplyr::case_when(neutral==1~'yes',
TRUE~'no'))
return(x) }
})}
#' @export
bart_team_shooting <- function(year=current_season()) {
suppressWarnings({
names <- c('team', 'conf','dunk_fg','dunk_share','dunk_fg_d', 'dunk_share_d','close_fg','close_share','close_fg_d','close_share_d','far_fg','far_share','far_fg_d','far_share_d','three_fg','three_share','three_fg_d','three_share_d')
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2010)) {
cli::cli_abort("Enter a valid year as a number (YYYY). Data only goes back to 2010!")
}
else {
x <- httr::GET(paste0('https://barttorvik.com/teampbptot.php?year=',year)) %>%
httr::content(as = "text") %>%
rvest::read_html() %>%
rvest::html_table() %>%
purrr::pluck(1) %>%
subset(select=-c(1, seq(7, 22, 5)))
colnames(x) <- names
x <- x[!(x$team == ""), ]
x <- x %>% tidyr::separate(team, into=c('team','seed'), sep='(?<=\\D) (?=[0-9])') %>%
dplyr::mutate(across(c(2, seq(5,19,2)), as.numeric), year=year)
return(x)
}})}
#' @export
bart_player_season <- function(year=current_season(), stat=NULL) {
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)) {
cli::cli_abort('Enter a valid year as a number (YYYY). Data only goes back to 2008')
}
if(is.null(stat)) {
cli::cli_abort("Please input a valid stat command ('box,' 'shooting', or 'adv')")
}
if(!(stat %in% c('box','shooting','adv'))) {
cli::cli_abort("Please input a valid stat command ('box,' 'shooting', or 'adv')")
}
if(stat=='box') {
names <- c('player','pos','exp','hgt','team','conf','g','mpg','ppg','oreb',
'dreb','rpg','apg','ast_to', 'spg','bpg','num','year', 'id')
x <- utils::read.csv(paste0('https://barttorvik.com/getadvstats.php?year=',year,'&csv=1'), header=FALSE)
y <- x %>% dplyr::mutate(across(c(17, 18, 20, 21, 43, 44), as.numeric))
y <- y %>% dplyr::group_by(V33) %>% dplyr::summarize(fga=sum(V18,V21,V44, na.rm=TRUE),
fgm=sum(V17,V20,V43, na.rm=TRUE),
fg_pct=fgm/fga) %>%
dplyr::rename('id'=1)
x <- x %>% dplyr::select(1, 65, 26, 27, 2:4, 55, 64, 58:61, 36, 62, 63, 28, 32, 33) %>%
dplyr::mutate(across(c(7:17), as.numeric))
colnames(x) <- names
x <- dplyr::left_join(x, (y %>% dplyr::select(1, 4)), by='id') %>%
dplyr::relocate(fg_pct, .before=oreb) %>% dplyr::arrange(desc(ppg))
return(x) }
if(stat=='shooting') {
names <- c('player','pos', 'exp','team','conf','g','mpg','ppg','usg','ortg','efg','ts',
'ftm','fta','ft_pct','two_m','two_a','two_pct','three_m','three_a',
'three_pct','dunk_m','dunk_a','dunk_pct','rim_m','rim_a','rim_pct',
'mid_m','mid_a','mid_pct', 'id')
x <- utils::read.csv(paste0('https://barttorvik.com/getadvstats.php?year=',year,'&csv=1'), header=FALSE) %>%
dplyr::select(1, 65, 26, 2:4, 55, 64, 7, 6, 8, 9, 14:22, 43:45, 37, 38, 41, 39, 40,
42, 33)
colnames(x) <- names
x <- x %>% dplyr::mutate(p_per=((40*ppg)/mpg), .after=ppg) %>% arrange(desc(ppg))
return(x)
}
if(stat=='adv') {
names <- c('player', 'pos', 'exp', 'team','conf','g','min','porpag','dporpag','ortg','adj_oe','drtg','adj_de',
'stops', 'obpm','dbpm','bpm', 'oreb','dreb','ast','to','blk','stl','ftr','pfr',
'rec','pick','id')
x <- utils::read.csv(paste0('https://barttorvik.com/getadvstats.php?year=',year,'&csv=1'), header=FALSE) %>%
dplyr::select(1, 65, 26, 2:5,29,49,6,30,47,48,50,56,57,54,10:13,23:25,31,35,46,33)
colnames(x) <- names
x <- x %>% arrange(desc(rec))
return(x) }
})}
#' @export
bart_player_game <- function(year=current_season(), stat=NULL) {
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)) {
cli::cli_abort('Enter a valid year as a number. Data only goes back to 2008!')
}
if(!(is.character(stat) && stat %in% c('box','shooting','adv'))) {
cli::cli_abort("Please input a valid stat command ('box,' 'shooting', or 'adv')")
}
if(stat=='box') {
names <- c('date','player','exp','team','opp','result','min','pts','two_m','two_a','three_m',
'three_a','ftm','fta','oreb','dreb','ast','tov','stl','blk', 'pf','id','game_id')
x <- jsonlite::fromJSON(paste0('https://barttorvik.com/',year,'_all_advgames.json')) %>%
as.data.frame() %>% select(1,49,51,48,6,5,9,34,24:29,35,36,37,38,39,40,43,52,7)
colnames(x) <- names
x <- x %>% dplyr::mutate(date=lubridate::ymd(date),
across(c(7:16), as.numeric),
reb=oreb+dreb, .after=dreb,
result=case_when(result=='1'~'W',
TRUE~'L'),
year=year) %>%
dplyr::mutate(fgm=two_m+three_m,
fga=two_a+three_a,
.after=three_a) %>%
dplyr::relocate(year, .after=date)
return(x) }
if(stat=='shooting') {
names <- c('date','player','exp','team','opp','result','min','pts','usg','efg','ts','dunk_m','dunk_a',
'rim_m','rim_a','mid_m','mid_a','two_m','two_a','three_m','three_a','ftm','fta','id','game_id')
x <- jsonlite::fromJSON(paste0('https://barttorvik.com/',year,'_all_advgames.json')) %>%
as.data.frame() %>% select(1,49,51,48,6,5,9,34,11:13,18:29,52,7)
colnames(x) <- names
x <- x %>% dplyr::mutate(date=lubridate::ymd(date),
across(c(7:24), as.numeric),
fg=(two_m+three_m)/(two_a+three_a)*100, .before=efg,
result=case_when(result=='1'~'W',
TRUE~'L'),
year=year) %>% dplyr::relocate(year, .after=date)
return(x) }
if(stat=='adv') {
names <- c('date','player','exp','team','opp','result','min','pts','usg','ortg','or_pct','dr_pct',
'ast_pct','to_pct','stl_pct','blk_pct','bpm','obpm','dbpm','net','poss','id','game_id')
x <- jsonlite::fromJSON(paste0('https://barttorvik.com/',year,'_all_advgames.json')) %>%
as.data.frame() %>% select(1,49,51,48,6,5,9,34,11,10,14:17,41:42,30:33,44,52,7)
colnames(x) <- names
x <- x %>% dplyr::mutate(date=lubridate::ymd(date),
across(c(7:22), as.numeric),
result=case_when(result=='1'~'W',
TRUE~'L'),
year=year, .after=date)
return(x) }
})}
#' @export
bart_team_schedule <- function(year=current_season(), team=NULL) {
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)){
cli::cli_abort('Enter a valid year as a number. Data only goes back to 2008!')
}
else {
team <- gsub(" ","+", team)
names <- c('date','type','team','conf','opp','loc','result','adj_o','adj_d','ppp','efg',
'to','or','ftr','def_ppp','def_efg','def_to','def_or','def_ftr','game_score',
'opp_conf','year','poss','game_id','coach','opp_coach','lead_diff')
x <- jsonlite::fromJSON(paste0('https://barttorvik.com/getgamestats.php?year=', year,'&tvalue=',team)) %>%
as.data.frame() %>%
dplyr::select(-c(22, 28:30))
colnames(x) <- names
x <- x %>% dplyr::mutate(type=case_when(type==0~'nc',
type==1~'conf',
type==2~'conf_t',
type==3~'post'),
date=lubridate::mdy(date)) %>%
tidyr::separate(result, into=c('result','score'), sep=',') %>%
tidyr::separate(score, into=c('win','loss'), sep='-') %>%
dplyr::mutate(points=case_when(result=='W'~win,
TRUE~loss),
opp_points=case_when(result=='W'~loss,
TRUE~win)) %>%
dplyr::select(-c(8:9)) %>%
dplyr::relocate(points, .after=result) %>%
dplyr::relocate(opp_points, .after=points) %>%
dplyr::relocate(opp_conf, .before=loc) %>%
dplyr::relocate(lead_diff, .after=opp_points) %>%
relocate(game_id, .after=last_col()) %>%
arrange(desc(date))
return(x) }
}
)}
#' @export
bart_pregame <- function(year=current_season()) {
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)){
cli::cli_abort('Enter a valid year as a number. Data only goes back to 2008!')
}
else {
names <- c('date','conf','line','ttq','type', 'team1','team1_wp','team1_pts','team2','team2_wp','team2_pts','game_id')
x <- utils::read.csv(paste0('https://barttorvik.com/',year,'_super_sked.csv'), header=FALSE) %>%
dplyr::select(2,3,5:7,9,53,14,15,54,20,1)
colnames(x) <- names
x <- x %>% dplyr::mutate(type=case_when(type==0~'nc',
type==1~'conf',
type==2~'conf_t',
type==3~'post',
type==99~'d2+'),
date=lubridate::mdy(date),
across(c(4,7,8,10,11), as.numeric),
year=year)
return(x) }
})}
#' @export
bart_game_total <- function(year=current_season()) {
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)){
cli::cli_abort('Enter a valid year as a number. Data only goes back to 2008!')
}
else {
abbrev <- c('fgm','fga','tpm','tpa','ftm','fta','oreb','dreb','reb','ast','stl','blk','to','pf','pts')
names <- c('game_id','date','min','team1','team2', 'pos','win','loss')
x <- jsonlite::fromJSON(paste0('https://barttorvik.com/',year,'_season.json')) %>%
as.data.frame()
x <- x %>%
dplyr::select(-37) %>%
dplyr::rename_at(c(1:5, 36:38), ~paste0(names)) %>%
dplyr::rename_at(6:20, ~paste0('team1_', abbrev)) %>%
dplyr::rename_at(21:35, ~paste0('team2_', abbrev)) %>%
dplyr::relocate(game_id, .after=loss) %>%
dplyr::mutate(date=lubridate::mdy(date),
across(c(2, 35), as.numeric)) %>%
dplyr::arrange(desc(date))
return(x) } }
)}
#' @export
bart_coach_change <- function(year=current_season()) {
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)) {
cli::cli_abort('Enter a valid year as a number. Data only goes back to 2008!') }
else {
x <- httr::GET(paste0('https://barttorvik.com/coaching_moves.php?year=',year)) %>%
httr::content(as = "text") %>%
rvest::read_html() %>%
rvest::html_table(header = FALSE) %>%
purrr::pluck(1) %>%
janitor::row_to_names(row=1) %>%
janitor::clean_names()
return(x) }
})}
#' @export
bart_tourney_odds <- function(year=current_season(), odds='current') {
suppressWarnings({
lookup <- list(
'current'='cur',
'pre'='pre',
'recent'='l10',
't100'='t100'
)
odds <- lookup[odds]
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2018)) {
cli::cli_abort('Enter a valid year as a number (YYYY). Data only goes back to 2018!')
}
if(!(odds %in% c('cur','pre','l10','t100'))) {
cli::cli_abort("Please input a valid odds variable ('current', 'pre', 'recent', or 't100')")
}
if(year >= 2022) {
x <- httr::GET(paste0('https://barttorvik.com/tourneytime.php?conlimit=All&src=',odds,'&year=', year)) %>%
httr::content(as = "text") %>%
rvest::read_html() %>%
rvest::html_table(header = FALSE) %>%
purrr::pluck(1) %>%
janitor::row_to_names(row=1) %>%
janitor::clean_names() %>%
dplyr::mutate_all(funs(stringr::str_replace(., '✓','100'))) %>%
dplyr::mutate(across(c(1, 5:11), as.numeric))
return(x) }
if(year < 2022) {
x <- httr::GET(paste0('https://barttorvik.com/tourneytime.php?conlimit=All&src=',odds,'&year=', year)) %>%
httr::content(as = "text") %>%
rvest::read_html() %>%
rvest::html_table(header = FALSE) %>%
purrr::pluck(1) %>%
janitor::row_to_names(row=1) %>%
janitor::clean_names() %>%
dplyr::select(-2) %>%
dplyr::mutate_all(funs(stringr::str_replace(., '✓','100'))) %>%
dplyr::mutate(across(c(1, 4:10), as.numeric))
return(x) }
})}
#' @export
bart_factors <- function(year=current_season(),venue='all',type='all',quad='4', start=NULL, end=NULL) {
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)) {
cli::cli_abort('Enter a valid year as a number (YYYY). Data only goes back to 2008!') }
if(!(is.character(quad))) {
cli::cli_abort("Please enter quadrant cutoff as a character value (e.g. '4')")
}
x_names <- c('team','barthag','rec','wins','games','adj_t','adj_o','off_efg','off_to','off_or','off_ftr','adj_d','def_efg',
'def_to','def_or','def_ftr')
y_names <- c('team','conf')
venue_lookup <- list(
'all'='All',
'home'='H',
'away'='A',
'neutral'='N',
'road'='A-N'
)
v <- venue_lookup[venue]
type_lookup <- list (
'all'='All',
'nc'='N',
'conf'='C',
'reg'='R',
'post'='P',
'ncaa'='T'
)
t <- type_lookup[type]
quad_lookup <- list (
'0'='1',
'1'='2',
'2'='3',
'3'='4',
'4'='5'
)
q <- quad_lookup[quad]
y <- httr::GET(paste0('https://barttorvik.com/sos.php?year=',year,'&csv=1')) %>%
httr::content(as = "text") %>%
rvest::read_html() %>%
rvest::html_table(header = FALSE) %>%
purrr::pluck(1) %>%
janitor::row_to_names(row=2) %>%
janitor::clean_names() %>%
select(2:3) %>%
tidyr::separate(team, into=c('team', NA), sep="(?<=[A-Za-z.]) (?=[0-9])")
colnames(y) <- y_names
if(is.null(start) && is.null(end)) {
x <- utils::read.csv(paste0('https://barttorvik.com/trank.php?year=',year,'&revquad=0&quad=',q,'&venue=',v,'&type=',t,'&csv=1'), header=FALSE) %>%
as.data.frame() %>%
dplyr::select(1,4,5,6,7,27,2,8,12,14,10,3,9,13,15,11)
colnames(x) <- x_names
x <- x %>% dplyr::mutate(across(c(2, 4:13), as.numeric),
year=year,
venue=venue,
type=type,
quad=paste0(quad,'+'))
x <- left_join(x,y, by='team') %>% dplyr::relocate(conf, .after=team) %>%
dplyr::arrange(desc(barthag)) }
if(!(is.null(start) && is.null(end))) {
x <- utils::read.csv(paste0('https://barttorvik.com/trank.php?year=',year,'&sort=&hteam=&t2value=&begin=',start,'&end=',end,'&revquad=0&quad=',q,'&venue=',v,'&type=',t,'&csv=1'), header=FALSE) %>%
as.data.frame() %>%
dplyr::select(1,4,5,6,7,27,2,8,12,14,10,3,9,13,15,11)
colnames(x) <- x_names
x <- x %>% dplyr::mutate(across(c(2, 4:13), as.numeric),
year=year,
venue=venue,
type=type,
quad=paste0(quad,'+'),
start=start,
end=end)
x <- left_join(x,y, by='team') %>% dplyr::relocate(conf, .after=team) %>%
dplyr::arrange(desc(barthag)) }
return(x) })}
#' @export
bart_ratings <- function(year=current_season()){
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)) {
cli::cli_abort('Enter a valid year as a number (YYYY). Data only goes back to 2008!')
}
else {
x_names <- c('team','barthag','adj_o','adj_d','adj_t')
y_names <- c('team','seed','conf','nc_elite_sos','nc_fut_sos','nc_cur_sos',
'ov_elite_sos', 'ov_fut_sos','ov_cur_sos')
x <- utils::read.csv(paste0('https://barttorvik.com/trank.php?year=',year,'&csv=1'), header = FALSE) %>%
as.data.frame() %>%
dplyr::select(1,4,2,3,27)
colnames(x) <- x_names
y <- httr::GET(paste0('https://barttorvik.com/sos.php?year=',year,'&csv=1')) %>%
httr::content(as = "text") %>%
rvest::read_html() %>%
rvest::html_table(header = FALSE) %>%
purrr::pluck(1) %>%
janitor::row_to_names(row=2) %>%
janitor::clean_names() %>%
select(-1) %>%
dplyr::mutate_at(3:8, funs(parse_number(.))) %>%
tidyr::separate(team, into=c('team', 'seed'), sep="(?<=[A-Za-z.]) (?=[0-9])",
convert=TRUE)
colnames(y) <- y_names
x <- dplyr::left_join(x,y,by='team') %>%
dplyr::relocate(conf,.before=barthag) %>%
dplyr::relocate(seed,.after=last_col()) %>%
dplyr::mutate(year=year) %>%
dplyr::arrange(desc(barthag)) %>%
dplyr::mutate(barthag_rk=row_number(), .after=barthag) %>%
dplyr::arrange(desc(adj_o)) %>%
dplyr::mutate(adj_o_rk=row_number(), .after=adj_o) %>%
dplyr::arrange(adj_d) %>%
dplyr::mutate(adj_d_rk=row_number(), .after=adj_d) %>%
dplyr::arrange(desc(adj_t)) %>%
dplyr::mutate(adj_t_rk=row_number(), .after=adj_t) %>%
arrange(desc(barthag))
return(x) }
})}
#' @export
bart_injuryimpact <- function(year=current_season(), team=NULL, player=NULL) {
suppressWarnings({
if(is.null(team) | is.null(player)) {
cli::cli_abort('Please enter a team or player value!')
}
else {
player <- gsub(" ","+", player)
team <- gsub(" ", "+", team)
x <- httr::GET(paste0('https://barttorvik.com/missing_player.php?team=',team,'&player=',player,'&year=',year)) %>%
httr::content(as = "text") %>%
rvest::read_html() %>%
rvest::html_table(header = FALSE) %>%
purrr::pluck(1) %>%
janitor::row_to_names(row=1) %>%
janitor::clean_names() %>%
dplyr::rename('situation'=1) %>%
dplyr::mutate(across(c(2:5), as.numeric))
return(x) }
})}
#' @export
bart_archive <- function(date){
suppressWarnings({
t_date <- lubridate::ymd(date)
if(t_date < as.Date('2014-11-01')) {
cli::cli_abort('Data only goes back to 2014-11-01!')
}
names <- c('rk','team','conf','rec','adj_o','adj_o_rk','adj_d','adj_d_rk','barthag','proj_rec','proj_conf_rec',
'wab','wab_rk','cur_rk','change')
x <- httr::GET(paste0('https://barttorvik.com/trank-time-machine.php?date=',date)) %>%
httr::content(as='text') %>%
rvest::read_html() %>%
rvest::html_table() %>%
purrr::pluck(1)
x <- x %>%
subset(select=-c(16:ncol(x)))
colnames(x) <- names
x <- x %>%
dplyr::mutate(across(c(1, 5:9, 12:15), as.numeric),
date=lubridate::ymd(date), .after=last_col()) %>%
dplyr::filter(!is.na(adj_o))
return(x) }
)}
#' @export
bart_tourney_results <- function(min_year=2000, max_year=current_season(), type='team') {
suppressWarnings({
if(min_year < 2000) {
cli::cli_abort('Data only goes back to 2000!')
}
if(!(type %in% c('team','coach','conf','seed'))) {
cli::cli_abort("Please input a valid type command ('team','coach','conf', or 'seed')")
}
else {
x <- httr::GET(paste0('https://barttorvik.com/cgi-bin/ncaat.cgi?conlimit=&yrlow=',min_year,'&yrhigh=',max_year,'&type=',type)) %>%
httr::content(as='text') %>%
rvest::read_html() %>%
rvest::html_table() %>%
purrr::pluck(1) %>%
dplyr::select(-1) %>%
janitor::clean_names() %>%
filter(pake!='PAKE') %>%
dplyr::mutate(across(15:16, parse_number),
across(2:14, as.numeric),
from=min_year,
to=max_year)
return(x) }
})}
#' @export
bart_poy <- function(year=current_season(), conf='All', class=NULL, conf_only=FALSE) {
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)) {
cli::cli_abort('Enter a valid year as a number (YYYY). Data only goes back to 2008!')
}
class_lookup <- list (
'fr'='Fr',
'so'='So',
'jr'='Jr',
'sr'='Sr'
)
class <- class_lookup[class]
if(conf_only==FALSE) {
x <- httr::GET(paste0('https://barttorvik.com/poy.php?conlimit=',conf,'&year=',year,'&yr=',class)) %>%
httr::content(as='text') %>%
rvest::read_html() %>%
rvest::html_table() %>%
purrr::pluck(1) %>%
janitor::clean_names()
return(x) }
if(conf_only==TRUE) {
x <- httr::GET(paste0('https://barttorvik.com/conpoy.php?conlimit=',conf,'&year=',year,'&yr=',class)) %>%
httr::content(as='text') %>%
rvest::read_html() %>%
rvest::html_table() %>%
purrr::pluck(1) %>%
janitor::clean_names()
return(x)
}}
#' @export
bart_coach <- function(coach) {
suppressWarnings({
coach <- gsub(" ","+", coach)
y_names <- c('year','player','team','rec_rank')
tabs <- httr::GET(paste0('https://barttorvik.com/coach-history.php?coach=', coach)) %>%
httr::content(as='text') %>%
rvest::read_html() %>%
rvest::html_table()
x <- tabs %>%
purrr::pluck(1) %>%
janitor::clean_names() %>%
tidyr::separate(team, into=c('team','more'), sep='(?<=[a-zA-QS-Z.])\\s*(?=[0-9])') %>%
tidyr::separate(more, into=c('seed','finish'), sep=",") %>%
tidyr::separate(rec, into=c('ov_rec', 'conf_rec'), sep='[\\(\\)]') %>%
dplyr::mutate_all(funs(stringr::str_replace(., 'No Tourney - COVID-19',""))) %>%
dplyr::mutate_at(c(3,5,7), funs(trimws(.))) %>%
dplyr::mutate(seed=readr::parse_number(seed),
across(c(1,2,4,9:22), as.numeric)) %>%
dplyr::rename('two_pct'=20,
'two_pct_d'=21,
'three_pct'=22,
'three_pct_d'=23)
y <- tabs %>%
purrr::pluck(2)
colnames(y) <- y_names
z <- c(list(x), list(y))
return(z)
})}
#' @export
bart_team_history <- function(team){
suppressWarnings({
team <- gsub(" ","+", team)
x <- httr::GET(paste0('https://barttorvik.com/team-history.php?team=',team)) %>%
httr::content(as='text') %>%
rvest::read_html() %>%
rvest::html_table() %>%
purrr::pluck(1) %>%
janitor::clean_names() %>%
tidyr::separate(coach, into=c('coach','more'), sep='(?<=[a-z.])\\s*(?=[0-9])') %>%
tidyr::separate(more, into=c('seed','finish'), sep=",") %>%
tidyr::separate(rec, into=c('ov_rec', 'conf_rec'), sep='[\\(\\)]') %>%
dplyr::mutate_at(c(5,7), funs(trimws(.))) %>%
dplyr::mutate(seed=readr::parse_number(seed),
across(c(1,2,4,9:22), as.numeric)) %>%
dplyr::rename('two_pct'=20,
'two_pct_d'=21,
'three_pct'=22)
return(x) }
)}
#' @export
bart_conf_stats <- function(year=current_season(), conf=NULL) {
suppressWarnings({
if(is.null(conf)) {
cli::cli_abort("Please enter valid conference code. See function help for full list.")
}
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)){
cli::cli_abort('Enter a valid year as a number. Data only goes back to 2008!')
}
else{
x <- httr::GET(paste0('https://barttorvik.com/conf.php?conf=',conf,'&year=',year)) %>%
httr::content(as='text') %>%
rvest::read_html() %>%
rvest::html_table() %>%
purrr::pluck(1) %>%
janitor::row_to_names(row_number = 1) %>%
janitor::clean_names() %>%
tidyr::separate(team, into=c('team','more'), sep='(?<=[a-zA-QS-Z.])\\s*(?=[0-9])') %>%
tidyr::separate(more, into=c('seed','finish'), sep=",") %>%
dplyr::mutate_at(4, funs(trimws(.))) %>%
dplyr::rename('conf_rec'=5,
'con_oe_rk'=12,
'con_de_rk'=14,
'conf_barthag'=15,
'conf_cur_sos'=17,
'conf_cur_sos_rk'=18,
'conf_fut_sos'=19,
'conf_fut_sos_rk'=20,
'conf_sos'=21,
'conf_sos_rk'=22) %>%
dplyr::mutate(seed=parse_number(seed),
across(c(1,6:15,17:22), as.numeric))
return(x)
} })}
#' @export
bart_conf_factors <- function(year=current_season(),venue='all',type='all',quad='4', start=NULL, end=NULL) {
suppressWarnings({
if(!(is.numeric(year) && nchar(year) == 4 && year >=
2008)) {
cli::cli_abort('Enter a valid year as a number (YYYY). Data only goes back to 2008!') }
if(!(is.character(quad))) {
cli::cli_abort("Please enter quadrant cutoff as a character value (e.g. '4')")
}
x_names <- c('conf','barthag','rec','wins','games','adj_t','adj_o','off_efg','off_to','off_or','off_ftr','adj_d','def_efg',
'def_to','def_or','def_ftr','wab')
venue_lookup <- list(
'all'='All',
'home'='H',
'away'='A',
'neutral'='N',
'road'='A-N'
)
v <- venue_lookup[venue]
type_lookup <- list (
'all'='All',
'nc'='N',
'conf'='C',
'reg'='R',
'post'='P',
'ncaa'='T'
)
t <- type_lookup[type]
quad_lookup <- list (
'0'='1',
'1'='2',
'2'='3',
'3'='4',
'4'='5'
)
q <- quad_lookup[quad]
if(is.null(start) && is.null(end)) {
x <- utils::read.csv(paste0('https://barttorvik.com/trank.php?year=',year,'&conyes=1&revquad=0&quad=',q,'&venue=',v,'&type=',t,'&csv=1'), header=FALSE) %>%
as.data.frame() %>%
dplyr::select(1,4,5,6,7,27,2,8,12,14,10,3,9,13,15,11,35)
colnames(x) <- x_names
x <- x %>% dplyr::mutate(year=year,
venue=venue,
type=type,
quad=paste0(quad,'+')) %>%
dplyr::arrange(desc(barthag)) }
if(!(is.null(start) && is.null(end))) {
x <- utils::read.csv(paste0('https://barttorvik.com/trank.php?year=',year,'&conyes=1&sort=&hteam=&t2value=&begin=',start,'&end=',end,'&revquad=0&quad=',q,'&venue=',v,'&type=',t,'&csv=1'), header=FALSE) %>%
as.data.frame() %>%
dplyr::select(1,4,5,6,7,27,2,8,12,14,10,3,9,13,15,11,35)
colnames(x) <- x_names
x <- x %>% dplyr::mutate(year=year,
venue=venue,
type=type,
quad=paste0(quad,'+'),
start=start,
end=end) %>%
dplyr::arrange(desc(barthag)) }
return(x) })}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.