R/tween_balls.R

In mjskay/plinko: Animated Plinko Boards

#' Tween balls in a Plinko board
#'
#' Adds tweening frames to the animation of ball positions in a Plinko board.
#'
#' @param board A `plinko_board()` object
#' @param frame_mult The number of frames to add per existing frame in the
#'   animation. 4 tends to be a good number.
#' @param ease The easing function to use. See `tweenr::display_ease()` for
#'   examples.
#' @return A modifed `plinko_board()` with tweened frames added.
#'
#' @importFrom purrr map map_dbl keep
#' @importFrom dplyr %>% bind_rows mutate group_split as_tibble
#' @importFrom tweenr tween_states
#' @export
tween_balls = function(board, frame_mult, ease = "bounce-out") { within(board, {

  # We tween each ball's position and add an easing function. The following is
  # essentially using `tweenr::tween_states()` to do what
  # `gganimate::transition_states()` does under the hood, but we're doing it
  # manually instead because gganimate is pretty slow on this animation. If we
  # build up the animation manually it will go faster (it's just a bit more work)
  # and we can use the ragg device.

  frames_df = frames_df %>%
    group_split(ball_id) %>%
    map(function(frames) {
      # frames is a data frame of all rows associated with a single ball
      frames = frames %>%
        group_split(frame_id) %>%
        # some of the frames are empty (0 rows), corresponding to times when
        # this ball is not visible. Need to filter those out for tweenr
        keep(~ nrow(.x) != 0)

      frame_ids = map_dbl(frames, "frame_id")
      min_frame_id = min(frame_ids)
      max_frame_id = max(frame_ids)
      n_frame =  max_frame_id - min_frame_id + 1

      frames %>%
        tween_states(
          tweenlength = 1,
          statelength = 0,
          ease = ease,
          nframes = n_frame * frame_mult
        ) %>%
        # the .frame column generated by tweenr starts at the wrong spot because
        # we had to filter out empty rows above (corresponding to when the ball is not
        # visible yet), so we will adjust the frame_id to start when this ball
        # first becomes visible instead of at 1
        mutate(frame_id = (min_frame_id - 1) * frame_mult + .frame)
    }) %>%
    bind_rows() %>%
    as_tibble()
})}