- Use quasiquotation to get variable names - Unified documentation - Use match.arg to guard for correct arguments in type and export - Removed animate_helpers.Rpull/18/merge
| @@ -1,59 +0,0 @@ | |||
| #' Animates a set - wrapper function | |||
| #' | |||
| #' @param x left dataset | |||
| #' @param y right dataset | |||
| #' @param type type of the set, i.e., intersect, setdiff, etc. | |||
| #' @param export if the function exports a gif, the first, or last picture | |||
| #' @param ... further arguments passed to static_plot or to add_color | |||
| #' | |||
| #' | |||
| #' @name animate_set_function | |||
| #' @return either a gif or a ggplot | |||
| #' | |||
| #' @examples | |||
| #' NULL | |||
| animate_set <- function(x, y, type, export = "gif", ...) { | |||
| if (!all(names(x) %in% names(y)) && ncol(x) == ncol(y)) | |||
| stop("x and y must have the same variables/column-names") | |||
| if (!type %in% c("union", "union_all", "intersect", "setdiff")) | |||
| stop("type has to be a dplyr-set operation") | |||
| if (!export %in% c("gif", "first", "last")) | |||
| stop("export must be either gif, first, or last") | |||
| title <- sprintf(paste0(type, "(%s, %s)"), | |||
| deparse(substitute(x)), | |||
| deparse(substitute(y))) | |||
| if (type %in% c("union", "intersect", "setdiff")) { | |||
| x <- dplyr::distinct(x) | |||
| y <- dplyr::distinct(y) | |||
| } | |||
| if (type == "union_all") { | |||
| ll <- process_join(x, y, by = names(x), fill = FALSE, ...) | |||
| ll <- lapply(ll, function(a) | |||
| a %>% mutate(.id_long = paste(.id_long, .side, sep = "-")) | |||
| ) | |||
| } else { | |||
| ll <- process_join(x, y, by = names(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, ...) | |||
| } | |||
| } | |||
| @@ -66,11 +66,11 @@ animate_join <- function( | |||
| export = c("gif", "first", "last"), | |||
| ... | |||
| ) { | |||
| type <- match.arg(type) | |||
| 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) | |||
| data <- make_named_data(x, y) | |||
| by_args <- if (length(by) == 1) sprintf("\"%s\"", by) else | |||
| sprintf("c(\"%s\")", paste(by, collapse = "\", \"")) | |||
| @@ -7,23 +7,16 @@ | |||
| #' @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}} | |||
| #' | |||
| #' @name animate_set | |||
| #' | |||
| #' @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") | |||
| #' ) | |||
| #' 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") | |||
| @@ -31,59 +24,111 @@ | |||
| #' | |||
| #' # animate the transition as a gif (default) | |||
| #' \donttest{ | |||
| #' animate_union(x, y, export = "gif") | |||
| #' 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) | |||
| #' 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 | |||
| #' ) | |||
| #' # 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) | |||
| #' # 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_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") | |||
| #' } | |||
| NULL | |||
| 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, ...) | |||
| } | |||
| @@ -8,6 +8,9 @@ | |||
| \alias{animate_setdiff} | |||
| \title{Animates a set operation} | |||
| \usage{ | |||
| animate_set(x, y, type = c("union", "union_all", "intersect", "setdiff"), | |||
| export = c("gif", "first", "last"), ...) | |||
| animate_union(x, y, export = "gif", ...) | |||
| animate_union_all(x, y, export = "gif", ...) | |||
| @@ -21,6 +24,8 @@ animate_setdiff(x, y, export = "gif", ...) | |||
| \item{y}{the y dataset} | |||
| \item{type}{type of the set, i.e., intersect, setdiff, etc.} | |||
| \item{export}{the export type, either gif, first or last. The latter two | |||
| export ggplots of the first/last state of the join} | |||
| @@ -34,14 +39,8 @@ Functions to visualise the set operations either static as a ggplot, or | |||
| dynamic as a gif. | |||
| } | |||
| \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") | |||
| ) | |||
| 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") | |||
| @@ -49,36 +48,36 @@ animate_union(x, y, export = "last") | |||
| # animate the transition as a gif (default) | |||
| \donttest{ | |||
| animate_union(x, y, export = "gif") | |||
| 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) | |||
| 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 | |||
| ) | |||
| # 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) | |||
| # 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_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") | |||
| } | |||
| } | |||
| \seealso{ | |||
| @@ -1,29 +0,0 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/animate_helpers.R | |||
| \name{animate_set_function} | |||
| \alias{animate_set_function} | |||
| \alias{animate_set} | |||
| \title{Animates a set - wrapper function} | |||
| \usage{ | |||
| animate_set(x, y, type, export = "gif", ...) | |||
| } | |||
| \arguments{ | |||
| \item{x}{left dataset} | |||
| \item{y}{right dataset} | |||
| \item{type}{type of the set, i.e., intersect, setdiff, etc.} | |||
| \item{export}{if the function exports a gif, the first, or last picture} | |||
| \item{...}{further arguments passed to static_plot or to add_color} | |||
| } | |||
| \value{ | |||
| either a gif or a ggplot | |||
| } | |||
| \description{ | |||
| Animates a set - wrapper function | |||
| } | |||
| \examples{ | |||
| NULL | |||
| } | |||