nbastatR: R's interface to NBA data

#' # http://www.prosportstransactions.com/basketball/Search/SearchResults.php?Player=&Team=&BeginDate=&EndDate=&PlayerMovementChkBx=yes&ILChkBx=yes&NBADLChkBx=yes&InjuriesChkBx=yes&PersonalChkBx=yes&DisciplinaryChkBx=yes&LegalChkBx=yes&Submit=Search
#'
#' .fix_double_name <-
#'   function(x) {
#'     if (x %>% is.na()) {
#'       return(x)
#'     }
#'     count_slashes <-x %>% str_count("/")
#'     if (count_slashes == 0) {
#'       return(x)
#'     }
#'     actual_name <- x %>% str_split("/") %>% flatten_chr() %>% str_trim() %>% .[[2]]
#'     actual_name
#'   }
#'
#' .munge_data <-
#'   function(data) {
#'
#'     data <-
#'       data %>%
#'       separate(nicknameTeam,
#'                into = c("nicknameTeam", "slugLeague"),
#'                sep = "\\(") %>%
#'       mutate(
#'         slugLeague = slugLeague %>% str_replace("\\)", ""),
#'         slugLeague = if_else(slugLeague %>% is.na(), "NBA", slugLeague),
#'         isTrade = descriptionTransaction %>% str_detect("trade"),
#'         isDraftPick = descriptionTransaction %>% str_detect("round pick"),
#'         isHiredExec = descriptionTransaction %>% str_detect("hire"),
#'         isPromotedExec = descriptionTransaction %>% str_detect("promote"),
#'         isLostFreeAgent = descriptionTransaction %>% str_detect("lost free agent"),
#'         isSignedFreeAgent = descriptionTransaction %>% str_detect("signed"),
#'         isWaived = descriptionTransaction %>% str_detect("waived"),
#'         isActivedFromIL = descriptionTransaction %>% str_detect("activated from IL"),
#'         isIRPlacement = descriptionTransaction %>% str_detect("placed on IR"),
#'         isILPlacement = descriptionTransaction %>% str_detect("placed on IL"),
#'         isArrested = descriptionTransaction %>% str_detect("arrest"),
#'         iSurgery = descriptionTransaction %>% str_detect("Surgery"),
#'         isFine = descriptionTransaction %>% str_detect("fined"),
#'         isDNP = descriptionTransaction %>% str_detect("DNP"),
#'         isLostExpansionDraft = descriptionTransaction %>% str_detect("lost in expansion draft"),
#'         isDTD = descriptionTransaction %>% str_detect("DTD")
#'       ) %>%
#'       mutate_if(is.character,
#'                 funs(str_trim)) %>%
#'       suppressWarnings()
#'
#'     data <-
#'       data %>%
#'       mutate(namePlayerAcquired = namePlayerAcquired %>% map_chr(.fix_double_name),
#'              namePlayerRelinquished = namePlayerRelinquished %>% map_chr(.fix_double_name))
#'
#'    data
#'   }
#'
#' # generate ----------------------------------------------------------------
#'
#' .generate_pst_url <-
#'   function(person = NULL,
#'          team = NULL,
#'          date_from = NULL,
#'          date_to = NULL,
#'          include_trades = T,
#'          include_injury_list_movement = T,
#'          include_g_league_movement = T,
#'          include_injury_missed_games = T,
#'          include_personal_missed_games = T,
#'          include_discipline = T,
#'          include_criminal_incidents = T
#' ) {
#'
#'     if (person %>% is_null()) {
#'       entity_slug <- ''
#'     } else {
#'       entity_slug <-
#'         person %>% URLencode()
#'     }
#'     if (team %>% is_null()) {
#'       team_slug <- ''
#'     } else {
#'       team_slug <-
#'         team %>% URLencode()
#'     }
#'
#'     if (date_from %>% is_null()) {
#'       date_f_slug <- ''
#'     } else {
#'       date_f_slug <- lubridate::ymd(date_from)
#'     }
#'
#'     if (date_to %>% is_null()) {
#'       date_t_slug <- ''
#'     } else {
#'       date_t_slug <- lubridate::ymd(date_to)
#'     }
#'
#'     player_m_slug <-
#'       case_when(include_trades == T ~ "yes",
#'                 TRUE ~ "no")
#'
#'
#'     il_slug <-
#'       case_when(include_injury_list_movement == T ~ "yes",
#'                 TRUE ~ "no")
#'
#'     gl_slug <-
#'       case_when(include_g_league_movement == T ~ "yes",
#'                 TRUE ~ "no")
#'     injury_slug  <-
#'       case_when(include_injury_missed_games == T ~ "yes",
#'                 TRUE ~ "no")
#'     personal_slug <-
#'       case_when(include_personal_missed_games == T ~ "yes",
#'                 TRUE ~ "no")
#'     disc_slug  <-
#'       case_when(include_discipline == T ~ "yes",
#'                 TRUE ~ "no")
#'     legal_slug <-
#'       case_when(include_criminal_incidents == T ~ "yes",
#'                 TRUE ~ "no")
#'
#'
#'
#'   base_url <- "http://www.prosportstransactions.com/basketball/Search/SearchResults.php?"
#'   url <-
#'     glue("{base_url}Player={entity_slug}&Team={team_slug}&BeginDate={date_f_slug}&EndDate={date_t_slug}&PlayerMovementChkBx={player_m_slug}&ILChkBx={il_slug}&NBADLChkBx={gl_slug}&InjuriesChkBx={injury_slug}&PersonalChkBx={personal_slug}&DisciplinaryChkBx={disc_slug}&LegalChkBx={legal_slug}&Submit=Search") %>% as.character()
#'   url
#' }
#'
#' # parse -------------------------------------------------------------------
#' .parse.pst.page <-
#'     function(url = "http://www.prosportstransactions.com/basketball/Search/SearchResults.php?Player=&Team=&BeginDate=&EndDate=&PlayerMovementChkBx=yes&ILChkBx=yes&NBADLChkBx=yes&InjuriesChkBx=yes&PersonalChkBx=yes&DisciplinaryChkBx=yes&LegalChkBx=yes&Submit=Search&start=110050") {
#'     page <-
#'       url %>%
#'         read_page()
#'     df_items <-
#'       tibble(idNode = 1:5,
#'                item = c("dateTransaction","nicknameTeam",
#'                         "namePlayerAcquired", "namePlayerRelinquished",
#'                         "descriptionTransaction"))
#'    data <-
#'      1:5 %>%
#'       future_map_dfr(function(x){
#'         value <-
#'           page %>%
#'           html_nodes(css = glue(".center td:nth-child({x})") %>% as.character()) %>%
#'           html_text() %>%
#'           str_trim()
#'
#'         value <- value[2:length(value)]
#'
#'         value <- case_when(value == "" ~ NA_character_,
#'                   TRUE ~ value)
#'         if (x %in% 3:5) {
#'         value <-
#'          value %>%
#'           map_chr(function(v){
#'             v %>%
#'               str_split(". ") %>%
#'               flatten_chr() %>%
#'               discard(~.x == "") %>% str_c(collapse = " | ")
#'           })
#'         }
#'
#'         item <-
#'           df_items %>% filter(idNode == x) %>% pull(item)
#'
#'
#'         tibble(item, value) %>%
#'           mutate(idRow = 1:n())
#'       })
#'
#'    data <-
#'      data %>%
#'      spread(item, value) %>%
#'      select(-idRow) %>%
#'      select(one_of(df_items$item)) %>%
#'      mutate(dateTransaction = dateTransaction %>% lubridate::ymd(),
#'             urlPST = url)
#'    data
#'     }
#'
#' .parse_pst_urls <-
#'   function(urls = c("http://www.prosportstransactions.com/basketball/SearchSearchResults.php?Player=&Team=&BeginDate=&EndDate=&PlayerMovementChkBx=yes&ILChkBx=yes&NBADLChkBx=yes&InjuriesChkBx=yes&PersonalChkBx=yes&DisciplinaryChkBx=yes&LegalChkBx=yes&Submit=Search&start=97350",
#'                     "http://www.prosportstransactions.com/basketball/SearchSearchResults.php?Player=&Team=&BeginDate=&EndDate=&PlayerMovementChkBx=yes&ILChkBx=yes&NBADLChkBx=yes&InjuriesChkBx=yes&PersonalChkBx=yes&DisciplinaryChkBx=yes&LegalChkBx=yes&Submit=Search&start=2025",
#'                     "http://www.prosportstransactions.com/basketball/SearchSearchResults.php?Player=&Team=&BeginDate=&EndDate=&PlayerMovementChkBx=yes&ILChkBx=yes&NBADLChkBx=yes&InjuriesChkBx=yes&PersonalChkBx=yes&DisciplinaryChkBx=yes&LegalChkBx=yes&Submit=Search&start=106175",
#'                     "http://www.prosportstransactions.com/basketball/SearchSearchResults.php?Player=&Team=&BeginDate=&EndDate=&PlayerMovementChkBx=yes&ILChkBx=yes&NBADLChkBx=yes&InjuriesChkBx=yes&PersonalChkBx=yes&DisciplinaryChkBx=yes&LegalChkBx=yes&Submit=Search&start=22675",
#'                     "http://www.prosportstransactions.com/basketball/SearchSearchResults.php?Player=&Team=&BeginDate=&EndDate=&PlayerMovementChkBx=yes&ILChkBx=yes&NBADLChkBx=yes&InjuriesChkBx=yes&PersonalChkBx=yes&DisciplinaryChkBx=yes&LegalChkBx=yes&Submit=Search&start=46650"
#'   ),
#'            return_message = T) {
#'     df <-
#'       tibble()
#'
#'     success <- function(res) {
#'       url <-
#'         res$url
#'
#'       if (return_message) {
#'         glue("Parsing {url}") %>%
#'           cat(fill = T)
#'       }
#'       .parse.pst.page.safe <-
#'         possibly(.parse.pst.page, tibble())
#'
#'       all_data <-
#'         .parse.pst.page(url = url)
#'
#'
#'       df <<-
#'         df %>%
#'         bind_rows(all_data)
#'     }
#'     failure <- function(msg) {
#'       tibble()
#'     }
#'     urls %>%
#'       future_map(function(x) {
#'         curl_fetch_multi(url = x, success, failure)
#'       })
#'     multi_run()
#'     df
#'   }
#'
#' .get_pst_result_url_df <-
#'   function(url = "http://www.prosportstransactions.com/basketball/Search/SearchResults.php?Player=&Team=&BeginDate=&EndDate=&PlayerMovementChkBx=yes&ILChkBx=yes&NBADLChkBx=yes&InjuriesChkBx=yes&PersonalChkBx=yes&DisciplinaryChkBx=yes&LegalChkBx=yes&Submit=Search&start=110050") {
#'     page <-
#'       url %>%
#'       read_page()
#'     pages <-
#'       page %>%
#'       html_nodes('.center+ table td:nth-child(3) a') %>%
#'       html_text() %>%
#'       as.character() %>%
#'       parse_number()
#'
#'     if (pages %>% length() == 0) {
#'       return(tibble(idPage = 1,
#'                  urlPST = url))
#'     }
#'
#'     urls <-
#'       page %>%
#'       html_nodes('.center+ table td:nth-child(3) a') %>%
#'       html_attr('href') %>%
#'       str_c("http://www.prosportstransactions.com/basketball/Search/", .)
#'
#'     tibble(idPage = pages,
#'                urlPST = urls)
#'   }
#'
#' #' ProSports NBA transactions
#' #'
#' #' Returns data matching specified
#' #' parameters
#' #'
#' #' @param person if not \code{NULL} vector of person name
#' #' @param team if not \code{NULL} vector of team name
#' #' @param date_from if not \code{NULL} vector of dates
#' #' @param date_to if not \code{NULL} vector of person name
#' #' @param include_trades if \code{TRUE} includes trades
#' #' @param include_injury_list_movement if \code{TRUE} includes injury list
#' #' @param include_g_league_movement if \code{TRUE} includes g-league movement
#' #' @param include_injury_missed_games if \code{TRUE} includes injury missed games
#' #' @param include_personal_missed_games if \code{TRUE} include personal missed games
#' #' @param include_discipline if \code{TRUE} include disciple
#' #' @param include_criminal_incidents if \code{TRUE} include criminal incidents
#' #' @param return_message if \code{TRUE} returns a message
#' #'
#' #' @return a \code{tibble}
#' #' @export
#' #'
#' #' @examples
#' #' pst_transaction(person = NULL, team = "Nets")
#' pst_transaction <-
#'   function(person = "Jarrett Jack",
#'            team = NULL,
#'            date_from = NULL,
#'            date_to = NULL,
#'            include_trades = T,
#'            include_injury_list_movement = T,
#'            include_g_league_movement = T,
#'            include_injury_missed_games = T,
#'            include_personal_missed_games = T,
#'            include_discipline = T,
#'            include_criminal_incidents = T,
#'            return_message = T) {
#'     url <-
#'       .generate_pst_url(person = person,
#'                      team = team,
#'                      date_from = date_from,
#'                      date_to = date_to,
#'                      include_trades = include_trades,
#'                      include_injury_list_movement = include_injury_list_movement,
#'                      include_g_league_movement = include_g_league_movement,
#'                      include_injury_missed_games = include_injury_missed_games,
#'                      include_personal_missed_games = include_personal_missed_games,
#'                      include_discipline = include_discipline,
#'                      include_criminal_incidents = include_criminal_incidents)
#'     df_urls <-
#'       .get_pst_result_url_df(url = url)
#'     data <-
#'       .parse_pst_urls(urls = df_urls$urlPST, return_message = return_message)
#'
#'     data %>%
#'       .munge_data()
#'   }