R/miscellaneous.R

In guytuori/simScores: Similarity Scores for Baseball Players

#' Time between Two Dates
#'
#' Find the number of years between two dates
#' @param d1 first date in character form.  Must be in mdy form for lubridate
#' @param d2 second date in character form.  Must be in mdy form for lubridate
#' @return number of years between \code{d1} and \code{d2}
#' @examples
#' year_diff("9/13/1990", "12/5/2014")
year_diff <- function(d1, d2) {
  d1 <- lubridate::mdy(d1)
  d2 <- lubridate::mdy(d2)
  the_interval <- lubridate::interval(d1, d2)
  floor(the_interval / lubridate::eyears(1))
}

#' Right Substring of a Character Vector
#'
#' Extract the right n characters from a string
#' @param x a character vector
#' @param n number of characters
#' @return character.  The right n characters of the string
#' @examples
#' substr_right("some text in a string", 6)
#' substr_right("some text in a string", 8)
substr_right <- function(x, n){
  substr(x, nchar(x)-n+1, nchar(x))
}
#' Go from Baseball-Reference Name to Display Name
#'
#' Takes a name in the Baseball-Reference style and turns it into a name for the
#' apps
#' @param name the name to change.  Must be in the style "First Last"
#' @return the name in the format "Last; First"
#' @examples
#' j_display_name("Mike Schmidt")
j_display_name <- function(name) {
  name_split <- strsplit(name, " ")
  display_name <- sapply(name_split, function(x) {
    paste(last(x), x[1], sep = "; ")
  })
  unlist(display_name)
}
#' Shorten Name
#'
#' Takes a Display Name from the apps and turns it into "LastF"
#' @param display_name character in the format "Last; First"
#' @return character in the format "LastF"
#' @examples
#' getLastF("Schmidt; Mike J.")
getLastF <- function(display_name) {
  semi_loc <- stringr::str_locate_all(display_name, "; ")
  semi_pos <- sapply(semi_loc, function(z) z[1,1])

  paste0(substr(display_name, 1, semi_pos-1),
         substr(display_name, semi_pos + 2, semi_pos + 2)
  )
}

#' Evaluates an Expression and Return the Number of Warnings
#'
#' Evaluates an expression.  Returns a list with the value of expression and the
#' number of warnings thrown by an expression.
#' @param expr the expression to evaluate
#' @references
#' \url{http://stackoverflow.com/questions/4020239/warnings-does-not-work-within-a-function-how-can-one-work-around-this}
#' @return list of length two. The first element of the list is names "ans" and
#'   it contains the results of the expression.  The second element of the list
#'   is named "warnings" and contains the number of warning generated by the
#'   expression.
#' @examples
#' countWarnings(log(-1))
#' foo <- function(){
#'    warning("first warning!")
#'    warning("second warning!")
#'    warning("third warning!")
#'    invisible()
#'  }
#'  countWarnings(foo())
countWarnings <- function(expr) {
  .number_of_warnings <- 0L
  frame_number <- sys.nframe()
  ans <- withCallingHandlers(expr, warning = function(w) {
    assign(".number_of_warnings", .number_of_warnings + 1L,
           envir = sys.frame(frame_number))
    invokeRestart("muffleWarning")
  })
  list(result = ans, n = .number_of_warnings)
}


#' Strips a name of non-alphabetic character when scraped from Baseball-Reference
cleanNames <- function(dat) {
  sapply(dat, function(x) gsub("[*#?]", "", x));
}