inst/scripts/mlb_stadium_data_processing.R

In bdilday/GeomMLBStadiums: GeomMLBStadiums: Draw Major League Baseball Stadiums with ggplot2

generate_sample_data = function() {
  set.seed(101)
  batted_ball_data = data.frame(hc_x = rnorm(20, 125, 10), hc_y=rnorm(20, 100, 20))
  batted_ball_data$team = rep(c("angels", "yankees"), each=10)
}

generic_ballpark = function() {
  left_outfield_line = parametric_curve(125, 208, 30, 100)
  outfield_curve = geom_curve_gen_points(30, 220, 100, 0.9)[,c("x", "y")]
  right_outfield_line = parametric_curve(220, 100, 125, 208)

  left_infield_line = parametric_curve(125, 208, 80, 155)
  infield_curve = geom_curve_gen_points(80, 170, 155, 0.9)[,c("x", "y")]
  right_infield_line = parametric_curve(170, 155, 125, 208)

  outfield_path = rbind.data.frame(left_outfield_line, outfield_curve, right_outfield_line)
  outfield_path$segment = "outfield_outer"
  infield_path = rbind.data.frame(left_infield_line, infield_curve, right_infield_line)
  infield_path$segment = "infield_outer"

  path_df = rbind.data.frame(outfield_path, infield_path)
  team_df = data.frame(team = rep("generic", length(path_df)))
  cbind.data.frame(team_df, path_df)
}

parametric_curve = function(x1, y1, x2, y2) {
  xslope = (x2-x1)
  yslope = (y2-y1)
  tt = seq(0, 1, length.out = 100)
  ll = lapply(tt, function(s) {
    data.frame(x=x1+xslope*s, y=y1+yslope*s)
  })

  do.call(rbind.data.frame, ll)

}

#' geom_curve_gen_points
#'
#' This is an attempt at generating the same curve that
#' would be generated by curveGrob, given a value of curvature. It
#' is restricted to a case where the y start and end points are the same.
#' The definition of curvature here has been deduced with some trial and error
#' using \cose{geom_curve}
#'
#' @param x1 numeric starting x point
#' @param x1 numeric ending x point
#' @param y numeric y location
#' @param curvature numeric The curvature value, as in \code{geom_curve}
geom_curve_gen_points = function(x1, x2, y, curvature) {

  if (x2 < x1) {
    tmp = x1
    x1 = x2
    x2 = tmp
  }

  k = curvature
  xscale = 0.5 * (x2 - x1)

  d1 = (1-k**2)/(2*k)
  r = d1 + k

  starting_theta = abs(atan2(1, d1))
  tt = seq(-starting_theta, starting_theta, length.out = 100)
  x0 = 0.5 * (x1 + x2)
  y0 = y + d1 * xscale
  r = r * xscale
  xx = x0 + r * sin(tt)
  yy = y0 - r * cos(tt)
  data.frame(t=tt, x=xx, y=yy)
}