Convenience function for touring baseball PITCHf/x data

pitch_tour.R

library(tourr)
library(animint)

pitch_tour <- function(dat, color_by = "pitch_type", vars = c("start_speed", "break_y", "break_angle", "break_length"),
                       nprojs = 200, out_dir = tempdir()) {
  kept <- dat[names(dat) %in% vars]
  kept[] <- lapply(kept, as.numeric)
  idx <- complete.cases(kept)
  kept <- kept[idx, ]
  type <- dat[idx, color_by, drop = TRUE]
  mat <- rescale(as.matrix(kept))
  tour <- new_tour(mat, grand_tour(), NULL)
  steps <- c(0, rep(1/15, nprojs))
  stepz <- cumsum(steps)
  tour_dat <- function(step_size) {
    step <- tour(step_size)
    proj <- center(mat %*% step$proj)
    df <- data.frame(x = proj[,1], y = proj[,2], type)
    list(dat = df, proj = data.frame(step$proj, vars = vars))
  }
  dats <- lapply(steps, tour_dat)
  datz <- Map(function(x, y) cbind(x$dat, step = y), dats, stepz)
  dat <- do.call("rbind", datz)
  projz <- Map(function(x, y) cbind(x$proj, step = y), dats, stepz)
  projs <- do.call("rbind", projz)
  projs$X1 <- round(projs$X1, 3)
  projs$X2 <- round(projs$X2, 3)
  dat$type <- factor(dat$type)
  p <- ggplot() + 
    geom_point(data = dat,
               aes(x = x, y = y, colour = type, showSelected = step)) +
    geom_segment(data = projs, alpha = 0.25,
                 aes(x = 0, y = 0, xend = X1, yend = X2, showSelected = step)) +
    geom_text(data = projs, alpha = 0.25,
              aes(x = X1, y = X2, label = vars, showSelected = step))
  plist <- list(
    plot = p,
    time = list(variable = "step", ms = 300),
    duration = list(step = 300)
  )
  animint2dir(plist, out.dir = out_dir, open.browser = FALSE)
}