R/functions.R

Defines functions bart_ratings bart_factors bart_tourney_odds bart_coach_change bart_game_total bart_pregame bart_team_schedule bart_player_game bart_player_season bart_team_shooting bart_season_schedule bart_tourney_sheets current_season

Documented in bart_coach_change bart_factors bart_game_total bart_player_game bart_player_season bart_pregame bart_ratings bart_season_schedule bart_team_schedule bart_team_shooting bart_tourney_odds bart_tourney_sheets

#' @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) })}
andreweatherman/baRt documentation built on March 27, 2022, 12:49 a.m.