| Type: Package | Type: Package | ||||
| Package: tidyverbs | |||||
| Title: Animate the Verbs of the Tidyverse | |||||
| Package: tidyexplain | |||||
| Title: Animated Explanations of Tidyverse Verbs | |||||
| Version: 0.0.1.9000 | Version: 0.0.1.9000 | ||||
| Date: 2018-08-27 | Date: 2018-08-27 | ||||
| Authors@R: | Authors@R: | ||||
| person(given = "Tyler Grant", | person(given = "Tyler Grant", | ||||
| family = "Smith", | family = "Smith", | ||||
| role = "ctb")) | role = "ctb")) | ||||
| Description: Animate the verbs of the tidyverse. | |||||
| Description: Animated explanations of the verbs in the tidyverse | |||||
| using gganimate and ggplot2. | |||||
| License: MIT + file LICENSE | License: MIT + file LICENSE | ||||
| Depends: | Depends: | ||||
| gganimate (>= 0.9.9.9999), | gganimate (>= 0.9.9.9999), | ||||
| Imports: | Imports: | ||||
| dplyr, | dplyr, | ||||
| magrittr, | magrittr, | ||||
| purrr, | |||||
| rlang (>= 0.1.2), | rlang (>= 0.1.2), | ||||
| scales, | scales, | ||||
| tidyr | |||||
| tidyr, | |||||
| tidyselect | |||||
| Suggests: | Suggests: | ||||
| knitr, | knitr, | ||||
| roxygen2, | roxygen2, | ||||
| testthat, | |||||
| viridis | viridis | ||||
| VignetteBuilder: | VignetteBuilder: | ||||
| knitr | knitr |
| # Generated by roxygen2: do not edit by hand | # Generated by roxygen2: do not edit by hand | ||||
| S3method(print,anim_opts) | |||||
| export("%>%") | export("%>%") | ||||
| export(anim_options) | |||||
| export(anim_options_set) | |||||
| export(animate_anti_join) | export(animate_anti_join) | ||||
| export(animate_full_join) | export(animate_full_join) | ||||
| export(animate_gather) | export(animate_gather) | ||||
| export(animate_spread) | export(animate_spread) | ||||
| export(animate_union) | export(animate_union) | ||||
| export(animate_union_all) | export(animate_union_all) | ||||
| export(get_font_size) | |||||
| export(is.anim_opts) | |||||
| export(set_font_size) | |||||
| importFrom(dplyr,anti_join) | importFrom(dplyr,anti_join) | ||||
| importFrom(dplyr,arrange) | importFrom(dplyr,arrange) | ||||
| importFrom(dplyr,bind_cols) | importFrom(dplyr,bind_cols) | ||||
| importFrom(dplyr,bind_rows) | importFrom(dplyr,bind_rows) | ||||
| importFrom(dplyr,data_frame) | |||||
| importFrom(dplyr,filter) | importFrom(dplyr,filter) | ||||
| importFrom(dplyr,full_join) | importFrom(dplyr,full_join) | ||||
| importFrom(dplyr,group_by) | importFrom(dplyr,group_by) | ||||
| importFrom(dplyr,mutate) | importFrom(dplyr,mutate) | ||||
| importFrom(dplyr,pull) | importFrom(dplyr,pull) | ||||
| importFrom(dplyr,right_join) | importFrom(dplyr,right_join) | ||||
| importFrom(dplyr,row_number) | |||||
| importFrom(dplyr,select) | importFrom(dplyr,select) | ||||
| importFrom(dplyr,semi_join) | importFrom(dplyr,semi_join) | ||||
| importFrom(dplyr,slice) | |||||
| importFrom(magrittr,"%>%") | importFrom(magrittr,"%>%") | ||||
| importFrom(tidyr,gather) | |||||
| importFrom(tidyr,spread) |
| #' 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, ...) | |||||
| } | |||||
| } | |||||
| #' Animates a join - wrapper function | |||||
| #' | |||||
| #' @param x left dataset | |||||
| #' @param y right dataset | |||||
| #' @param by by arguments for the join | |||||
| #' @param type type of the join, i.e., left_join, right_join, 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 | |||||
| #' | |||||
| #' @return either a gif or a ggplot | |||||
| #' | |||||
| #' @name animate_join_function | |||||
| #' | |||||
| #' @examples | |||||
| #' NULL | |||||
| animate_join <- function(x, y, by, type, export = "gif", ...) { | |||||
| if (!type %in% c("full_join", "inner_join", "left_join", "right_join", | |||||
| "semi_join", "anti_join")) | |||||
| stop("type has to be a dplyr-join") | |||||
| if (!export %in% c("gif", "first", "last")) | |||||
| stop("export must be either gif, first, or last") | |||||
| by_args <- ifelse(length(by) == 1, | |||||
| sprintf("\"%s\"", by), | |||||
| sprintf("c(\"%s\")", paste(by, collapse = "\", \"")) | |||||
| ) | |||||
| title <- sprintf(paste0(type, "(%s, %s, by = %s)"), | |||||
| deparse(substitute(x)), | |||||
| deparse(substitute(y)), | |||||
| by_args) | |||||
| if (type %in% c("semi_join", "anti_join")) { | |||||
| # for semi and anti_joins, there is no adding of multiple rows | |||||
| y <- dplyr::distinct(y) | |||||
| } | |||||
| ll <- process_join(x, y, by, ...) | |||||
| 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, ...) | |||||
| } else if (export == "first") { | |||||
| title <- "" | |||||
| static_plot(step0, title, ...) | |||||
| } else if (export == "last") { | |||||
| static_plot(step1, title, ...) | |||||
| } | |||||
| } | |||||
| #' | #' | ||||
| #' @name animate_join | #' @name animate_join | ||||
| #' @examples | #' @examples | ||||
| #' x <- data_frame( | |||||
| #' id = 1:3, | |||||
| #' x = paste0("x", 1:3) | |||||
| #' ) | |||||
| #' y <- data_frame( | |||||
| #' id = (1:4)[-3], | |||||
| #' y = paste0("y", (1:4)[-3]) | |||||
| #' ) | |||||
| #' x <- data_frame(id = 1:3, x = paste0("x", 1:3)) | |||||
| #' y <- data_frame(id = (1:4)[-3], y = paste0("y", (1:4)[-3])) | |||||
| #' | #' | ||||
| #' # Animate the first or last state of the join | #' # Animate the first or last state of the join | ||||
| #' animate_full_join(x, y, by = "id", export = "first") | #' animate_full_join(x, y, by = "id", export = "first") | ||||
| #' | #' | ||||
| #' # animate the transition as a gif (default) | #' # animate the transition as a gif (default) | ||||
| #' \donttest{ | #' \donttest{ | ||||
| #' animate_full_join(x, y, by = "id", export = "gif") | |||||
| #' animate_full_join(x, y, by = "id", export = "gif") | |||||
| #' } | #' } | ||||
| #' | #' | ||||
| #' # different options include | #' # different options include | ||||
| #' \donttest{ | #' \donttest{ | ||||
| #' animate_full_join(x, y, by = "id") | |||||
| #' animate_inner_join(x, y, by = "id") | |||||
| #' animate_left_join(x, y, by = "id") | |||||
| #' animate_right_join(x, y, by = "id") | |||||
| #' animate_semi_join(x, y, by = "id") | |||||
| #' animate_anti_join(x, y, by = "id") | |||||
| #' animate_full_join(x, y, by = "id") | |||||
| #' animate_inner_join(x, y, by = "id") | |||||
| #' animate_left_join(x, y, by = "id") | |||||
| #' animate_right_join(x, y, by = "id") | |||||
| #' animate_semi_join(x, y, by = "id") | |||||
| #' animate_anti_join(x, y, by = "id") | |||||
| #' | #' | ||||
| #' # further arguments can be passed to all animate_* functions | |||||
| #' animate_full_join( | |||||
| #' x, y, by = "id", export = "last", | |||||
| #' 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_full_join( | |||||
| #' x, y, by = "id", export = "last", | |||||
| #' text_size = 5, title_size = 25, | |||||
| #' color_header = "black", | |||||
| #' color_other = "lightblue", | |||||
| #' color_fun = viridis::viridis | |||||
| #' ) | |||||
| #' } | #' } | ||||
| #' | #' | ||||
| #' # Save the results | #' # Save the results | ||||
| #' \donttest{ | #' \donttest{ | ||||
| #' # to save the ggplot, use | |||||
| #' fj <- animate_full_join(x, y, by = "id", export = "last") | |||||
| #' ggsave("full-join.pdf", fj) | |||||
| #' # to save the ggplot, use | |||||
| #' fj <- animate_full_join(x, y, by = "id", export = "last") | |||||
| #' ggsave("full-join.pdf", fj) | |||||
| #' | #' | ||||
| #' # to save the gif, use | |||||
| #' fj <- animate_full_join(x, y, by = "id", export = "gif") | |||||
| #' anim_save(fj, "full-join.gif") | |||||
| #' # to save the gif, use | |||||
| #' fj <- animate_full_join(x, y, by = "id", export = "gif") | |||||
| #' anim_save(fj, "full-join.gif") | |||||
| #' } | #' } | ||||
| NULL | |||||
| animate_join <- function( | |||||
| x, | |||||
| y, | |||||
| by, | |||||
| type = c("full_join", "inner_join", "left_join", "right_join", | |||||
| "semi_join", "anti_join"), | |||||
| 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) | |||||
| by_args <- if (length(by) == 1) sprintf("\"%s\"", by) else | |||||
| sprintf("c(\"%s\")", paste(by, collapse = "\", \"")) | |||||
| title <- sprintf(paste0(type, "(%s, %s, by = %s)"), x_name, y_name, by_args) | |||||
| if (type %in% c("semi_join", "anti_join")) { | |||||
| # for semi and anti_joins, there is no adding of multiple rows | |||||
| data$y <- dplyr::distinct(data$y) | |||||
| } | |||||
| ll <- process_join(data$x, data$y, by, ...) | |||||
| 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, ...) | |||||
| } else if (export == "first") { | |||||
| title <- "" | |||||
| static_plot(step0, title, ...) | |||||
| } else if (export == "last") { | |||||
| static_plot(step1, title, ...) | |||||
| } | |||||
| } | |||||
| #' @rdname animate_join | #' @rdname animate_join | ||||
| #' @export | #' @export | ||||
| animate_full_join <- function(x, y, by, export = "gif", ...) { | animate_full_join <- function(x, y, by, export = "gif", ...) { | ||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_join(x, y, by, type = "full_join", export = export, ...) | animate_join(x, y, by, type = "full_join", export = export, ...) | ||||
| } | } | ||||
| #' @rdname animate_join | #' @rdname animate_join | ||||
| #' @export | #' @export | ||||
| animate_inner_join <- function(x, y, by, export = "gif", ...) { | animate_inner_join <- function(x, y, by, export = "gif", ...) { | ||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_join(x, y, by, type = "inner_join", export = export, ...) | animate_join(x, y, by, type = "inner_join", export = export, ...) | ||||
| } | } | ||||
| #' @rdname animate_join | #' @rdname animate_join | ||||
| #' @export | #' @export | ||||
| animate_left_join <- function(x, y, by, export = "gif", ...) { | animate_left_join <- function(x, y, by, export = "gif", ...) { | ||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_join(x, y, by, type = "left_join", export = export, ...) | animate_join(x, y, by, type = "left_join", export = export, ...) | ||||
| } | } | ||||
| #' @rdname animate_join | #' @rdname animate_join | ||||
| #' @export | #' @export | ||||
| animate_right_join <- function(x, y, by, export = "gif", ...) { | animate_right_join <- function(x, y, by, export = "gif", ...) { | ||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_join(x, y, by, type = "right_join", export = export, ...) | animate_join(x, y, by, type = "right_join", export = export, ...) | ||||
| } | } | ||||
| #' @rdname animate_join | #' @rdname animate_join | ||||
| #' @export | #' @export | ||||
| animate_semi_join <- function(x, y, by, export = "gif", ...) { | animate_semi_join <- function(x, y, by, export = "gif", ...) { | ||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_join(x, y, by, type = "semi_join", export = export, ...) | animate_join(x, y, by, type = "semi_join", export = export, ...) | ||||
| } | } | ||||
| #' @rdname animate_join | #' @rdname animate_join | ||||
| #' @export | #' @export | ||||
| animate_anti_join <- function(x, y, by, export = "gif", ...) { | animate_anti_join <- function(x, y, by, export = "gif", ...) { | ||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_join(x, y, by, type = "anti_join", export = export, ...) | animate_join(x, y, by, type = "anti_join", export = export, ...) | ||||
| } | } |
| #' Animation Options | |||||
| #' | |||||
| #' Helper function to set animation and plotting options to be passed to | |||||
| #' [animate_plot()] and [static_plot()]. | |||||
| #' | |||||
| #' @param text_family Font family for the plot text, default is "Fira Mono". Use | |||||
| #' [set_font_size()] to set global default font sizes. | |||||
| #' @param title_family Font family for the plot title, default is "Fira Mono". | |||||
| #' Use [set_font_size()] to set global default font sizes. | |||||
| #' @param text_size Font size of the plot text, default is 5. | |||||
| #' @param title_size Font size of the plot title, default is 17. | |||||
| #' @param ease_default Default aes easing function. See [tweenr::display_ease()] | |||||
| #' for more options. The tidyexplain default value is `sine-in-out`. | |||||
| #' @param ease_other Additional aes easing options, specified as a named list. | |||||
| #' List entries are named with the aesthetic to which the easeing should be | |||||
| #' applied, consistent with [gganimate::ease_aes()]. E.g. `list(color = | |||||
| #' "sine")`. | |||||
| #' @param enter Enter fading function applied to objects in the animation. See | |||||
| #' [gganimate::enter_exit] for a complete list of options. The tidyexplain | |||||
| #' default is [gganimate::enter_fade()]. | |||||
| #' @param exit Exit fading function applied to objects in the animation. See | |||||
| #' [gganimate::enter_exit] for a complete list of options. The tidyexplain | |||||
| #' default is [gganimate::exit_fade()]. | |||||
| #' @inheritParams gganimate::transition_states | |||||
| #' @export | |||||
| anim_options <- function( | |||||
| transition_length = NULL, | |||||
| state_length = NULL, | |||||
| ease_default = NULL, | |||||
| ease_other = NULL, | |||||
| enter = NULL, | |||||
| exit = NULL, | |||||
| text_family = NULL, | |||||
| title_family = NULL, | |||||
| text_size = NULL, | |||||
| title_size = NULL, | |||||
| ... | |||||
| ){ | |||||
| enter_name <- if (!missing(enter)) rlang::quo_name(rlang::enquo(enter)) | |||||
| exit_name <- if (!missing(exit)) rlang::quo_name(rlang::enquo(exit)) | |||||
| ao <- list( | |||||
| transition_length = transition_length, | |||||
| state_length = state_length, | |||||
| ease_default = ease_default, | |||||
| ease_other = ease_other, | |||||
| enter = if (!is.null(enter)) setNames(list(enter), enter_name), | |||||
| exit = if (!is.null(exit)) setNames(list(exit), exit_name), | |||||
| text_family = text_family, | |||||
| text_size = text_size, | |||||
| title_family = title_family, | |||||
| title_size = title_size, | |||||
| ... | |||||
| ) | |||||
| ao <- purrr::compact(ao) | |||||
| structure(ao, class = "anim_opts") | |||||
| } | |||||
| # Global Animation Options Setters and Getters ---------------------------- | |||||
| #' @describeIn anim_options Set default animation options for the current session. | |||||
| #' @param anim_opts An [anim_options()] options list. | |||||
| #' @export | |||||
| anim_options_set <- function(anim_opts = anim_options()) { | |||||
| stopifnot(is.anim_opts(anim_opts)) | |||||
| ao_old <- plot_settings$anim_opts | |||||
| plot_settings$anim_opts <- merge(anim_opts, plot_settings$anim_opts) | |||||
| invisible(ao_old) | |||||
| } | |||||
| get_anim_opt <- function(anim_opt = NULL) { | |||||
| if (is.null(anim_opt)) return(plot_settings$anim_opts) | |||||
| if (anim_opt %in% c("text_size", "title_size")) rlang::abort( | |||||
| "Use get_text_size() or get_title_size()" | |||||
| ) | |||||
| plot_settings$anim_opts[[anim_opt]] %||% plot_settings$default[[anim_opt]] | |||||
| } | |||||
| # Animation Options Methods ----------------------------------------------- | |||||
| #' @export | |||||
| print.anim_opts <- function(x) { | |||||
| # Replace ggproto (enter/exit functions) with their names | |||||
| if ("enter" %in% names(x)) x$enter <- paste("ggproto:", names(x$enter)) | |||||
| if ("exit" %in% names(x)) x$exit <- paste("ggproto:", names(x$exit)) | |||||
| anim_opts <- capture.output(str(x, no.list = TRUE)) | |||||
| cat( | |||||
| paste0("<anim_options: ", length(x), " options>"), | |||||
| anim_opts, sep = "\n" | |||||
| ) | |||||
| } | |||||
| #' @export | |||||
| is.anim_opts <- function(ao) inherits(ao, "anim_opts") | |||||
| # Fill, Validate, Merge Animation Options --------------------------------- | |||||
| # Fills in default animation options | |||||
| fill_anim_opts <- function(ao) { | |||||
| ao$transition_length <- ao$transition_length %||% get_anim_opt("transition_length") | |||||
| ao$state_length <- ao$state_length %||% get_anim_opt("state_length") | |||||
| ao$ease_default <- ao$ease_default %||% get_anim_opt("ease_default") | |||||
| ao$ease_other <- ao$ease_other %||% get_anim_opt("ease_other") | |||||
| ao$enter <- ao$enter %||% get_anim_opt("enter") | |||||
| ao$exit <- ao$exit %||% get_anim_opt("exit") | |||||
| ao$text_family <- ao$text_family %||% get_anim_opt("text_family") | |||||
| ao$title_family <- ao$title_family %||% get_anim_opt("title_family") | |||||
| ao | |||||
| } | |||||
| validate_anim_opts <- function(ao, quiet = FALSE, strict = getOption("tidyexplain.strict_dots", FALSE)) { | |||||
| if (!inherits(ao, "anim_opts")) { | |||||
| rlang::warn("Use `anim_options()` to set `anim_opts`") | |||||
| } | |||||
| ao <- fill_anim_opts(ao) | |||||
| stopifnot(is.ggproto(ao$enter[[1]]), is.ggproto(ao$exit[[1]])) | |||||
| extra_names <- setdiff(names(ao), names(formals(anim_options))) | |||||
| if (!quiet && length(extra_names)) { | |||||
| extra_names <- paste0(sprintf("`%s`", extra_names), collapse = ", ") | |||||
| msg <- paste("Unknown animation options will be ignored:", extra_names) | |||||
| if (isTrue(strict)) rlang::abort(msg) else rlang::warn(msg) | |||||
| } | |||||
| invisible(ao) | |||||
| } | |||||
| merge.anim_opts <- function(ao_new, ao_base = anim_options()) { | |||||
| ao_new <- purrr::discard(ao_new, is.null) | |||||
| ao_base <- purrr::discard(ao_base, is.null) | |||||
| unique_base <- setdiff(names(ao_base), names(ao_new)) | |||||
| ao <- append(ao_new, ao_base[unique_base]) | |||||
| ao <- ao[names(formals(anim_options))] | |||||
| ao <- purrr::discard(ao, is.null) | |||||
| class(ao) <- "anim_opts" | |||||
| ao | |||||
| } | |||||
| # Default Animation Options for Verb Families ----------------------------- | |||||
| default_anim_opts <- function(family, ao_custom = NULL) { | |||||
| family_options <- c("join", "set", "gather", "spread") | |||||
| family <- match.arg(family, family_options, several.ok = FALSE) | |||||
| ao_default <- switch( | |||||
| family, | |||||
| "gather" = anim_options(enter = enter_fade(), exit = exit_fade(), | |||||
| ease_default = "sine-in-out", | |||||
| ease_other = list(y = "cubic-out", x = "cubic-in")), | |||||
| "spread" = anim_options(enter = enter_fade(), exit = exit_fade(), | |||||
| ease_default = "sine-in-out", | |||||
| ease_other = list(y = "cubic-out", x = "cubic-in")), | |||||
| anim_options() | |||||
| ) | |||||
| if (is.null(ao_custom)) { | |||||
| # User set globals override defaults | |||||
| ao_custom <- get_anim_opt() | |||||
| } else { | |||||
| # Opts from function call override user-set globals | |||||
| ao_custom <- merge(ao_custom, get_anim_opt()) | |||||
| } | |||||
| # function > user-set global > default (> global default) | |||||
| if (!is.null(ao_custom)) merge(ao_custom, ao_default) else ao_default | |||||
| } | |||||
| # Font Size Setters and Getters ------------------------------------------- | |||||
| #' Set Default Text Sizes for Animation Plots | |||||
| #' | |||||
| #' Sets the default text sizes for the animated and static plots produced by | |||||
| #' this package during the current session. | |||||
| #' | |||||
| #' @param text_size Font size of value labels inside the data frame squares | |||||
| #' @param title_size Font size of the function call or plot title | |||||
| #' @export | |||||
| set_font_size <- function(text_size = NULL, title_size = NULL) { | |||||
| old <- list() | |||||
| if (!is.null(text_size)) old$text_size <- set_text_size(text_size) | |||||
| if (!is.null(title_size)) old$title_size <- set_title_size(title_size) | |||||
| invisible(old) | |||||
| } | |||||
| #' @describeIn set_font_size Get current global font sizes | |||||
| #' @export | |||||
| get_font_size <- function() { | |||||
| list("text_size" = get_text_size(), "title_size" = get_title_size()) | |||||
| } | |||||
| set_text_size <- function(size) { | |||||
| old <- plot_settings$text_size | |||||
| anim_options_set(anim_options(text_size = size)) | |||||
| invisible(old) | |||||
| } | |||||
| set_title_size <- function(size) { | |||||
| old <- plot_settings$title_size | |||||
| anim_options_set(anim_options(title_size = size)) | |||||
| invisible(old) | |||||
| } | |||||
| get_text_size <- function(x = NULL) { | |||||
| if (!is.null(x)) return(x) | |||||
| plot_settings$anim_opts$text_size %||% | |||||
| getFromNamespace("theme_env", "ggplot2")$current$text$size %||% | |||||
| plot_settings$default$text_size | |||||
| } | |||||
| get_title_size <- function(x = NULL) { | |||||
| if (!is.null(x)) return(x) | |||||
| plot_settings$anim_opts$title_size %||% | |||||
| getFromNamespace("theme_env", "ggplot2")$current$plot.title$size %||% | |||||
| plot_settings$default$title_size | |||||
| } |
| #' @param y the y dataset | #' @param y the y dataset | ||||
| #' @param export the export type, either gif, first or last. The latter two | #' @param export the export type, either gif, first or last. The latter two | ||||
| #' export ggplots of the first/last state of the join | #' 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 | #' @param ... further argument passed to static_plot | ||||
| #' | #' | ||||
| #' @return either a gif or a ggplot | #' @return either a gif or a ggplot | ||||
| #' | #' | ||||
| #' @seealso \code{\link[dplyr]{setops}} | #' @seealso \code{\link[dplyr]{setops}} | ||||
| #' | #' | ||||
| #' @name animate_set | |||||
| #' | |||||
| #' @examples | #' @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 the first or last state of the set | ||||
| #' animate_union(x, y, export = "first") | #' animate_union(x, y, export = "first") | ||||
| #' | #' | ||||
| #' # animate the transition as a gif (default) | #' # animate the transition as a gif (default) | ||||
| #' \donttest{ | #' \donttest{ | ||||
| #' animate_union(x, y, export = "gif") | |||||
| #' animate_union(x, y, export = "gif") | |||||
| #' } | #' } | ||||
| #' | #' | ||||
| #' # different options include | #' # different options include | ||||
| #' \donttest{ | #' \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 | #' # Save the results | ||||
| #' \dontrun{ | #' \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 | #' @rdname animate_set | ||||
| #' @export | #' @export | ||||
| animate_union <- function(x, y, export = "gif", ...) { | animate_union <- function(x, y, export = "gif", ...) { | ||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_set(x, y, type = "union", export = export, ...) | animate_set(x, y, type = "union", export = export, ...) | ||||
| } | } | ||||
| #' @rdname animate_set | #' @rdname animate_set | ||||
| #' @export | #' @export | ||||
| animate_union_all <- function(x, y, export = "gif", ...) { | 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, ...) | animate_set(x, y, type = "union_all", export = export, ...) | ||||
| } | } | ||||
| #' @rdname animate_set | #' @rdname animate_set | ||||
| #' @export | #' @export | ||||
| animate_intersect <- function(x, y, export = "gif", ...) { | animate_intersect <- function(x, y, export = "gif", ...) { | ||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_set(x, y, type = "intersect", export = export, ...) | animate_set(x, y, type = "intersect", export = export, ...) | ||||
| } | } | ||||
| #' @rdname animate_set | #' @rdname animate_set | ||||
| #' @export | #' @export | ||||
| animate_setdiff <- function(x, y, export = "gif", ...) { | animate_setdiff <- function(x, y, export = "gif", ...) { | ||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_set(x, y, type = "setdiff", export = export, ...) | animate_set(x, y, type = "setdiff", export = export, ...) | ||||
| } | } |
| #' Animates the gather function | #' Animates the gather function | ||||
| #' | #' | ||||
| #' @param w a data_frame in the wide format | #' @param w a data_frame in the wide format | ||||
| #' @param key the key | #' @param key the key | ||||
| #' @param value the value | #' @param value the value | ||||
| #' @param ... further arguments passed to gather, static_plot, or animate_plot | |||||
| #' @param export the export type, either gif, first or last. The latter two | |||||
| #' export ggplots of the first/last state of the gather function | |||||
| #' @param ... further arguments passed to [tidyr::gather()], [process_wide()], | |||||
| #' or [process_long()] | |||||
| #' @param detailed boolean value if the animation should show one step for each | #' @param detailed boolean value if the animation should show one step for each | ||||
| #' key value | |||||
| #' key value | |||||
| #' @inheritParams animate_join | |||||
| #' @inheritParams anim_options | |||||
| #' | #' | ||||
| #' @return a gif or a ggplot | #' @return a gif or a ggplot | ||||
| #' @export | #' @export | ||||
| #' # if you want to have a less detailed animation, you can also use | #' # if you want to have a less detailed animation, you can also use | ||||
| #' animate_gather(wide, "person", "sales", -year, export = "gif", detailed = FALSE) | #' animate_gather(wide, "person", "sales", -year, export = "gif", detailed = FALSE) | ||||
| #' } | #' } | ||||
| animate_gather <- function(w, key, value, ..., export = "gif", detailed = TRUE) { | |||||
| animate_gather <- function(w, key, value, ..., export = "gif", detailed = TRUE, anim_opts = anim_options()) { | |||||
| anim_opts <- default_anim_opts("gather", anim_opts) | |||||
| lhs <- w | lhs <- w | ||||
| rhs <- tidyr::gather(w, !!key, !!value, ...) | rhs <- tidyr::gather(w, !!key, !!value, ...) | ||||
| # construct the title sequence | # construct the title sequence | ||||
| wname <- deparse(substitute(w)) | wname <- deparse(substitute(w)) | ||||
| ids <- get_quos_names(...) | |||||
| # ids <- "" | |||||
| # what happens if ids := -year or ids := x:y | |||||
| # the case that ... contains two -arguments. i.e., -year, -region | |||||
| ids <- ids[2, ] | |||||
| ids <- ids[!ids %in% c(key, value)] | |||||
| ids <- ids[ids != "-"] | |||||
| tidyr_selection <- get_quos_names(...) | |||||
| ids <- setdiff(colnames(w), tidyselect::vars_select(colnames(w), ...)) | |||||
| id_string <- paste0(", ", paste(sprintf("-%s", ids), collapse = ", ")) | |||||
| id_string <- paste0(", ", paste(sprintf("%s", tidyr_selection), collapse = ", ")) | |||||
| sequence <- c( | sequence <- c( | ||||
| current_state = "Wide", | |||||
| final_state = "Long", | |||||
| current_state = "wide", | |||||
| final_state = "long", | |||||
| operation = sprintf("gather(%s, %s, %s%s)", | operation = sprintf("gather(%s, %s, %s%s)", | ||||
| wname, | wname, | ||||
| dput_parser(key), | dput_parser(key), | ||||
| rhs_proc <- process_long(rhs, ids, key, value, ...) | rhs_proc <- process_long(rhs, ids, key, value, ...) | ||||
| gather_spread(lhs_proc, rhs_proc, sequence = sequence, key_values = key_values, | gather_spread(lhs_proc, rhs_proc, sequence = sequence, key_values = key_values, | ||||
| export = export, detailed = detailed, ...) | |||||
| export = export, detailed = detailed, ..., anim_opts = anim_opts) | |||||
| } | } | ||||
| #' Animates the spread function | #' Animates the spread function | ||||
| #' | #' | ||||
| #' @param l a data_frame in the long/tidy format | #' @param l a data_frame in the long/tidy format | ||||
| #' @param key the key | |||||
| #' @param value the values | |||||
| #' @param export the export type, either gif, first or last. The latter two | |||||
| #' export ggplots of the first/last state of the spread function | |||||
| #' @param detailed boolean value if the animation should show one step for each | |||||
| #' key value | |||||
| #' @param ... further arguments passed to static_plot | |||||
| #' @param ... further arguments passed to [process_long] or [process_wide] | |||||
| #' @inheritParams animate_gather | |||||
| #' @inheritParams animate_join | |||||
| #' @inheritParams anim_options | |||||
| #' | #' | ||||
| #' @return a ggplot or a gif | #' @return a ggplot or a gif | ||||
| #' @export | #' @export | ||||
| #' # if you want to have a less detailed animation, you can also use | #' # if you want to have a less detailed animation, you can also use | ||||
| #' animate_spread(long, key = "person", value = "sales", export = "gif", detailed = FALSE) | #' animate_spread(long, key = "person", value = "sales", export = "gif", detailed = FALSE) | ||||
| #' } | #' } | ||||
| animate_spread <- function(l, key, value, export = "gif", detailed = TRUE, ...) { | |||||
| animate_spread <- function(l, key, value, export = "gif", detailed = TRUE, ..., anim_opts = anim_options()) { | |||||
| anim_opts <- default_anim_opts("spread", anim_opts) | |||||
| lhs <- l | lhs <- l | ||||
| rhs <- tidyr::spread(l, key = key, value = value) | rhs <- tidyr::spread(l, key = key, value = value) | ||||
| id_string <- paste0(", ", paste(sprintf("-%s", ids), collapse = ", ")) | id_string <- paste0(", ", paste(sprintf("-%s", ids), collapse = ", ")) | ||||
| sequence <- c( | sequence <- c( | ||||
| current_state = "Long", | |||||
| final_state = "Wide", | |||||
| current_state = "long", | |||||
| final_state = "wide", | |||||
| operation = sprintf("spread(%s, %s, %s)", | operation = sprintf("spread(%s, %s, %s)", | ||||
| lname, | lname, | ||||
| dput_parser(key), | dput_parser(key), | ||||
| rhs_proc <- process_wide(rhs, ids, key, value, ...) | rhs_proc <- process_wide(rhs, ids, key, value, ...) | ||||
| key_values <- lhs %>% pull(key) %>% unique() | key_values <- lhs %>% pull(key) %>% unique() | ||||
| gather_spread(lhs_proc, rhs_proc, sequence, key_values, export, detailed, ...) | |||||
| gather_spread(lhs_proc, rhs_proc, sequence, key_values, export, detailed, ..., anim_opts = anim_opts) | |||||
| } | } |
| all <- bind_rows(lhs, rhs) | all <- bind_rows(lhs, rhs) | ||||
| # separate column and row-filter (ids) | # separate column and row-filter (ids) | ||||
| x_cols <- distinct(lhs, .col) | |||||
| y_cols <- distinct(rhs, .col) | |||||
| x_cols <- dplyr::distinct(lhs, .col) | |||||
| y_cols <- dplyr::distinct(rhs, .col) | |||||
| # separate header columns from ids and treat them as columns | # separate header columns from ids and treat them as columns | ||||
| x_ids <- distinct(lhs, .id, .id_long) | |||||
| y_ids <- distinct(rhs, .id, .id_long) | |||||
| x_ids <- dplyr::distinct(lhs, .id, .id_long) | |||||
| y_ids <- dplyr::distinct(rhs, .id, .id_long) | |||||
| x_headers <- filter(x_ids, grepl("^\\.header", .id_long)) | x_headers <- filter(x_ids, grepl("^\\.header", .id_long)) | ||||
| y_headers <- filter(y_ids, grepl("^\\.header", .id_long)) | y_headers <- filter(y_ids, grepl("^\\.header", .id_long)) | ||||
| .x = xvals[.col], | .x = xvals[.col], | ||||
| .y = yvals[.id_long]) | .y = yvals[.id_long]) | ||||
| res <- bind_rows( | |||||
| bind_rows( | |||||
| # take, | # take, | ||||
| take_vals, | take_vals, | ||||
| # fade in place: | # fade in place: | ||||
| all %>% filter(.id_long %in% take_ids$.id_long & !.col %in% take_cols$.col) %>% | all %>% filter(.id_long %in% take_ids$.id_long & !.col %in% take_cols$.col) %>% | ||||
| mutate(.alpha = 0) | mutate(.alpha = 0) | ||||
| ) | ) | ||||
| return(res) | |||||
| } | } |
| set_text_color <- function(a) ifelse(apply(col2rgb(a), 2, mean) > 127, "black", "white") | |||||
| #' Animates a plot | |||||
| #' | |||||
| #' @param d a preprocessed dataset | |||||
| #' @param title the plot title | |||||
| #' @param transition_length see transition_states | |||||
| #' @param state_length see transition_states | |||||
| #' @param ... further arguments passed to static_plot | |||||
| #' | |||||
| #' @return a gif | |||||
| #' Animate a Plot | |||||
| #' | #' | ||||
| #' @param d a processed dataset | |||||
| #' @param title the title of the plot | |||||
| #' @param anim_opts Animation options generated with [anim_options()]. Overrides | |||||
| #' any options set in `...`. | |||||
| #' @return a `gganim` object | |||||
| #' @examples | #' @examples | ||||
| #' NULL | #' NULL | ||||
| animate_plot <- function(d, title = "", transition_length = 2, state_length = 1, ...) { | |||||
| static_plot(d, title, ...) + | |||||
| transition_states(.frame, transition_length, state_length) + | |||||
| enter_fade() + | |||||
| exit_fade() + | |||||
| ease_aes("sine-in-out") | |||||
| animate_plot <- function( | |||||
| d, | |||||
| title = "", | |||||
| ..., | |||||
| anim_opts = anim_options(...) | |||||
| ) { | |||||
| ao <- validate_anim_opts(anim_opts) | |||||
| ease_opts <- if (!is.null(ao$ease_other)) { | |||||
| ao$ease_other$default <- ao$ease_default | |||||
| ao$ease_other | |||||
| } else list(default = ao$ease_default) | |||||
| ao_ease_aes <- do.call(ease_aes, ease_opts) | |||||
| static_plot(d, title, anim_opts = ao) + | |||||
| transition_states(.frame, ao$transition_length, ao$state_length) + | |||||
| ao$enter[[1]] + | |||||
| ao$exit[[1]] + | |||||
| ao_ease_aes | |||||
| } | } | ||||
| #' Prints the tiles for a processed dataset statically | #' Prints the tiles for a processed dataset statically | ||||
| #' | #' | ||||
| #' @param d a processed dataset | |||||
| #' @param title the title of the plot | |||||
| #' @param text_family the font for the text | |||||
| #' @param title_family the font for the title | |||||
| #' @param text_size the size of the text | |||||
| #' @param title_size the size of the title | |||||
| #' @param ... further arguments | |||||
| #' @inheritParams animate_plot | |||||
| #' @inheritDotParams anim_options | |||||
| #' | #' | ||||
| #' @return a ggplot | #' @return a ggplot | ||||
| #' | #' | ||||
| #' @examples | #' @examples | ||||
| #' NULL | #' NULL | ||||
| static_plot <- function(d, title = "", | |||||
| text_family = "Fira Sans", title_family = "Fira Mono", | |||||
| text_size = 5, title_size = 17, ...) { | |||||
| static_plot <- function( | |||||
| d, | |||||
| title = "", | |||||
| ..., | |||||
| anim_opts = anim_options(...) | |||||
| ) { | |||||
| ao <- validate_anim_opts(anim_opts) | |||||
| text_size <- get_text_size(ao$text_size) | |||||
| title_size <- get_title_size(ao$title_size) | |||||
| if (!".alpha" %in% names(d)) d <- d %>% mutate(.alpha = 1) | if (!".alpha" %in% names(d)) d <- d %>% mutate(.alpha = 1) | ||||
| if (!".textcolor" %in% names(d)) | if (!".textcolor" %in% names(d)) | ||||
| d <- d %>% mutate(.textcolor = set_text_color(.color)) | |||||
| d <- d %>% mutate(.textcolor = choose_text_color(.color)) | |||||
| if (".id_long" %in% names(d)) { | if (".id_long" %in% names(d)) { | ||||
| d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-")) | d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-")) | ||||
| geom_tile(width = 0.9, height = 0.9) + | geom_tile(width = 0.9, height = 0.9) + | ||||
| coord_equal() + | coord_equal() + | ||||
| geom_text(data = d %>% filter(!is.na(.val)), aes(label = .val, color = .textcolor), | geom_text(data = d %>% filter(!is.na(.val)), aes(label = .val, color = .textcolor), | ||||
| family = text_family, size = text_size) + | |||||
| family = ao$text_family, size = text_size) + | |||||
| scale_fill_identity() + | scale_fill_identity() + | ||||
| scale_color_identity() + | scale_color_identity() + | ||||
| scale_alpha_identity() + | scale_alpha_identity() + | ||||
| labs(title = title) + | labs(title = title) + | ||||
| theme_void() + | theme_void() + | ||||
| theme(plot.title = element_text(family = title_family, hjust = 0.5, size = title_size)) | |||||
| theme(plot.title = element_text(family = ao$title_family, hjust = 0.5, size = title_size)) | |||||
| } | } | ||||
| } | } | ||||
| x <- x %>% | x <- x %>% | ||||
| unite(one_of(by), col = ".id", remove = FALSE) %>% | |||||
| tidyr::unite(dplyr::one_of(by), col = ".id", remove = FALSE) %>% | |||||
| mutate(.id_long = add_duplicate_number(.id)) | mutate(.id_long = add_duplicate_number(.id)) | ||||
| y <- y %>% | y <- y %>% | ||||
| unite(one_of(by), col = ".id", remove = FALSE) %>% | |||||
| tidyr::unite(dplyr::one_of(by), col = ".id", remove = FALSE) %>% | |||||
| mutate(.id_long = add_duplicate_number(.id)) | mutate(.id_long = add_duplicate_number(.id)) | ||||
| ids <- dplyr::union(x %>% dplyr::select(.id, .id_long), | ids <- dplyr::union(x %>% dplyr::select(.id, .id_long), | ||||
| y_ <- process_data_join(y, ids, by, fill = fill, ...) %>% | y_ <- process_data_join(y, ids, by, fill = fill, ...) %>% | ||||
| mutate(.x = .x + ncol(x) - 1) | mutate(.x = .x + ncol(x) - 1) | ||||
| return(list(x = x_, y = y_)) | |||||
| list(x = x_, y = y_) | |||||
| } | } | ||||
| x <- x %>% | x <- x %>% | ||||
| mutate(.r = row_number()) %>% | mutate(.r = row_number()) %>% | ||||
| gather_(key = ".col", value = ".val", names(x)[grepl("^[^.]", names(x))]) %>% | |||||
| # TODO re-evaluate gather_ here | |||||
| tidyr::gather_(key = ".col", value = ".val", names(x)[grepl("^[^.]", names(x))]) %>% | |||||
| mutate(.x = x_keys[.col], | mutate(.x = x_keys[.col], | ||||
| .y = -.r) %>% | .y = -.r) %>% | ||||
| bind_rows(data_frame(.id = ".header", | bind_rows(data_frame(.id = ".header", | ||||
| } | } | ||||
| } | } | ||||
| res <- add_color_join(x, rev(ids$.id), by, ...) | |||||
| return(res) | |||||
| add_color_join(x, rev(ids$.id), by, ...) | |||||
| } | } | ||||
| #' Adds Color to a processed data_frame | #' Adds Color to a processed data_frame | ||||
| .textcolor = text_color) | .textcolor = text_color) | ||||
| if (is.na(text_color)) | if (is.na(text_color)) | ||||
| res <- res %>% mutate(.textcolor = set_text_color(.color)) | |||||
| res <- res %>% mutate(.textcolor = choose_text_color(.color)) | |||||
| return(res) | return(res) | ||||
| } | } |
| #' get_quos_names(-x) | #' get_quos_names(-x) | ||||
| #' get_quos_names(x:y) | #' get_quos_names(x:y) | ||||
| get_quos_names <- function(...) { | get_quos_names <- function(...) { | ||||
| q <- quos(...) | |||||
| sapply(q, function(i) as.character(i[[2]])) | |||||
| q <- rlang::quos(...) | |||||
| purrr::map_chr(q, rlang::quo_name) | |||||
| } | } | ||||
| #' Parses a simple vector so that it looks like its input | #' Parses a simple vector so that it looks like its input | ||||
| #' @examples | #' @examples | ||||
| #' dput_parser("x") | #' dput_parser("x") | ||||
| #' dput_parser(c("x", "y")) | #' dput_parser(c("x", "y")) | ||||
| dput_parser <- function(x) { | |||||
| ifelse(length(x) == 1, | |||||
| sprintf("'%s'", x), | |||||
| paste0("c(", | |||||
| paste(sprintf("'%s'", x), collapse = ", "), | |||||
| ")")) | |||||
| dput_parser <- function(x) UseMethod("dput_parser") | |||||
| dput_parser.character <- function(x) { | |||||
| if (length(x) == 1) { | |||||
| sprintf('"%s"', x) | |||||
| } else { | |||||
| x <- capture.output(dput(x)) | |||||
| paste(x, collapse = "") | |||||
| } | |||||
| } | } | ||||
| #' Adds color to processed tidy data | #' Adds color to processed tidy data | ||||
| key_values <- names(x) | key_values <- names(x) | ||||
| key_values <- key_values[!key_values %in% ids] | key_values <- key_values[!key_values %in% ids] | ||||
| id_values <- x %>% select(one_of(ids)) | |||||
| id_values <- id_values %>% gather(key = ".key_map", value = ".id_map") | |||||
| id_values <- x %>% select(dplyr::one_of(ids)) | |||||
| id_values <- id_values %>% tidyr::gather(key = ".key_map", value = ".id_map") | |||||
| x <- x %>% mutate(.r = row_number()) %>% | x <- x %>% mutate(.r = row_number()) %>% | ||||
| unite(one_of(ids), col = ".id_map", remove = F) | |||||
| tidyr::unite(dplyr::one_of(ids), col = ".id_map", remove = F) | |||||
| x <- x %>% | x <- x %>% | ||||
| gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>% | gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>% | ||||
| tmp <- x %>% filter(.key_map %in% ids) | tmp <- x %>% filter(.key_map %in% ids) | ||||
| x <- bind_rows( | x <- bind_rows( | ||||
| left_join(tmp %>% select(-.key_map), | left_join(tmp %>% select(-.key_map), | ||||
| tmp %>% select(.id_map) %>% crossing(.key_map = key_values), | |||||
| tmp %>% select(.id_map) %>% tidyr::crossing(.key_map = key_values), | |||||
| by = ".id_map"), | by = ".id_map"), | ||||
| x %>% filter(!.key_map %in% ids) | x %>% filter(!.key_map %in% ids) | ||||
| ) | ) | ||||
| # add header: | # add header: | ||||
| crosser <- crossing(.id_map = as.character(id_values$.id_map), | |||||
| crosser <- tidyr::crossing(.id_map = as.character(id_values$.id_map), | |||||
| .key_map = key_values) | .key_map = key_values) | ||||
| key_header <- data_frame( | key_header <- data_frame( | ||||
| .key_map = key_values, | .key_map = key_values, | ||||
| .x = 1:length(ids), | .x = 1:length(ids), | ||||
| .y = 0, | .y = 0, | ||||
| .header = TRUE), | .header = TRUE), | ||||
| crossing(.id_map = ids, .key_map = key_values), | |||||
| tidyr::crossing(.id_map = ids, .key_map = key_values), | |||||
| by = ".id_map" | by = ".id_map" | ||||
| ) | ) | ||||
| x <- bind_rows(id_header, key_header, x) | x <- bind_rows(id_header, key_header, x) | ||||
| x <- x %>% unite(.key_map, .id_map, .val, col = ".id", remove = F) | |||||
| x <- x %>% tidyr::unite(.key_map, .id_map, .val, col = ".id", remove = F) | |||||
| x %>% | x %>% | ||||
| add_color_tidyr(key_values = key_values) %>% | add_color_tidyr(key_values = key_values) %>% | ||||
| xn <- names(x) | xn <- names(x) | ||||
| x <- x %>% mutate(.r = row_number()) %>% | x <- x %>% mutate(.r = row_number()) %>% | ||||
| unite(ids, col = ".id_map", remove = F) %>% | |||||
| unite(key, col = ".key_map", remove = F) | |||||
| tidyr::unite(ids, col = ".id_map", remove = F) %>% | |||||
| tidyr::unite(key, col = ".key_map", remove = F) | |||||
| key_values <- x %>% pull(key) %>% unique() | key_values <- x %>% pull(key) %>% unique() | ||||
| names(x_dict) <- xn | names(x_dict) <- xn | ||||
| x <- x %>% | x <- x %>% | ||||
| gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>% | |||||
| tidyr::gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>% | |||||
| mutate( | mutate( | ||||
| .x = x_dict[.col], | .x = x_dict[.col], | ||||
| .y = -rep(1:nr, nc), | .y = -rep(1:nr, nc), | ||||
| # add headers: | # add headers: | ||||
| id_headers <- crossing(.id_map = ids, # x$.id_map %>% unique() | |||||
| .key_map = key_values, | |||||
| ) %>% | |||||
| id_headers <- tidyr::crossing(.id_map = ids, # x$.id_map %>% unique() | |||||
| .key_map = key_values, | |||||
| ) %>% | |||||
| mutate( | mutate( | ||||
| .r = 0, | .r = 0, | ||||
| .col = "id", | .col = "id", | ||||
| ) | ) | ||||
| x <- x %>% | x <- x %>% | ||||
| add_row( | |||||
| dplyr::add_row( | |||||
| .before = T, | .before = T, | ||||
| .id_map = c(rep("key", length(key)), rep("value", length(value))), | .id_map = c(rep("key", length(key)), rep("value", length(value))), | ||||
| .key_map = c(rep("key", length(key)), rep("value", length(value))), | .key_map = c(rep("key", length(key)), rep("value", length(value))), | ||||
| x <- bind_rows(id_headers, x) | x <- bind_rows(id_headers, x) | ||||
| x <- x %>% | x <- x %>% | ||||
| unite(.key_map, .id_map, .val, col = ".id", remove = F) | |||||
| tidyr::unite(.key_map, .id_map, .val, col = ".id", remove = F) | |||||
| x %>% add_color_tidyr(key_values = key_values) %>% | x %>% add_color_tidyr(key_values = key_values) %>% | ||||
| mutate(.alpha = ifelse(.header == TRUE, 1, 0.6)) | mutate(.alpha = ifelse(.header == TRUE, 1, 0.6)) | ||||
| #' | #' | ||||
| #' @examples | #' @examples | ||||
| #' NULL | #' NULL | ||||
| gather_spread <- function(lhs, rhs, sequence, key_values, export, detailed, ...) { | |||||
| gather_spread <- function(lhs, rhs, sequence, key_values, export, detailed, ..., anim_opts = anim_options()) { | |||||
| # lhs is the one state of the df | # lhs is the one state of the df | ||||
| # rhs is the target state | # rhs is the target state | ||||
| labels = frame_labels)) | labels = frame_labels)) | ||||
| if (export == "gif") { | if (export == "gif") { | ||||
| animate_plot(anim_df, title = title_string, transition_length = tl, state_length = sl) #, ...) | |||||
| animate_plot(anim_df, title = title_string, anim_opts = anim_opts) | |||||
| } else if (export == "first") { | } else if (export == "first") { | ||||
| static_plot(state_start) #.... | |||||
| static_plot(state_start, anim_opts = anim_opts) #.... | |||||
| } else if (export == "last") { | } else if (export == "last") { | ||||
| static_plot(state_end) #.... | |||||
| static_plot(state_end, anim_opts = anim_opts) #.... | |||||
| } | } | ||||
| # open issues: ... doesnt work properly. | # open issues: ... doesnt work properly. |
| `%||%` <- function(x, y) if (is.null(x)) y else x | |||||
| choose_text_color <- function(x, black = "#000000", white = "#FFFFFF") { | |||||
| # x = color_hex | |||||
| color_rgb <- col2rgb(x) | |||||
| # modified from https://stackoverflow.com/a/3943023/2022615 | |||||
| # following W3 guidelines: https://www.w3.org/TR/WCAG20/#relativeluminancedef | |||||
| color_rgb <- color_rgb / 255 | |||||
| color_rgb[color_rgb <= 0.03928] <- color_rgb[color_rgb <= 0.03928]/12.92 | |||||
| color_rgb[color_rgb > 0.03928] <- ((color_rgb[color_rgb > 0.03928] + 0.055)/1.055)^2.4 | |||||
| lum <- t(color_rgb) %*% c(0.2126, 0.7152, 0.0722) | |||||
| lum <- lum[,1] | |||||
| # threshold is supposed to be 0.179 but 1/3 seems to work better for our plots | |||||
| ifelse(lum > 1/3, black, white) | |||||
| } | |||||
| get_input_text <- function(x) { | |||||
| if (!rlang::is_quosure(x)) x <- rlang::enquo(x) | |||||
| rlang::quo_name(x) | |||||
| } | |||||
| make_named_data <- function(x, y, data_names = c("x", "y")) { | |||||
| ll <- rlang::eval_tidy(rlang::quo(list(!!x, !!y))) | |||||
| names(ll) <- data_names | |||||
| ll | |||||
| } |
| #' @importFrom dplyr left_join right_join full_join inner_join semi_join anti_join | #' @importFrom dplyr left_join right_join full_join inner_join semi_join anti_join | ||||
| #' @importFrom dplyr mutate select filter arrange bind_rows bind_cols group_by pull | |||||
| #' @importFrom dplyr mutate select filter arrange bind_rows bind_cols group_by pull slice data_frame row_number | |||||
| #' @importFrom tidyr gather spread | |||||
| #' @keywords internal | #' @keywords internal | ||||
| "_PACKAGE" | "_PACKAGE" | ||||
| plot_settings <- new.env(parent = emptyenv()) | |||||
| plot_settings$default <- list( | |||||
| transition_length = 2, | |||||
| state_length = 1, | |||||
| ease_default = "sine-in-out", | |||||
| ease_other = NULL, | |||||
| enter = setNames(list(enter_fade()), "enter_fade()"), | |||||
| exit = setNames(list(exit_fade()), "exit_fade()"), | |||||
| text_family = "Fira Mono", | |||||
| title_family = "Fira Mono", | |||||
| text_size = 5, | |||||
| title_size = 17 | |||||
| ) | |||||
| --- | --- | ||||
| output: github_document | output: github_document | ||||
| editor_options: | |||||
| chunk_output_type: console | |||||
| --- | --- | ||||
| <!-- README.md is generated from README.Rmd. Please edit that file --> | <!-- README.md is generated from README.Rmd. Please edit that file --> | ||||
| echo = TRUE, | echo = TRUE, | ||||
| warning = FALSE, | warning = FALSE, | ||||
| message = FALSE, | message = FALSE, | ||||
| fig.path = "man/figures/tidyexplain-", | |||||
| cache = TRUE | cache = TRUE | ||||
| ) | ) | ||||
| library(tidyAnimatedVerbs) | |||||
| library(tidyexplain) | |||||
| set_font_size(11, 26) | |||||
| ``` | ``` | ||||
| [gganimate]: https://github.com/thomasp85/gganimate#README | [gganimate]: https://github.com/thomasp85/gganimate#README | ||||
| - Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) | - Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) | ||||
| - Learn more about | - Learn more about | ||||
| - [Relational Data](#relational-data) | |||||
| - [gganimate](#gganimate) | |||||
| - [Relational Data](#relational-data) | |||||
| - [gganimate](#gganimate) | |||||
| Please feel free to use these images for teaching or learning about action verbs from the [tidyverse](https://tidyverse.org). | Please feel free to use these images for teaching or learning about action verbs from the [tidyverse](https://tidyverse.org). | ||||
| ## Installing | ## Installing | ||||
| The library can be installed with | |||||
| ```{r, echo=T,eval=F} | |||||
| The in-development version of `tidyexplain` can be installed with `devtools`: | |||||
| ```r | |||||
| # install.package("devtools") | # install.package("devtools") | ||||
| devtools::install_github("gadenbuie/tidy-animated-verbs") | devtools::install_github("gadenbuie/tidy-animated-verbs") | ||||
| library(tidyexplain) | |||||
| ``` | ``` | ||||
| ## Mutating Joins | ## Mutating Joins | ||||
| ```{r intial-dfs, echo=T} | |||||
| library(tidyAnimatedVerbs) | |||||
| x <- data_frame( | |||||
| ```{r intial-dfs} | |||||
| x <- dplyr::data_frame( | |||||
| id = 1:3, | id = 1:3, | ||||
| x = paste0("x", 1:3) | x = paste0("x", 1:3) | ||||
| ) | ) | ||||
| y <- data_frame( | |||||
| y <- dplyr::data_frame( | |||||
| id = (1:4)[-3], | id = (1:4)[-3], | ||||
| y = paste0("y", (1:4)[-3]) | y = paste0("y", (1:4)[-3]) | ||||
| ) | ) | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| ```{r} | |||||
| x | x | ||||
| y | y | ||||
| ``` | ``` | ||||
| > All rows from `x` where there are matching values in `y`, and all columns from `x` and `y`. | > All rows from `x` where there are matching values in `y`, and all columns from `x` and `y`. | ||||
| ```{r inner-join, echo=T} | |||||
| ```{r inner-join} | |||||
| animate_inner_join(x, y, by = "id") | animate_inner_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| inner_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::inner_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ### Left Join | ### Left Join | ||||
| > All rows from `x`, and all columns from `x` and `y`. Rows in `x` with no match in `y` will have `NA` values in the new columns. | > All rows from `x`, and all columns from `x` and `y`. Rows in `x` with no match in `y` will have `NA` values in the new columns. | ||||
| ```{r left-join, echo=T} | |||||
| ```{r left-join} | |||||
| animate_left_join(x, y, by = "id") | animate_left_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| left_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::left_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ### Left Join (Extra Rows in y) | ### Left Join (Extra Rows in y) | ||||
| > ... If there are multiple matches between `x` and `y`, all combinations of the matches are returned. | > ... If there are multiple matches between `x` and `y`, all combinations of the matches are returned. | ||||
| ```{r left-join-extra, echo=T} | |||||
| y_extra <- bind_rows(y, data_frame(id = 2, y = "y5")) | |||||
| ```{r left-join-extra} | |||||
| y_extra <- dplyr::bind_rows(y, dplyr::data_frame(id = 2, y = "y5")) | |||||
| y_extra # has multiple rows with the key from `x` | y_extra # has multiple rows with the key from `x` | ||||
| animate_left_join(x, y_extra, by = "id") | |||||
| animate_left_join(x, y_extra, by = "id", | |||||
| anim_opts = anim_options(title_size = 22)) | |||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| left_join(x, y_extra, by = "id") | |||||
| ```{r} | |||||
| dplyr::left_join(x, y_extra, by = "id") | |||||
| ``` | ``` | ||||
| ### Right Join | ### Right Join | ||||
| > All rows from y, and all columns from `x` and `y`. Rows in `y` with no match in `x` will have `NA` values in the new columns. | > All rows from y, and all columns from `x` and `y`. Rows in `y` with no match in `x` will have `NA` values in the new columns. | ||||
| ```{r right-join, echo = T} | |||||
| ```{r right-join} | |||||
| animate_right_join(x, y, by = "id") | animate_right_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| right_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::right_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ### Full Join | ### Full Join | ||||
| > All rows and all columns from both `x` and `y`. Where there are not matching values, returns `NA` for the one missing. | > All rows and all columns from both `x` and `y`. Where there are not matching values, returns `NA` for the one missing. | ||||
| ```{r full-join, echo=T} | |||||
| ```{r full-join} | |||||
| animate_full_join(x, y, by = "id") | animate_full_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| full_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::full_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ## Filtering Joins | ## Filtering Joins | ||||
| > All rows from `x` where there are matching values in `y`, keeping just columns from `x`. | > All rows from `x` where there are matching values in `y`, keeping just columns from `x`. | ||||
| ```{r semi-join, echo=T} | |||||
| ```{r semi-join} | |||||
| animate_semi_join(x, y, by = "id") | animate_semi_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| semi_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::semi_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ### Anti Join | ### Anti Join | ||||
| > All rows from `x` where there are not matching values in `y`, keeping just columns from `x`. | > All rows from `x` where there are not matching values in `y`, keeping just columns from `x`. | ||||
| ```{r anti-join, echo=T} | |||||
| ```{r anti-join} | |||||
| animate_anti_join(x, y, by = "id") | animate_anti_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| anti_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::anti_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ## Set Operations | ## Set Operations | ||||
| ```{r intial-dfs-so, echo=T} | |||||
| x <- data_frame( | |||||
| ```{r intial-dfs-so} | |||||
| x <- dplyr::data_frame( | |||||
| x = c(1, 1, 2), | x = c(1, 1, 2), | ||||
| y = c("a", "b", "a") | y = c("a", "b", "a") | ||||
| ) | ) | ||||
| y <- data_frame( | |||||
| y <- dplyr::data_frame( | |||||
| x = c(1, 2), | x = c(1, 2), | ||||
| y = c("a", "b") | y = c("a", "b") | ||||
| ) | ) | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| ```{r} | |||||
| x | x | ||||
| y | y | ||||
| ``` | ``` | ||||
| > All unique rows from `x` and `y`. | > All unique rows from `x` and `y`. | ||||
| ```{r union, echo=T} | |||||
| ```{r union} | |||||
| animate_union(x, y) | animate_union(x, y) | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| union(x, y) | |||||
| ```{r} | |||||
| dplyr::union(x, y) | |||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| ```{r union-y-x} | |||||
| animate_union(y, x) | animate_union(y, x) | ||||
| union(y, x) | |||||
| dplyr::union(y, x) | |||||
| ``` | ``` | ||||
| ### Union All | ### Union All | ||||
| > All rows from `x` and `y`, keeping duplicates. | > All rows from `x` and `y`, keeping duplicates. | ||||
| ```{r union-all, echo=T} | |||||
| ```{r union-all} | |||||
| animate_union_all(x, y) | animate_union_all(x, y) | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| union_all(x, y) | |||||
| ```{r} | |||||
| dplyr::union_all(x, y) | |||||
| ``` | ``` | ||||
| > Common rows in both `x` and `y`, keeping just unique rows. | > Common rows in both `x` and `y`, keeping just unique rows. | ||||
| ```{r intersect, echo=T} | |||||
| ```{r intersect} | |||||
| animate_intersect(x, y) | animate_intersect(x, y) | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| intersect(x, y) | |||||
| ```{r} | |||||
| dplyr::intersect(x, y) | |||||
| ``` | ``` | ||||
| ### Set Difference | ### Set Difference | ||||
| > All rows from `x` which are not also rows in `y`, keeping just unique rows. | > All rows from `x` which are not also rows in `y`, keeping just unique rows. | ||||
| ```{r setdiff, echo=T} | |||||
| ```{r setdiff} | |||||
| animate_setdiff(x, y) | animate_setdiff(x, y) | ||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| setdiff(x, y) | |||||
| ```{r} | |||||
| dplyr::setdiff(x, y) | |||||
| ``` | ``` | ||||
| ```{r echo=TRUE} | |||||
| ```{r setdiff-y-x} | |||||
| animate_setdiff(y, x) | animate_setdiff(y, x) | ||||
| setdiff(y, x) | |||||
| dplyr::setdiff(y, x) | |||||
| ``` | ``` | ||||
| ## Tidy Data and `gather()`, `spread()` functionality | ## Tidy Data and `gather()`, `spread()` functionality | ||||
| you organize your data into tidy data. | you organize your data into tidy data. | ||||
| ```{r} | ```{r} | ||||
| long <- data_frame( | |||||
| long <- dplyr::data_frame( | |||||
| year = c(2010, 2011, 2010, 2011, 2010, 2011), | year = c(2010, 2011, 2010, 2011, 2010, 2011), | ||||
| person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), | person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), | ||||
| sales = c(105, 110, 100, 97, 90, 95) | sales = c(105, 110, 100, 97, 90, 95) | ||||
| ) | ) | ||||
| wide <- data_frame( | |||||
| wide <- dplyr::data_frame( | |||||
| year = 2010:2011, | year = 2010:2011, | ||||
| Alice = c(105, 110), | Alice = c(105, 110), | ||||
| Bob = c(100, 97), | Bob = c(100, 97), | ||||
| ) | ) | ||||
| ``` | ``` | ||||
| ### Gather | ### Gather | ||||
| > Gather takes multiple columns and collapses into key-value pairs, duplicating all other columns as needed. You use gather() when you notice that your column names are not names of variables, but values of a variable. | > Gather takes multiple columns and collapses into key-value pairs, duplicating all other columns as needed. You use gather() when you notice that your column names are not names of variables, but values of a variable. | ||||
| ```{r} | |||||
| ```{r gather} | |||||
| set_font_size(4.5, 15) | |||||
| animate_gather(wide, key = "person", value = "sales", -year) | animate_gather(wide, key = "person", value = "sales", -year) | ||||
| ``` | ``` | ||||
| ```{r} | ```{r} | ||||
| gather(wide, key = "person", value = "sales", -year) | |||||
| tidyr::gather(wide, key = "person", value = "sales", -year) | |||||
| ``` | ``` | ||||
| ### Spread | ### Spread | ||||
| > Spread a key-value pair across multiple columns. Use it when an a column contains observations from multiple variables. | > Spread a key-value pair across multiple columns. Use it when an a column contains observations from multiple variables. | ||||
| ```{r} | |||||
| ```{r spread} | |||||
| animate_spread(long, key = "person", value = "sales") | animate_spread(long, key = "person", value = "sales") | ||||
| ``` | ``` | ||||
| ```{r} | ```{r} | ||||
| spread(long, key = "person", value = "sales") | |||||
| tidyr::spread(long, key = "person", value = "sales") | |||||
| ``` | ``` | ||||
| ## Learn More | ## Learn More | ||||
| ### Relational Data | ### Relational Data |
| - Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) | - Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) | ||||
| - Learn more about | - Learn more about | ||||
| - [Relational Data](#relational-data) | |||||
| - [gganimate](#gganimate) | |||||
| - [Relational Data](#relational-data) | |||||
| - [gganimate](#gganimate) | |||||
| Please feel free to use these images for teaching or learning about | Please feel free to use these images for teaching or learning about | ||||
| action verbs from the [tidyverse](https://tidyverse.org). You can | action verbs from the [tidyverse](https://tidyverse.org). You can | ||||
| ## Installing | ## Installing | ||||
| The library can be installed with | |||||
| The in-development version of `tidyexplain` can be installed with | |||||
| `devtools`: | |||||
| ``` r | ``` r | ||||
| # install.package("devtools") | # install.package("devtools") | ||||
| devtools::install_github("gadenbuie/tidy-animated-verbs") | devtools::install_github("gadenbuie/tidy-animated-verbs") | ||||
| library(tidyexplain) | |||||
| ``` | ``` | ||||
| ## Mutating Joins | ## Mutating Joins | ||||
| ``` r | ``` r | ||||
| library(tidyAnimatedVerbs) | |||||
| x <- data_frame( | |||||
| x <- dplyr::data_frame( | |||||
| id = 1:3, | id = 1:3, | ||||
| x = paste0("x", 1:3) | x = paste0("x", 1:3) | ||||
| ) | ) | ||||
| y <- data_frame( | |||||
| y <- dplyr::data_frame( | |||||
| id = (1:4)[-3], | id = (1:4)[-3], | ||||
| y = paste0("y", (1:4)[-3]) | y = paste0("y", (1:4)[-3]) | ||||
| ) | ) | ||||
| animate_full_join(x, y, by = c("id"), export = "first") | animate_full_join(x, y, by = c("id"), export = "first") | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| x | x | ||||
| animate_inner_join(x, y, by = "id") | animate_inner_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| inner_join(x, y, by = "id") | |||||
| dplyr::inner_join(x, y, by = "id") | |||||
| #> # A tibble: 2 x 3 | #> # A tibble: 2 x 3 | ||||
| #> id x y | #> id x y | ||||
| #> <int> <chr> <chr> | #> <int> <chr> <chr> | ||||
| animate_left_join(x, y, by = "id") | animate_left_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| left_join(x, y, by = "id") | |||||
| dplyr::left_join(x, y, by = "id") | |||||
| #> # A tibble: 3 x 3 | #> # A tibble: 3 x 3 | ||||
| #> id x y | #> id x y | ||||
| #> <int> <chr> <chr> | #> <int> <chr> <chr> | ||||
| > of the matches are returned. | > of the matches are returned. | ||||
| ``` r | ``` r | ||||
| y_extra <- bind_rows(y, data_frame(id = 2, y = "y5")) | |||||
| y_extra <- dplyr::bind_rows(y, dplyr::data_frame(id = 2, y = "y5")) | |||||
| y_extra # has multiple rows with the key from `x` | y_extra # has multiple rows with the key from `x` | ||||
| #> # A tibble: 4 x 2 | #> # A tibble: 4 x 2 | ||||
| #> id y | #> id y | ||||
| #> 3 4 y4 | #> 3 4 y4 | ||||
| #> 4 2 y5 | #> 4 2 y5 | ||||
| animate_left_join(x, y_extra, by = "id") | |||||
| animate_left_join(x, y_extra, by = "id", | |||||
| anim_opts = anim_options(title_size = 22)) | |||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| left_join(x, y_extra, by = "id") | |||||
| dplyr::left_join(x, y_extra, by = "id") | |||||
| #> # A tibble: 4 x 3 | #> # A tibble: 4 x 3 | ||||
| #> id x y | #> id x y | ||||
| #> <dbl> <chr> <chr> | #> <dbl> <chr> <chr> | ||||
| animate_right_join(x, y, by = "id") | animate_right_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| right_join(x, y, by = "id") | |||||
| dplyr::right_join(x, y, by = "id") | |||||
| #> # A tibble: 3 x 3 | #> # A tibble: 3 x 3 | ||||
| #> id x y | #> id x y | ||||
| #> <int> <chr> <chr> | #> <int> <chr> <chr> | ||||
| animate_full_join(x, y, by = "id") | animate_full_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| full_join(x, y, by = "id") | |||||
| dplyr::full_join(x, y, by = "id") | |||||
| #> # A tibble: 4 x 3 | #> # A tibble: 4 x 3 | ||||
| #> id x y | #> id x y | ||||
| #> <int> <chr> <chr> | #> <int> <chr> <chr> | ||||
| animate_semi_join(x, y, by = "id") | animate_semi_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| semi_join(x, y, by = "id") | |||||
| dplyr::semi_join(x, y, by = "id") | |||||
| #> # A tibble: 2 x 2 | #> # A tibble: 2 x 2 | ||||
| #> id x | #> id x | ||||
| #> <int> <chr> | #> <int> <chr> | ||||
| animate_anti_join(x, y, by = "id") | animate_anti_join(x, y, by = "id") | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| anti_join(x, y, by = "id") | |||||
| dplyr::anti_join(x, y, by = "id") | |||||
| #> # A tibble: 1 x 2 | #> # A tibble: 1 x 2 | ||||
| #> id x | #> id x | ||||
| #> <int> <chr> | #> <int> <chr> | ||||
| ## Set Operations | ## Set Operations | ||||
| ``` r | ``` r | ||||
| x <- data_frame( | |||||
| x <- dplyr::data_frame( | |||||
| x = c(1, 1, 2), | x = c(1, 1, 2), | ||||
| y = c("a", "b", "a") | y = c("a", "b", "a") | ||||
| ) | ) | ||||
| y <- data_frame( | |||||
| y <- dplyr::data_frame( | |||||
| x = c(1, 2), | x = c(1, 2), | ||||
| y = c("a", "b") | y = c("a", "b") | ||||
| ) | ) | ||||
| animate_union(x, y, export = "first") | animate_union(x, y, export = "first") | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| x | x | ||||
| animate_union(x, y) | animate_union(x, y) | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| union(x, y) | |||||
| dplyr::union(x, y) | |||||
| #> # A tibble: 4 x 2 | #> # A tibble: 4 x 2 | ||||
| #> x y | #> x y | ||||
| #> <dbl> <chr> | #> <dbl> <chr> | ||||
| animate_union(y, x) | animate_union(y, x) | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| union(y, x) | |||||
| dplyr::union(y, x) | |||||
| #> # A tibble: 4 x 2 | #> # A tibble: 4 x 2 | ||||
| #> x y | #> x y | ||||
| #> <dbl> <chr> | #> <dbl> <chr> | ||||
| animate_union_all(x, y) | animate_union_all(x, y) | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| union_all(x, y) | |||||
| dplyr::union_all(x, y) | |||||
| #> # A tibble: 5 x 2 | #> # A tibble: 5 x 2 | ||||
| #> x y | #> x y | ||||
| #> <dbl> <chr> | #> <dbl> <chr> | ||||
| animate_intersect(x, y) | animate_intersect(x, y) | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| intersect(x, y) | |||||
| dplyr::intersect(x, y) | |||||
| #> # A tibble: 1 x 2 | #> # A tibble: 1 x 2 | ||||
| #> x y | #> x y | ||||
| #> <dbl> <chr> | #> <dbl> <chr> | ||||
| animate_setdiff(x, y) | animate_setdiff(x, y) | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| setdiff(x, y) | |||||
| dplyr::setdiff(x, y) | |||||
| #> # A tibble: 2 x 2 | #> # A tibble: 2 x 2 | ||||
| #> x y | #> x y | ||||
| #> <dbl> <chr> | #> <dbl> <chr> | ||||
| animate_setdiff(y, x) | animate_setdiff(y, x) | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| setdiff(y, x) | |||||
| dplyr::setdiff(y, x) | |||||
| #> # A tibble: 1 x 2 | #> # A tibble: 1 x 2 | ||||
| #> x y | #> x y | ||||
| #> <dbl> <chr> | #> <dbl> <chr> | ||||
| you organize your data into tidy data. | you organize your data into tidy data. | ||||
| ``` r | ``` r | ||||
| long <- data_frame( | |||||
| long <- dplyr::data_frame( | |||||
| year = c(2010, 2011, 2010, 2011, 2010, 2011), | year = c(2010, 2011, 2010, 2011, 2010, 2011), | ||||
| person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), | person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), | ||||
| sales = c(105, 110, 100, 97, 90, 95) | sales = c(105, 110, 100, 97, 90, 95) | ||||
| ) | ) | ||||
| wide <- data_frame( | |||||
| wide <- dplyr::data_frame( | |||||
| year = 2010:2011, | year = 2010:2011, | ||||
| Alice = c(105, 110), | Alice = c(105, 110), | ||||
| Bob = c(100, 97), | Bob = c(100, 97), | ||||
| > of a variable. | > of a variable. | ||||
| ``` r | ``` r | ||||
| set_font_size(4.5, 15) | |||||
| animate_gather(wide, key = "person", value = "sales", -year) | animate_gather(wide, key = "person", value = "sales", -year) | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| gather(wide, key = "person", value = "sales", -year) | |||||
| tidyr::gather(wide, key = "person", value = "sales", -year) | |||||
| #> # A tibble: 6 x 3 | #> # A tibble: 6 x 3 | ||||
| #> year person sales | #> year person sales | ||||
| #> <int> <chr> <dbl> | #> <int> <chr> <dbl> | ||||
| animate_spread(long, key = "person", value = "sales") | animate_spread(long, key = "person", value = "sales") | ||||
| ``` | ``` | ||||
| <!-- --> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| spread(long, key = "person", value = "sales") | |||||
| tidyr::spread(long, key = "person", value = "sales") | |||||
| #> # A tibble: 2 x 4 | #> # A tibble: 2 x 4 | ||||
| #> year Alice Bob Charlie | #> year Alice Bob Charlie | ||||
| #> <dbl> <dbl> <dbl> <dbl> | #> <dbl> <dbl> <dbl> <dbl> |
| % Generated by roxygen2: do not edit by hand | |||||
| % Please edit documentation in R/animate_options.R | |||||
| \name{anim_options} | |||||
| \alias{anim_options} | |||||
| \alias{anim_options_set} | |||||
| \title{Animation Options} | |||||
| \usage{ | |||||
| anim_options(transition_length = NULL, state_length = NULL, | |||||
| ease_default = NULL, ease_other = NULL, enter = NULL, | |||||
| exit = NULL, text_family = NULL, title_family = NULL, | |||||
| text_size = NULL, title_size = NULL, ...) | |||||
| anim_options_set(anim_opts = anim_options()) | |||||
| } | |||||
| \arguments{ | |||||
| \item{transition_length}{The relative length of the transition. Will be | |||||
| recycled to match the number of states in the data} | |||||
| \item{state_length}{The relative length of the pause at the states. Will be | |||||
| recycled to match the number of states in the data} | |||||
| \item{ease_default}{Default aes easing function. See \code{\link[tweenr:display_ease]{tweenr::display_ease()}} | |||||
| for more options. The tidyexplain default value is \code{sine-in-out}.} | |||||
| \item{ease_other}{Additional aes easing options, specified as a named list. | |||||
| List entries are named with the aesthetic to which the easeing should be | |||||
| applied, consistent with \code{\link[gganimate:ease_aes]{gganimate::ease_aes()}}. E.g. \code{list(color = "sine")}.} | |||||
| \item{enter}{Enter fading function applied to objects in the animation. See | |||||
| \link[gganimate:enter_exit]{gganimate::enter_exit} for a complete list of options. The tidyexplain | |||||
| default is \code{\link[gganimate:enter_fade]{gganimate::enter_fade()}}.} | |||||
| \item{exit}{Exit fading function applied to objects in the animation. See | |||||
| \link[gganimate:enter_exit]{gganimate::enter_exit} for a complete list of options. The tidyexplain | |||||
| default is \code{\link[gganimate:exit_fade]{gganimate::exit_fade()}}.} | |||||
| \item{text_family}{Font family for the plot text, default is "Fira Mono". Use | |||||
| \code{\link[=set_font_size]{set_font_size()}} to set global default font sizes.} | |||||
| \item{title_family}{Font family for the plot title, default is "Fira Mono". | |||||
| Use \code{\link[=set_font_size]{set_font_size()}} to set global default font sizes.} | |||||
| \item{text_size}{Font size of the plot text, default is 5.} | |||||
| \item{title_size}{Font size of the plot title, default is 17.} | |||||
| \item{anim_opts}{An \code{\link[=anim_options]{anim_options()}} options list.} | |||||
| } | |||||
| \description{ | |||||
| Helper function to set animation and plotting options to be passed to | |||||
| \code{\link[=animate_plot]{animate_plot()}} and \code{\link[=static_plot]{static_plot()}}. | |||||
| } | |||||
| \section{Functions}{ | |||||
| \itemize{ | |||||
| \item \code{anim_options_set}: Set default animation options for the current session. | |||||
| }} | |||||
| \alias{animate_gather} | \alias{animate_gather} | ||||
| \title{Animates the gather function} | \title{Animates the gather function} | ||||
| \usage{ | \usage{ | ||||
| animate_gather(w, key, value, ..., export = "gif", detailed = TRUE) | |||||
| animate_gather(w, key, value, ..., export = "gif", detailed = TRUE, | |||||
| anim_opts = anim_options()) | |||||
| } | } | ||||
| \arguments{ | \arguments{ | ||||
| \item{w}{a data_frame in the wide format} | \item{w}{a data_frame in the wide format} | ||||
| \item{value}{the value} | \item{value}{the value} | ||||
| \item{...}{further arguments passed to gather, static_plot, or animate_plot} | |||||
| \item{...}{further arguments passed to \code{\link[tidyr:gather]{tidyr::gather()}}, \code{\link[=process_wide]{process_wide()}}, | |||||
| or \code{\link[=process_long]{process_long()}}} | |||||
| \item{export}{the export type, either gif, first or last. The latter two | \item{export}{the export type, either gif, first or last. The latter two | ||||
| export ggplots of the first/last state of the gather function} | |||||
| export ggplots of the first/last state of the join} | |||||
| \item{detailed}{boolean value if the animation should show one step for each | \item{detailed}{boolean value if the animation should show one step for each | ||||
| key value} | key value} | ||||
| \item{anim_opts}{An \code{\link[=anim_options]{anim_options()}} options list.} | |||||
| } | } | ||||
| \value{ | \value{ | ||||
| a gif or a ggplot | a gif or a ggplot |
| \alias{animate_anti_join} | \alias{animate_anti_join} | ||||
| \title{Animates a join operation} | \title{Animates a join operation} | ||||
| \usage{ | \usage{ | ||||
| animate_join(x, y, by, type = c("full_join", "inner_join", "left_join", | |||||
| "right_join", "semi_join", "anti_join"), export = c("gif", "first", | |||||
| "last"), ...) | |||||
| animate_full_join(x, y, by, export = "gif", ...) | animate_full_join(x, y, by, export = "gif", ...) | ||||
| animate_inner_join(x, y, by, export = "gif", ...) | animate_inner_join(x, y, by, export = "gif", ...) | ||||
| dynamic as a gif. | dynamic as a gif. | ||||
| } | } | ||||
| \examples{ | \examples{ | ||||
| x <- data_frame( | |||||
| id = 1:3, | |||||
| x = paste0("x", 1:3) | |||||
| ) | |||||
| y <- data_frame( | |||||
| id = (1:4)[-3], | |||||
| y = paste0("y", (1:4)[-3]) | |||||
| ) | |||||
| x <- data_frame(id = 1:3, x = paste0("x", 1:3)) | |||||
| y <- data_frame(id = (1:4)[-3], y = paste0("y", (1:4)[-3])) | |||||
| # Animate the first or last state of the join | # Animate the first or last state of the join | ||||
| animate_full_join(x, y, by = "id", export = "first") | animate_full_join(x, y, by = "id", export = "first") | ||||
| # animate the transition as a gif (default) | # animate the transition as a gif (default) | ||||
| \donttest{ | \donttest{ | ||||
| animate_full_join(x, y, by = "id", export = "gif") | |||||
| animate_full_join(x, y, by = "id", export = "gif") | |||||
| } | } | ||||
| # different options include | # different options include | ||||
| \donttest{ | \donttest{ | ||||
| animate_full_join(x, y, by = "id") | |||||
| animate_inner_join(x, y, by = "id") | |||||
| animate_left_join(x, y, by = "id") | |||||
| animate_right_join(x, y, by = "id") | |||||
| animate_semi_join(x, y, by = "id") | |||||
| animate_anti_join(x, y, by = "id") | |||||
| # further arguments can be passed to all animate_* functions | |||||
| animate_full_join( | |||||
| x, y, by = "id", export = "last", | |||||
| text_size = 5, title_size = 25, | |||||
| color_header = "black", | |||||
| color_other = "lightblue", | |||||
| color_fun = viridis::viridis | |||||
| ) | |||||
| animate_full_join(x, y, by = "id") | |||||
| animate_inner_join(x, y, by = "id") | |||||
| animate_left_join(x, y, by = "id") | |||||
| animate_right_join(x, y, by = "id") | |||||
| animate_semi_join(x, y, by = "id") | |||||
| animate_anti_join(x, y, by = "id") | |||||
| # further arguments can be passed to all animate_* functions | |||||
| animate_full_join( | |||||
| x, y, by = "id", export = "last", | |||||
| text_size = 5, title_size = 25, | |||||
| color_header = "black", | |||||
| color_other = "lightblue", | |||||
| color_fun = viridis::viridis | |||||
| ) | |||||
| } | } | ||||
| # Save the results | # Save the results | ||||
| \donttest{ | \donttest{ | ||||
| # to save the ggplot, use | |||||
| fj <- animate_full_join(x, y, by = "id", export = "last") | |||||
| ggsave("full-join.pdf", fj) | |||||
| # to save the ggplot, use | |||||
| fj <- animate_full_join(x, y, by = "id", export = "last") | |||||
| ggsave("full-join.pdf", fj) | |||||
| # to save the gif, use | |||||
| fj <- animate_full_join(x, y, by = "id", export = "gif") | |||||
| anim_save(fj, "full-join.gif") | |||||
| # to save the gif, use | |||||
| fj <- animate_full_join(x, y, by = "id", export = "gif") | |||||
| anim_save(fj, "full-join.gif") | |||||
| } | } | ||||
| } | } | ||||
| \seealso{ | \seealso{ |
| % Generated by roxygen2: do not edit by hand | |||||
| % Please edit documentation in R/animate_helpers.R | |||||
| \name{animate_join_function} | |||||
| \alias{animate_join_function} | |||||
| \alias{animate_join} | |||||
| \title{Animates a join - wrapper function} | |||||
| \usage{ | |||||
| animate_join(x, y, by, type, export = "gif", ...) | |||||
| } | |||||
| \arguments{ | |||||
| \item{x}{left dataset} | |||||
| \item{y}{right dataset} | |||||
| \item{by}{by arguments for the join} | |||||
| \item{type}{type of the join, i.e., left_join, right_join, 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 join - wrapper function | |||||
| } | |||||
| \examples{ | |||||
| NULL | |||||
| } |
| % Please edit documentation in R/plot_helpers.R | % Please edit documentation in R/plot_helpers.R | ||||
| \name{animate_plot} | \name{animate_plot} | ||||
| \alias{animate_plot} | \alias{animate_plot} | ||||
| \title{Animates a plot} | |||||
| \title{Animate a Plot} | |||||
| \usage{ | \usage{ | ||||
| animate_plot(d, title = "", transition_length = 2, state_length = 1, | |||||
| ...) | |||||
| animate_plot(d, title = "", ..., anim_opts = anim_options(...)) | |||||
| } | } | ||||
| \arguments{ | \arguments{ | ||||
| \item{d}{a preprocessed dataset} | |||||
| \item{d}{a processed dataset} | |||||
| \item{title}{the plot title} | |||||
| \item{title}{the title of the plot} | |||||
| \item{transition_length}{see transition_states} | |||||
| \item{state_length}{see transition_states} | |||||
| \item{...}{further arguments passed to static_plot} | |||||
| \item{anim_opts}{Animation options generated with \code{\link[=anim_options]{anim_options()}}. Overrides | |||||
| any options set in \code{...}.} | |||||
| } | } | ||||
| \value{ | \value{ | ||||
| a gif | |||||
| a \code{gganim} object | |||||
| } | } | ||||
| \description{ | \description{ | ||||
| Animates a plot | |||||
| Animate a Plot | |||||
| } | } | ||||
| \examples{ | \examples{ | ||||
| NULL | NULL |
| \alias{animate_setdiff} | \alias{animate_setdiff} | ||||
| \title{Animates a set operation} | \title{Animates a set operation} | ||||
| \usage{ | \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(x, y, export = "gif", ...) | ||||
| animate_union_all(x, y, export = "gif", ...) | animate_union_all(x, y, export = "gif", ...) | ||||
| \item{y}{the y dataset} | \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 | \item{export}{the export type, either gif, first or last. The latter two | ||||
| export ggplots of the first/last state of the join} | export ggplots of the first/last state of the join} | ||||
| dynamic as a gif. | dynamic as a gif. | ||||
| } | } | ||||
| \examples{ | \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 the first or last state of the set | ||||
| animate_union(x, y, export = "first") | animate_union(x, y, export = "first") | ||||
| # animate the transition as a gif (default) | # animate the transition as a gif (default) | ||||
| \donttest{ | \donttest{ | ||||
| animate_union(x, y, export = "gif") | |||||
| animate_union(x, y, export = "gif") | |||||
| } | } | ||||
| # different options include | # different options include | ||||
| \donttest{ | \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 | # Save the results | ||||
| \dontrun{ | \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{ | \seealso{ |
| % 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 | |||||
| } |
| \alias{animate_spread} | \alias{animate_spread} | ||||
| \title{Animates the spread function} | \title{Animates the spread function} | ||||
| \usage{ | \usage{ | ||||
| animate_spread(l, key, value, export = "gif", detailed = TRUE, ...) | |||||
| animate_spread(l, key, value, export = "gif", detailed = TRUE, ..., | |||||
| anim_opts = anim_options()) | |||||
| } | } | ||||
| \arguments{ | \arguments{ | ||||
| \item{l}{a data_frame in the long/tidy format} | \item{l}{a data_frame in the long/tidy format} | ||||
| \item{key}{the key} | \item{key}{the key} | ||||
| \item{value}{the values} | |||||
| \item{value}{the value} | |||||
| \item{export}{the export type, either gif, first or last. The latter two | \item{export}{the export type, either gif, first or last. The latter two | ||||
| export ggplots of the first/last state of the spread function} | |||||
| export ggplots of the first/last state of the join} | |||||
| \item{detailed}{boolean value if the animation should show one step for each | \item{detailed}{boolean value if the animation should show one step for each | ||||
| key value} | key value} | ||||
| \item{...}{further arguments passed to static_plot} | |||||
| \item{...}{further arguments passed to \link{process_long} or \link{process_wide}} | |||||
| \item{anim_opts}{An \code{\link[=anim_options]{anim_options()}} options list.} | |||||
| } | } | ||||
| \value{ | \value{ | ||||
| a ggplot or a gif | a ggplot or a gif |
| \alias{gather_spread} | \alias{gather_spread} | ||||
| \title{Animates a gather or spread function} | \title{Animates a gather or spread function} | ||||
| \usage{ | \usage{ | ||||
| gather_spread(lhs, rhs, sequence, key_values, export, detailed, ...) | |||||
| gather_spread(lhs, rhs, sequence, key_values, export, detailed, ..., | |||||
| anim_opts = anim_options()) | |||||
| } | } | ||||
| \arguments{ | \arguments{ | ||||
| \item{lhs}{the (processed) dataset on the left-side} | \item{lhs}{the (processed) dataset on the left-side} |
| % Generated by roxygen2: do not edit by hand | |||||
| % Please edit documentation in R/animate_options.R | |||||
| \name{set_font_size} | |||||
| \alias{set_font_size} | |||||
| \alias{get_font_size} | |||||
| \title{Set Default Text Sizes for Animation Plots} | |||||
| \usage{ | |||||
| set_font_size(text_size = NULL, title_size = NULL) | |||||
| get_font_size() | |||||
| } | |||||
| \arguments{ | |||||
| \item{text_size}{Font size of value labels inside the data frame squares} | |||||
| \item{title_size}{Font size of the function call or plot title} | |||||
| } | |||||
| \description{ | |||||
| Sets the default text sizes for the animated and static plots produced by | |||||
| this package during the current session. | |||||
| } | |||||
| \section{Functions}{ | |||||
| \itemize{ | |||||
| \item \code{get_font_size}: Get current global font sizes | |||||
| }} | |||||
| \alias{static_plot} | \alias{static_plot} | ||||
| \title{Prints the tiles for a processed dataset statically} | \title{Prints the tiles for a processed dataset statically} | ||||
| \usage{ | \usage{ | ||||
| static_plot(d, title = "", text_family = "Fira Sans", | |||||
| title_family = "Fira Mono", text_size = 5, title_size = 17, ...) | |||||
| static_plot(d, title = "", ..., anim_opts = anim_options(...)) | |||||
| } | } | ||||
| \arguments{ | \arguments{ | ||||
| \item{d}{a processed dataset} | \item{d}{a processed dataset} | ||||
| \item{title}{the title of the plot} | \item{title}{the title of the plot} | ||||
| \item{text_family}{the font for the text} | |||||
| \item{...}{Arguments passed on to \code{anim_options} | |||||
| \describe{ | |||||
| \item{text_family}{Font family for the plot text, default is "Fira Mono". Use | |||||
| \code{\link[=set_font_size]{set_font_size()}} to set global default font sizes.} | |||||
| \item{title_family}{Font family for the plot title, default is "Fira Mono". | |||||
| Use \code{\link[=set_font_size]{set_font_size()}} to set global default font sizes.} | |||||
| \item{text_size}{Font size of the plot text, default is 5.} | |||||
| \item{title_size}{Font size of the plot title, default is 17.} | |||||
| \item{ease_default}{Default aes easing function. See \code{\link[tweenr:display_ease]{tweenr::display_ease()}} | |||||
| for more options. The tidyexplain default value is \code{sine-in-out}.} | |||||
| \item{ease_other}{Additional aes easing options, specified as a named list. | |||||
| List entries are named with the aesthetic to which the easeing should be | |||||
| applied, consistent with \code{\link[gganimate:ease_aes]{gganimate::ease_aes()}}. E.g. \code{list(color = "sine")}.} | |||||
| \item{enter}{Enter fading function applied to objects in the animation. See | |||||
| \link[gganimate:enter_exit]{gganimate::enter_exit} for a complete list of options. The tidyexplain | |||||
| default is \code{\link[gganimate:enter_fade]{gganimate::enter_fade()}}.} | |||||
| \item{exit}{Exit fading function applied to objects in the animation. See | |||||
| \link[gganimate:enter_exit]{gganimate::enter_exit} for a complete list of options. The tidyexplain | |||||
| default is \code{\link[gganimate:exit_fade]{gganimate::exit_fade()}}.} | |||||
| \item{transition_length}{The relative length of the transition. Will be | |||||
| recycled to match the number of states in the data} | |||||
| \item{state_length}{The relative length of the pause at the states. Will be | |||||
| recycled to match the number of states in the data} | |||||
| }} | |||||
| \item{title_family}{the font for the title} | |||||
| \item{text_size}{the size of the text} | |||||
| \item{title_size}{the size of the title} | |||||
| \item{...}{further arguments} | |||||
| \item{anim_opts}{Animation options generated with \code{\link[=anim_options]{anim_options()}}. Overrides | |||||
| any options set in \code{...}.} | |||||
| } | } | ||||
| \value{ | \value{ | ||||
| a ggplot | a ggplot |
| % Generated by roxygen2: do not edit by hand | % Generated by roxygen2: do not edit by hand | ||||
| % Please edit documentation in R/zzzz-package.R | % Please edit documentation in R/zzzz-package.R | ||||
| \docType{package} | \docType{package} | ||||
| \name{tidyverbs-package} | |||||
| \alias{tidyverbs} | |||||
| \alias{tidyverbs-package} | |||||
| \title{tidyverbs: Animate the Verbs of the Tidyverse} | |||||
| \name{tidyexplain-package} | |||||
| \alias{tidyexplain} | |||||
| \alias{tidyexplain-package} | |||||
| \title{tidyexplain: Animated Explanations of Tidyverse Verbs} | |||||
| \description{ | \description{ | ||||
| Animate the verbs of the tidyverse. | |||||
| Animated explanations of the verbs in the tidyverse | |||||
| using gganimate and ggplot2. | |||||
| } | } | ||||
| \author{ | \author{ | ||||
| \strong{Maintainer}: Garrick Aden-Buie \email{g.adenbuie@gmail.com} | \strong{Maintainer}: Garrick Aden-Buie \email{g.adenbuie@gmail.com} |
| library(testthat) | |||||
| library(tidyverbs) | |||||
| test_check("tidyverbs") |
| context("test-anim_options") | |||||
| test_that("merging of animation options works", { | |||||
| ao_new <- anim_options(5, 3, text_size = 9, title_size = 13) | |||||
| ao_old <- anim_options(ease_default = "cubic-in", text_family = "Times New Roman") | |||||
| ao_merged <- anim_options(5, 3, "cubic-in", text_size = 9, title_size = 13, text_family = "Times New Roman") | |||||
| expect_equal(merge(ao_new, ao_old), ao_merged) | |||||
| }) | |||||
| test_that("setting and getting animation options works", { | |||||
| set_font_size(5, 10) | |||||
| expect_equal(get_anim_opt(), anim_options(text_size = 5, title_size = 10)) | |||||
| expect_error(get_anim_opt("text_size")) | |||||
| expect_equal(get_text_size(), get_anim_opt()$text_size) | |||||
| expect_equal(get_title_size(), get_anim_opt()$title_size) | |||||
| anim_options_set(anim_options(2, 1)) | |||||
| expect_equal(get_anim_opt("transition_length"), 2) | |||||
| expect_equal(get_anim_opt("state_length"), 1) | |||||
| expect_equal(get_anim_opt(), anim_options(2, 1, text_size = 5, title_size = 10)) | |||||
| anim_options_set() | |||||
| expect_equal(get_anim_opt("transition_length"), plot_settings$default$transition_length) | |||||
| anim_options_set(anim_options(enter = enter_appear(early = TRUE))) | |||||
| expect_equal(names(get_anim_opt("enter")), "enter_appear(early = TRUE)") | |||||
| expect_s3_class(get_anim_opt("enter")[[1]], "ggproto") | |||||
| anim_options_set() | |||||
| }) | |||||
| test_that("precedence: function > user-set global > default (> global default)", { | |||||
| ao_function <- anim_options(ease_default = "linear") | |||||
| ao_global <- anim_options(ease_default = "cubic", text_family = "Arial") | |||||
| expect_equal(default_anim_opts("gather", ao_function)$ease_default, "linear") | |||||
| anim_options_set(ao_global) | |||||
| expect_equal(default_anim_opts("gather")$ease_default, "cubic") | |||||
| expect_equal(default_anim_opts("gather", ao_function)$ease_default, "linear") | |||||
| ao_default <- default_anim_opts("gather", ao_function) # inside animate_ function | |||||
| ao_final <- validate_anim_opts(ao_default) # just before animate_plot() or static_plot() | |||||
| expect_equal(ao_final$ease_default, "linear") | |||||
| expect_equal(ao_final$text_family, "Arial") | |||||
| expect_equivalent(names(ao_final$ease_other), c("y", "x")) | |||||
| expect_equal(ao_final$title_family, plot_settings$default$title_family) | |||||
| anim_options_set() | |||||
| }) |
| context("test-set_text_color") | |||||
| test_that("correct color selection", { | |||||
| colors <- c("#FFFFFF", scales::brewer_pal("seq", "Set1")(4), "#000000") | |||||
| expect_equal(choose_text_color(colors), c("#000000", rep("#FFFFFF", 5))) | |||||
| }) |
| context("test-tidyr_helpers") | |||||
| test_that("get_quos_names works", { | |||||
| expect_equivalent(get_quos_names(-x), "-x") | |||||
| expect_equivalent(get_quos_names(x:y), "x:y") | |||||
| expect_equivalent(get_quos_names(-x, -y, -z), c("-x", "-y", "-z")) | |||||
| }) | |||||
| test_that("dput_parsers works", { | |||||
| expect_equal(dput_parser("x"), '"x"') | |||||
| expect_equal(dput_parser(c("x", "y")), 'c("x", "y")') | |||||
| }) |