tidyexplain/R/animate_sets.R

#' Animates a set operation
#'
#' Functions to visualise the set operations either static as a ggplot, or
#' dynamic as a gif.
#'
#' @param x the x dataset
#' @param y the y dataset
#' @param export the export type, either gif, first or last. The latter two
#'              export ggplots of the first/last state of the join
#' @param type type of the set, i.e., intersect, setdiff, etc.
#' @param ... further argument passed to static_plot
#'
#' @return either a gif or a ggplot
#'
#' @seealso \code{\link[dplyr]{setops}}
#'
#' @examples
#' x <- data_frame(x = c(1, 1, 2), y = c("a", "b", "a"))
#' y <- data_frame(x = c(1, 2), y = c("a", "b"))
#'
#' # Animate the first or last state of the set
#' animate_union(x, y, export = "first")
#' animate_union(x, y, export = "last")
#'
#' # animate the transition as a gif (default)
#' \donttest{
#' animate_union(x, y, export = "gif")
#' }
#'
#' # different options include
#' \donttest{
#' animate_union(x, y)
#' animate_union_all(x, y)
#' animate_intersect(x, y)
#' animate_setdiff(x, y)
#'
#' # further arguments can be passed to all animate_* functions
#' animate_union(
#'   x, y,
#'   text_size = 5, title_size = 25,
#'   color_header = "black",
#'   color_other = "lightblue",
#'   color_fun = viridis::viridis
#' )
#' }
#'
#' # Save the results
#' \dontrun{
#' # to save the ggplot, use
#' un <- animate_union(x, y, by = "id", export = "last")
#' ggsave("union.pdf", un)
#'
#' animate_union(x, y, by = "id", export = "gif")
#' # to save the gif, use
#' un <- animate_union(x, y, by = "id", export = "gif")
#' anim_save(un, "union.gif")
#' }
animate_set <- function(
  x, y,
  type = c("union", "union_all", "intersect", "setdiff"),
  export = c("gif", "first", "last"),
  ...
) {
  type   <- match.arg(type)
  export <- match.arg(export)
  x_name <- get_input_text(x)
  y_name <- get_input_text(y)
  data   <- make_named_data(x, y)

  col_names <- purrr::map(data, names)

  if (!all(names(data$x) %in% names(data$y)) && ncol(data$x) == ncol(data$y))
    stop("x and y must have the same variables/column-names")

  title <- sprintf(paste0(type, "(%s, %s)"), x_name, y_name)

  if (type %in% c("union", "intersect", "setdiff")) {
    data <- purrr::map(data, dplyr::distinct)
  }

  if (type == "union_all") {
    ll <- process_join(data$x, data$y, by = names(data$x), fill = FALSE, ...)
    ll <- purrr::map(ll, ~ mutate(., .id_long = paste(.id_long, .side, sep = "-")))
  } else {
    ll <- process_join(data$x, data$y, by = names(data$x), ...)
  }

  step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)

  step1 <- move_together(ll$x, ll$y, type) %>% mutate(.frame = 1)

  all <- bind_rows(step0, step1)

  if (export == "gif") {
    animate_plot(all, title, ...) %>% animate()
  } else if (export == "first") {
    title <- ""
    static_plot(step0, title, ...)
  } else if (export == "last") {
    static_plot(step1, title, ...)
  }
}

#' @rdname animate_set
#' @export
animate_union <- function(x, y, export = "gif", ...) {
  x <- rlang::enquo(x)
  y <- rlang::enquo(y)
  animate_set(x, y, type = "union", export = export, ...)
}

#' @rdname animate_set
#' @export
animate_union_all <- function(x, y, export = "gif", ...) {
  x <- rlang::enquo(x)
  y <- rlang::enquo(y)
  animate_set(x, y, type = "union_all", export = export, ...)
}

#' @rdname animate_set
#' @export
animate_intersect <- function(x, y, export = "gif", ...) {
  x <- rlang::enquo(x)
  y <- rlang::enquo(y)
  animate_set(x, y, type = "intersect", export = export, ...)
}

#' @rdname animate_set
#' @export
animate_setdiff <- function(x, y, export = "gif", ...) {
  x <- rlang::enquo(x)
  y <- rlang::enquo(y)
  animate_set(x, y, type = "setdiff", export = export, ...)
}