diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..2eb964e --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,3 @@ +^LICENSE\.md$ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..771dc28 --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,41 @@ +Type: Package +Package: tidyexplain +Title: Animated Explanations of Tidyverse Verbs +Version: 0.0.1.9000 +Date: 2018-08-27 +Authors@R: + c(person(given = "Garrick", + family = "Aden-Buie", + role = c("aut", "cre"), + email = "g.adenbuie@gmail.com"), + person(given = "David", + family = "Zimmermann", + role = "aut", + email = "david_j_zimmermann@hotmail.com"), + person(given = "Tyler Grant", + family = "Smith", + role = "ctb")) +Description: Animated explanations of the verbs in the tidyverse + using gganimate and ggplot2. +License: MIT + file LICENSE +Depends: + gganimate (>= 0.9.9.9999), + ggplot2 (>= 3.0.0) +Imports: + dplyr, + magrittr, + purrr, + rlang (>= 0.1.2), + scales, + tidyr, + tidyselect +Suggests: + knitr, + roxygen2, + testthat, + viridis +VignetteBuilder: + knitr +Encoding: UTF-8 +Roxygen: list(markdown = TRUE) +RoxygenNote: 6.1.1 diff --git a/LICENSE b/LICENSE index 670154e..c46b197 100644 --- a/LICENSE +++ b/LICENSE @@ -1,116 +1,2 @@ -CC0 1.0 Universal - -Statement of Purpose - -The laws of most jurisdictions throughout the world automatically confer -exclusive Copyright and Related Rights (defined below) upon the creator and -subsequent owner(s) (each and all, an "owner") of an original work of -authorship and/or a database (each, a "Work"). - -Certain owners wish to permanently relinquish those rights to a Work for the -purpose of contributing to a commons of creative, cultural and scientific -works ("Commons") that the public can reliably and without fear of later -claims of infringement build upon, modify, incorporate in other works, reuse -and redistribute as freely as possible in any form whatsoever and for any -purposes, including without limitation commercial purposes. These owners may -contribute to the Commons to promote the ideal of a free culture and the -further production of creative, cultural and scientific works, or to gain -reputation or greater distribution for their Work in part through the use and -efforts of others. - -For these and/or other purposes and motivations, and without any expectation -of additional consideration or compensation, the person associating CC0 with a -Work (the "Affirmer"), to the extent that he or she is an owner of Copyright -and Related Rights in the Work, voluntarily elects to apply CC0 to the Work -and publicly distribute the Work under its terms, with knowledge of his or her -Copyright and Related Rights in the Work and the meaning and intended legal -effect of CC0 on those rights. - -1. Copyright and Related Rights. A Work made available under CC0 may be -protected by copyright and related or neighboring rights ("Copyright and -Related Rights"). Copyright and Related Rights include, but are not limited -to, the following: - - i. the right to reproduce, adapt, distribute, perform, display, communicate, - and translate a Work; - - ii. moral rights retained by the original author(s) and/or performer(s); - - iii. publicity and privacy rights pertaining to a person's image or likeness - depicted in a Work; - - iv. rights protecting against unfair competition in regards to a Work, - subject to the limitations in paragraph 4(a), below; - - v. rights protecting the extraction, dissemination, use and reuse of data in - a Work; - - vi. database rights (such as those arising under Directive 96/9/EC of the - European Parliament and of the Council of 11 March 1996 on the legal - protection of databases, and under any national implementation thereof, - including any amended or successor version of such directive); and - - vii. other similar, equivalent or corresponding rights throughout the world - based on applicable law or treaty, and any national implementations thereof. - -2. Waiver. To the greatest extent permitted by, but not in contravention of, -applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and -unconditionally waives, abandons, and surrenders all of Affirmer's Copyright -and Related Rights and associated claims and causes of action, whether now -known or unknown (including existing as well as future claims and causes of -action), in the Work (i) in all territories worldwide, (ii) for the maximum -duration provided by applicable law or treaty (including future time -extensions), (iii) in any current or future medium and for any number of -copies, and (iv) for any purpose whatsoever, including without limitation -commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes -the Waiver for the benefit of each member of the public at large and to the -detriment of Affirmer's heirs and successors, fully intending that such Waiver -shall not be subject to revocation, rescission, cancellation, termination, or -any other legal or equitable action to disrupt the quiet enjoyment of the Work -by the public as contemplated by Affirmer's express Statement of Purpose. - -3. Public License Fallback. Should any part of the Waiver for any reason be -judged legally invalid or ineffective under applicable law, then the Waiver -shall be preserved to the maximum extent permitted taking into account -Affirmer's express Statement of Purpose. In addition, to the extent the Waiver -is so judged Affirmer hereby grants to each affected person a royalty-free, -non transferable, non sublicensable, non exclusive, irrevocable and -unconditional license to exercise Affirmer's Copyright and Related Rights in -the Work (i) in all territories worldwide, (ii) for the maximum duration -provided by applicable law or treaty (including future time extensions), (iii) -in any current or future medium and for any number of copies, and (iv) for any -purpose whatsoever, including without limitation commercial, advertising or -promotional purposes (the "License"). The License shall be deemed effective as -of the date CC0 was applied by Affirmer to the Work. Should any part of the -License for any reason be judged legally invalid or ineffective under -applicable law, such partial invalidity or ineffectiveness shall not -invalidate the remainder of the License, and in such case Affirmer hereby -affirms that he or she will not (i) exercise any of his or her remaining -Copyright and Related Rights in the Work or (ii) assert any associated claims -and causes of action with respect to the Work, in either case contrary to -Affirmer's express Statement of Purpose. - -4. Limitations and Disclaimers. - - a. No trademark or patent rights held by Affirmer are waived, abandoned, - surrendered, licensed or otherwise affected by this document. - - b. Affirmer offers the Work as-is and makes no representations or warranties - of any kind concerning the Work, express, implied, statutory or otherwise, - including without limitation warranties of title, merchantability, fitness - for a particular purpose, non infringement, or the absence of latent or - other defects, accuracy, or the present or absence of errors, whether or not - discoverable, all to the greatest extent permissible under applicable law. - - c. Affirmer disclaims responsibility for clearing rights of other persons - that may apply to the Work or any use thereof, including without limitation - any person's Copyright and Related Rights in the Work. Further, Affirmer - disclaims responsibility for obtaining any necessary consents, permissions - or other rights required for any use of the Work. - - d. Affirmer understands and acknowledges that Creative Commons is not a - party to this document and has no duty or obligation with respect to this - CC0 or use of the Work. - -For more information, please see - +YEAR: 2018 +COPYRIGHT HOLDER: Garrick Aden-Buie diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000..7823bb8 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,21 @@ +# MIT License + +Copyright (c) 2018 Garrick Aden-Buie + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..d7e22ec --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,41 @@ +# Generated by roxygen2: do not edit by hand + +S3method(print,anim_opts) +export("%>%") +export(anim_options) +export(animate_anti_join) +export(animate_full_join) +export(animate_gather) +export(animate_inner_join) +export(animate_intersect) +export(animate_left_join) +export(animate_right_join) +export(animate_semi_join) +export(animate_setdiff) +export(animate_spread) +export(animate_union) +export(animate_union_all) +export(get_font_size) +export(is.anim_opts) +export(set_anim_options) +export(set_font_size) +importFrom(dplyr,anti_join) +importFrom(dplyr,arrange) +importFrom(dplyr,bind_cols) +importFrom(dplyr,bind_rows) +importFrom(dplyr,data_frame) +importFrom(dplyr,filter) +importFrom(dplyr,full_join) +importFrom(dplyr,group_by) +importFrom(dplyr,inner_join) +importFrom(dplyr,left_join) +importFrom(dplyr,mutate) +importFrom(dplyr,pull) +importFrom(dplyr,right_join) +importFrom(dplyr,row_number) +importFrom(dplyr,select) +importFrom(dplyr,semi_join) +importFrom(dplyr,slice) +importFrom(magrittr,"%>%") +importFrom(tidyr,gather) +importFrom(tidyr,spread) diff --git a/R/00_base_join.R b/R/00_base_join.R deleted file mode 100644 index cf77814..0000000 --- a/R/00_base_join.R +++ /dev/null @@ -1,37 +0,0 @@ -# Animated dplyr joins with gganimate -# * Garrick Aden-Buie -# * garrickadenbuie.com -# * MIT License: https://opensource.org/licenses/MIT - -library(tidyverse) -library(gganimate) - -if (!getOption("tidy_verb_anim.font_registered", FALSE)) { - source(here::here("R", "01_register-fonts.R")) -} - -if (!getOption("tidy_verb_anim.functions_loaded", FALSE)) { - source(here::here("R", "02_functions.R")) -} - -source(here::here("R", "03_check-folders.R")) - -plot_data_join <- function(x, title = "", xlims = xlim(0.5, 5.5), ylims = ylim(-3.5, -0.5)) { - plot_data(x, title) + - xlims + ylims -} - -# Data ---- -x <- data_frame( - id = 1:3, - x = paste0("x", 1:3) -) - -y <- data_frame( - id = (1:4)[-3], - y = paste0("y", (1:4)[-3]) -) - -initial_join_dfs <- proc_data(x, "x") %>% - bind_rows(mutate(proc_data(y, "y"), .x = .x + 3)) %>% - mutate(frame = 1) diff --git a/R/00_base_set.R b/R/00_base_set.R deleted file mode 100644 index bf4c68e..0000000 --- a/R/00_base_set.R +++ /dev/null @@ -1,50 +0,0 @@ -# Animated dplyr set opertaions with gganimate -# * Contributed by Tyler Grant Smith -# * and Garrick Aden-Buie -# * MIT License: https://opensource.org/licenses/MIT - -library(tidyverse) -library(gganimate) - -if (!getOption("tidy_verb_anim.font_registered", FALSE)) { - source(here::here("R", "01_register-fonts.R")) -} - -if (!getOption("tidy_verb_anim.functions_loaded", FALSE)) { - source(here::here("R", "02_functions.R")) -} - -source(here::here("R", "03_check-folders.R")) - -# Initialize data processing function ---- - -proc_data_set <- function(x, .id = "x") { - proc_data(x, .id, colorize_row_id, "before") -} - -plot_data_set <- function(x, title = "", xlims = xlim(1.5, 6.5), ylims = ylim(-3.5, -0.5)) { - filter(x, label != "id") %>% - plot_data(title) + - xlims + ylims -} - -# Data ---- - -x <- tibble::tribble( - ~id, ~x, ~y, - 1, "1", "a", - 2, "1", "b", - 3, "2", "a" -) - -y <- tibble::tribble( - ~id, ~x, ~y, - 1, "1", "a", - 4, "2", "b" -) - -initial_set_dfs <- bind_rows( - proc_data_set(x, "x"), - proc_data_set(y, "y") %>% mutate(.x = .x + 3) -) %>% - mutate(frame = 1) diff --git a/R/00_base_tidyr.R b/R/00_base_tidyr.R deleted file mode 100644 index c966637..0000000 --- a/R/00_base_tidyr.R +++ /dev/null @@ -1,28 +0,0 @@ -# Animated dplyr joins with gganimate -# * Garrick Aden-Buie -# * garrickadenbuie.com -# * MIT License: https://opensource.org/licenses/MIT - -library(tidyverse) -library(gganimate) - -if (!getOption("tidy_verb_anim.font_registered", FALSE)) { - source(here::here("R", "01_register-fonts.R")) -} - -if (!getOption("tidy_verb_anim.functions_loaded", FALSE)) { - source(here::here("R", "02_functions.R")) -} - -source(here::here("R", "03_check-folders.R")) - -# Data ---- -set.seed(42) -wide <- data_frame( - id = rep(1:2), - x = letters[1:2], - y = letters[3:4], - z = letters[5:6] -) - -long <- tidyr::gather(wide, key, val, x:z) diff --git a/R/01_register-fonts.R b/R/01_register-fonts.R deleted file mode 100644 index f6643e9..0000000 --- a/R/01_register-fonts.R +++ /dev/null @@ -1,7 +0,0 @@ -# Note: I used Fira Sans and Mono (downloaded here from Google Fonts). -# Feel free to change font names below for desired fonts. - -sysfonts::font_add_google("Fira Sans") -sysfonts::font_add_google("Fira Mono") -showtext::showtext_auto() -options(tidy_verb_anim.font_registered = TRUE) diff --git a/R/02_functions.R b/R/02_functions.R deleted file mode 100644 index eb92684..0000000 --- a/R/02_functions.R +++ /dev/null @@ -1,112 +0,0 @@ -proc_data <- function(x, .id = "x", color_fun = colorize_keys, color_when = c("after", "before"), ...) { - color_when <- match.arg(color_when) - n_colors <- max(x$id) - - if (color_when == "before") x <- color_fun(x, n_colors, ...) - - x <- x %>% - mutate(.y = -row_number()) %>% - tidyr::gather("label", "value", setdiff(colnames(x), c(".y", "color"))) %>% - mutate(value = as.character(value)) %>% - group_by(.y) %>% - mutate( - .x = 1:n(), - .id = .id, - .width = 1 - ) %>% - ungroup(.y) - - if (color_when == "after") x <- color_fun(x, n_colors, ...) - x -} - -colorize_keys <- function(df, n_colors, key_col = "id", color_other = "#d0d0d0", color_missing = "#ffffff") { - # Assumes that key_col is integer - colors <- scales::brewer_pal(type = "qual", "Set1")(n_colors) - mutate( - df, - color = ifelse(label == key_col, value, n_colors + 1), - color = colors[as.integer(color)], - color = ifelse(is.na(color), "#d0d0d0", color), - color = ifelse(is.na(value), "#ffffff", color) - ) -} - -colorize_row_id <- function(df, n_colors, key_col = "id") { - # Assumes that key_col is integer - colors <- scales::brewer_pal(type = "qual", "Set1")(n_colors) - df$color <- colors[df[[key_col]]] - df -} - -colorize_wide_tidyr <- function(df, n_colors, key_col = "id") { - n_colors <- n_colors + length(setdiff(unique(df$label), key_col)) - colors <- scales::brewer_pal(type = "qual", "Set1")(n_colors) - - df$value_int <- as.integer(gsub("[a-zA-Z]", "0", df$value)) - max_id_color <- max(df$value_int) - - df %>% - bind_rows( - filter(df, .y == "-1") %>% mutate(.y = 0) - ) %>% - mutate( - idcp = max_id_color - 1L, - idc = case_when( - label == "id" ~ value_int, - TRUE ~ map_int(label, ~which(. == unique(label))) + idcp - ) - ) %>% - select(-idcp, -value_int) %>% - mutate( - idc = ifelse(.y == 0 & label == "id", 100, idc), - value = ifelse(.y == 0, label, value), - .id = ifelse(.y == 0, "n", .id), - color = colors[idc], - ) %>% - filter(!is.na(color)) %>% - mutate(alpha = ifelse(label != "id" & .y < 0, 0.6, 1.0)) %>% - select(-idc) -} - -plot_data <- function(x, title = "") { - if (!"alpha" %in% colnames(x)) x$alpha <- 1 - if (!".text_color" %in% colnames(x)) x$`.text_color` <- "white" - if (!".text_size" %in% colnames(x)) x$`.text_size` <- 12 - ggplot(x) + - aes(.x, .y, fill = color, label = value) + - geom_tile(aes(alpha = alpha), width = 0.9, height = 0.9) + - geom_text(aes(x = .x, color = .text_color, size = .text_size), hjust = 0.5, family = "Fira Sans") + - scale_fill_identity() + - scale_alpha_identity() + - scale_color_identity() + - scale_size_identity() + - coord_equal() + - ggtitle(title) + - theme_void() + - theme(plot.title = element_text(family = "Fira Mono", hjust = 0.5, size = 24)) + - guides(fill = FALSE) -} - -animate_plot <- function(x, transition_length = 2, state_length = 1) { - x + - transition_states(frame, transition_length, state_length) + - enter_fade() + - exit_fade() + - ease_aes("sine-in-out") -} - -save_static_plot <- function(g, filename, formats = c("png", "svg")) { - filenames <- formats %>% - purrr::set_names() %>% - purrr::map_chr(static_plot_filename, x = filename) %>% - purrr::iwalk( - ~ ggsave(filename = .x, plot = g, dev = .y) - ) -} - -static_plot_filename <- function(x, ext) { - here::here("images", "static", ext, paste0(x, ".", ext)) -} - -options(tidy_verb_anim.functions_loaded = TRUE) diff --git a/R/03_check-folders.R b/R/03_check-folders.R deleted file mode 100644 index f4f3e61..0000000 --- a/R/03_check-folders.R +++ /dev/null @@ -1,5 +0,0 @@ -if (!dir.exists(here::here("images"))) dir.create(here::here("images")) -png_path <- here::here("images", "static", "png") -svg_path <- here::here("images", "static", "svg") -if (!dir.exists(png_path)) dir.create(png_path, recursive = TRUE) -if (!dir.exists(svg_path)) dir.create(svg_path, recursive = TRUE) diff --git a/R/animate_joins.R b/R/animate_joins.R new file mode 100644 index 0000000..4a59019 --- /dev/null +++ b/R/animate_joins.R @@ -0,0 +1,150 @@ +#' Animates a join operation +#' +#' Functions to visualise the join operations either static as a ggplot, or +#' dynamic as a gif. +#' +#' @param x the x dataset +#' @param y the y dataset +#' @param by the by arguments for the join +#' @param export the export type, either gif, first or last. The latter two +#' export ggplots of the first/last state of the join +#' @param ... further arguments passed to anim_options() +#' +#' @return either a gif or a ggplot +#' +#' @seealso \code{\link[dplyr]{join}} +#' +#' @name animate_join +#' @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])) +#' +#' # 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 = "last") +#' +#' # animate the transition as a gif (default) +#' \donttest{ +#' animate_full_join(x, y, by = "id", export = "gif") +#' } +#' +#' # different options include +#' \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, see also ?anim_options +#' 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 +#' \donttest{ +#' # 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") +#' } +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 +#' @export +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, ...) +} + +#' @rdname animate_join +#' @export +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, ...) +} + +#' @rdname animate_join +#' @export +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, ...) +} + +#' @rdname animate_join +#' @export +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, ...) +} + +#' @rdname animate_join +#' @export +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, ...) +} + +#' @rdname animate_join +#' @export +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, ...) +} diff --git a/R/animate_options.R b/R/animate_options.R new file mode 100644 index 0000000..278dab2 --- /dev/null +++ b/R/animate_options.R @@ -0,0 +1,244 @@ +#' Animation Options +#' +#' Helper function to set animation and plotting options to be passed to +#' [animate_plot()] and [static_plot()]. +#' +#' @param color_header Color of the header row. +#' @param color_other Color of the cells that are not highlighted otherwise. +#' @param color_missing Color of the missing cells. +#' @param color_fun A function that generates the colors for the highlighted +#' cells, default is [scales::brewer_pal()] Set1. +#' @param text_color Color of the text of the cells, default is a black or +#' white, based on the background color of the cell. +#' @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 cell_width Width of a cell, default is 1. +#' @param cell_height Height of a cell, default is 1. +#' @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, + color_header = NULL, + color_other = NULL, + color_missing = NULL, + color_fun = NULL, + text_color = NULL, + cell_width = NULL, + cell_height = 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, + color_header = color_header, + color_other = color_other, + color_missing = color_missing, + color_fun = color_fun, + text_color = text_color, + cell_width = cell_width, + cell_height = cell_height, + ... + ) + 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 +set_anim_options <- 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_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$color_header <- ao$color_header %||% get_anim_opt("color_header") + ao$color_other <- ao$color_other %||% get_anim_opt("color_other") + ao$color_missing <- ao$color_missing %||% get_anim_opt("color_missing") + ao$color_fun <- ao$color_fun %||% get_anim_opt("color_fun") + ao$text_color <- ao$text_color %||% get_anim_opt("text_color") + ao$cell_width <- ao$cell_width %||% get_anim_opt("cell_width") + ao$cell_height <- ao$cell_height %||% get_anim_opt("cell_height") + + 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 + set_anim_options(anim_options(text_size = size)) + invisible(old) +} + +set_title_size <- function(size) { + old <- plot_settings$title_size + set_anim_options(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_void", "ggplot2")()$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_void", "ggplot2")()$plot.title$size %||% + plot_settings$default$title_size +} diff --git a/R/animate_sets.R b/R/animate_sets.R new file mode 100644 index 0000000..b4ad166 --- /dev/null +++ b/R/animate_sets.R @@ -0,0 +1,133 @@ +#' Animates a set operation +#' +#' Functions to visualise the set operations either static as a ggplot, or +#' dynamic as a gif. +#' +#' @param x the x dataset +#' @param y the y dataset +#' @param export the export type, either gif, first or last. The latter two +#' export ggplots of the first/last state of the join +#' @param type type of the set, i.e., intersect, setdiff, etc. +#' @param ... further argument passed to anim_options() +#' +#' @return either a gif or a ggplot +#' +#' @seealso \code{\link[dplyr]{setops}} +#' +#' @examples +#' x <- data_frame(x = c(1, 1, 2), y = c("a", "b", "a")) +#' y <- data_frame(x = c(1, 2), y = c("a", "b")) +#' +#' # Animate the first or last state of the set +#' animate_union(x, y, export = "first") +#' animate_union(x, y, export = "last") +#' +#' # animate the transition as a gif (default) +#' \donttest{ +#' animate_union(x, y, export = "gif") +#' } +#' +#' # different options include +#' \donttest{ +#' animate_union(x, y) +#' animate_union_all(x, y) +#' animate_intersect(x, y) +#' animate_setdiff(x, y) +#' +#' # further arguments can be passed to all animate_* functions +#' animate_union( +#' x, y, +#' text_size = 5, title_size = 25, +#' color_header = "black", +#' color_fun = viridis::viridis +#' ) +#' } +#' +#' # Save the results +#' \dontrun{ +#' # to save the ggplot, use +#' un <- animate_union(x, y, by = "id", export = "last") +#' ggsave("union.pdf", un) +#' +#' animate_union(x, y, by = "id", export = "gif") +#' # to save the gif, use +#' un <- animate_union(x, y, by = "id", export = "gif") +#' anim_save(un, "union.gif") +#' } +animate_set <- function( + x, y, + type = c("union", "union_all", "intersect", "setdiff"), + export = c("gif", "first", "last"), + ... +) { + type <- match.arg(type) + export <- match.arg(export) + x_name <- get_input_text(x) + y_name <- get_input_text(y) + data <- make_named_data(x, y) + + col_names <- purrr::map(data, names) + + if (!all(names(data$x) %in% names(data$y)) && ncol(data$x) == ncol(data$y)) + stop("x and y must have the same variables/column-names") + + title <- sprintf(paste0(type, "(%s, %s)"), x_name, y_name) + + if (type %in% c("union", "intersect", "setdiff")) { + data <- purrr::map(data, dplyr::distinct) + } + + if (type == "union_all") { + ll <- process_join(data$x, data$y, by = names(data$x), fill = FALSE, ...) + ll <- purrr::map(ll, ~ mutate(., .id_long = paste(.id_long, .side, sep = "-"))) + } else { + ll <- process_join(data$x, data$y, by = names(data$x), ...) + } + + step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1) + + step1 <- move_together(ll$x, ll$y, type) %>% mutate(.frame = 1) + + all <- bind_rows(step0, step1) + + if (export == "gif") { + animate_plot(all, title, ...) + } else if (export == "first") { + title <- "" + static_plot(step0, title, ...) + } else if (export == "last") { + static_plot(step1, title, ...) + } +} + +#' @rdname animate_set +#' @export +animate_union <- function(x, y, export = "gif", ...) { + x <- rlang::enquo(x) + y <- rlang::enquo(y) + animate_set(x, y, type = "union", export = export, ...) +} + +#' @rdname animate_set +#' @export +animate_union_all <- function(x, y, export = "gif", ...) { + x <- rlang::enquo(x) + y <- rlang::enquo(y) + animate_set(x, y, type = "union_all", export = export, ...) +} + +#' @rdname animate_set +#' @export +animate_intersect <- function(x, y, export = "gif", ...) { + x <- rlang::enquo(x) + y <- rlang::enquo(y) + animate_set(x, y, type = "intersect", export = export, ...) +} + +#' @rdname animate_set +#' @export +animate_setdiff <- function(x, y, export = "gif", ...) { + x <- rlang::enquo(x) + y <- rlang::enquo(y) + animate_set(x, y, type = "setdiff", export = export, ...) +} diff --git a/R/animate_tidyr.R b/R/animate_tidyr.R new file mode 100644 index 0000000..c9cb3fe --- /dev/null +++ b/R/animate_tidyr.R @@ -0,0 +1,123 @@ +#' Animates the gather function +#' +#' @param w a data_frame in the wide format +#' @param key the key +#' @param value the value +#' @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 +#' key value +#' @inheritParams animate_join +#' @inheritParams anim_options +#' +#' @return a gif or a ggplot +#' @export +#' +#' @examples +#' wide <- data_frame( +#' year = 2010:2011, +#' Alice = c(105, 110), +#' Bob = c(100, 97), +#' Charlie = c(90, 95) +#' ) +#' animate_gather(wide, "person", "sales", -year, export = "first") +#' animate_gather(wide, "person", "sales", -year, export = "last") +#' +#' \donttest{ +#' animate_gather(wide, "person", "sales", -year, export = "gif") +#' # 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 <- function(w, key, value, ..., export = "gif", detailed = TRUE, anim_opts = anim_options()) { + anim_opts <- default_anim_opts("gather", anim_opts) + lhs <- w + rhs <- tidyr::gather(w, !!key, !!value, ...) + + # construct the title sequence + wname <- deparse(substitute(w)) + tidyr_selection <- get_quos_names(...) + ids <- setdiff(colnames(w), tidyselect::vars_select(colnames(w), ...)) + + id_string <- paste0(", ", paste(sprintf("%s", tidyr_selection), collapse = ", ")) + + sequence <- c( + current_state = "wide", + final_state = "long", + operation = sprintf("gather(%s, %s, %s%s)", + wname, + dput_parser(key), + dput_parser(value), + id_string), + reverse_operation = sprintf("spread(%s, %s, %s)", + "long", + dput_parser(key), + dput_parser(value)) + ) + + key_values <- rhs %>% pull(key) %>% unique() + lhs_proc <- process_wide(lhs, ids, key, key_values, value, ...) + rhs_proc <- process_long(rhs, ids, key, value, ...) + + gather_spread(lhs_proc, rhs_proc, sequence = sequence, key_values = key_values, + export = export, detailed = detailed, ..., anim_opts = anim_opts) +} + + +#' Animates the spread function +#' +#' @param l a data_frame in the long/tidy format +#' @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 +#' @export +#' +#' @examples +#' long <- data_frame( +#' year = c(2010L, 2011L, 2010L, 2011L, 2010L, 2011L), +#' person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), +#' sales = c(105, 110, 100, 97, 90, 95) +#' ) +#' animate_spread(long, key = "person", value = "sales", export = "first") +#' animate_spread(long, key = "person", value = "sales", export = "last") +#' +#' \donttest{ +#' animate_spread(long, key = "person", value = "sales", export = "gif") +#' # 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 <- function(l, key, value, export = "gif", detailed = TRUE, ..., anim_opts = anim_options()) { + anim_opts <- default_anim_opts("spread", anim_opts) + + lhs <- l + rhs <- tidyr::spread(l, key = key, value = value) + + # construct the title sequence + lname <- deparse(substitute(l)) + ids <- names(lhs) + ids <- ids[!ids %in% c(key, value)] + + id_string <- paste0(", ", paste(sprintf("-%s", ids), collapse = ", ")) + + sequence <- c( + current_state = "long", + final_state = "wide", + operation = sprintf("spread(%s, %s, %s)", + lname, + dput_parser(key), + dput_parser(value)), + reverse_operation = sprintf("gather(%s, %s, %s%s)", + "wide", + dput_parser(key), + dput_parser(value), + id_string) + ) + + lhs_proc <- process_long(lhs, ids, key, value, ...) + rhs_proc <- process_wide(rhs, ids, key, value, ...) + + key_values <- lhs %>% pull(key) %>% unique() + gather_spread(lhs_proc, rhs_proc, sequence, key_values, export, detailed, ..., anim_opts = anim_opts) +} diff --git a/R/anti_join.R b/R/anti_join.R deleted file mode 100644 index 73d406c..0000000 --- a/R/anti_join.R +++ /dev/null @@ -1,48 +0,0 @@ -source(here::here("R/00_base_join.R")) - -initial_join_dfs <- initial_join_dfs %>% - arrange(.x, .y) %>% - mutate(.obj = row_number(), .obj = .obj + 90 * as.integer(.id == "y")) - -aj_step2 <- initial_join_dfs %>% - filter(.id == "x" | value %in% paste(1:2)) %>% - mutate(frame = 2, - .x = ifelse(.id == "y", 2.5, .x + 1.5), - alpha = case_when( - .x > 3 && .id == "x" ~ 0.5, - .y > -2.5 ~ 0.25, - TRUE ~ 1 - )) - -aj_step3 <- aj_step2 %>% - filter(alpha == 1) %>% - mutate(frame = 3) - -aj_step4 <- aj_step2 %>% - filter(alpha == 1) %>% - mutate(frame = 4, .y = -1) - -aj <- bind_rows( - initial_join_dfs, - aj_step2, - aj_step3, - aj_step4 -) %>% - mutate( - alpha = ifelse(is.na(alpha), 1, alpha), - .obj = ifelse(value == 4, 0, .obj) - ) %>% - arrange(.obj, frame) %>% - plot_data("anti_join(x, y)") %>% - animate_plot(transition_length = c(2, 1, 2), - state_length = c(1, 0, 0, 1)) - -aj <- animate(aj) -anim_save(here::here("images", "anti-join.gif"), aj) - -aj_g <- anti_join(x, y, by = "id") %>% - proc_data() %>% - mutate(.x = .x + 1.5) %>% - plot_data_join("anti_join(x, y)") - -save_static_plot(aj_g, "anti-join") diff --git a/R/full_join.R b/R/full_join.R deleted file mode 100644 index 1e1c122..0000000 --- a/R/full_join.R +++ /dev/null @@ -1,29 +0,0 @@ -source(here::here("R/00_base_join.R")) - -fj_joined_df <- full_join(x, y, "id") %>% - proc_data("x") %>% - mutate(.id = ifelse(value %in% c("4", "y4"), "y", .id)) %>% - mutate(frame = 2, .x = .x + 1) - -fj_extra_blocks <- inner_join(x, y, "id") %>% - select(id) %>% - proc_data("y") %>% - mutate(frame = 2, .x = .x + 1) - -fj <- initial_join_dfs %>% - bind_rows(fj_joined_df, fj_extra_blocks) %>% - plot_data("full_join(x, y)") + - transition_states(frame, transition_length = 2, state_length = 1) + - enter_appear() + - exit_disappear(early = TRUE) + - ease_aes("sine-in-out") - -fj <- animate(fj) -anim_save(here::here("images", "full-join.gif"), fj) - -fj_g <- full_join(x, y, "id") %>% - proc_data() %>% - mutate(.x = .x + 1) %>% - plot_data_join("full_join(x, y)", ylims = ylim(-4.5, -0.5)) - -save_static_plot(fj_g, "full-join") diff --git a/R/inner_join.R b/R/inner_join.R deleted file mode 100644 index ec34174..0000000 --- a/R/inner_join.R +++ /dev/null @@ -1,29 +0,0 @@ -source(here::here("R/00_base_join.R")) - -ij_joined_df <- inner_join(x, y, "id") -ij_joined_df <- bind_rows( - proc_data(ij_joined_df, "x"), - proc_data(ij_joined_df, "y") -) %>% - filter(!(label == "x" & .id == "y") & !(label == "y" & .id == "x")) %>% - mutate(frame = 2, .x = .x + 1) - -ij <- bind_rows( - initial_join_dfs, - ij_joined_df -) %>% - mutate(removed = value %in% c("3", "4", "x3", "y4"), - removed = as.integer(removed)) %>% - arrange(desc(frame), removed, desc(.id)) %>% - plot_data("inner_join(x, y)") %>% - animate_plot() - -ij <- animate(ij) -anim_save(here::here("images", "inner-join.gif"), ij) - -ij_g <- inner_join(x, y, by = "id") %>% - proc_data() %>% - mutate(.x = .x + 1) %>% - plot_data_join("inner_join(x, y)") - -save_static_plot(ij_g, "inner-join") diff --git a/R/intersect.R b/R/intersect.R deleted file mode 100644 index b138770..0000000 --- a/R/intersect.R +++ /dev/null @@ -1,28 +0,0 @@ -source(here::here("R/00_base_set.R")) - -ins_df <- intersect(x,y) -ins_step2 <- - bind_rows( - proc_data_set(ins_df, "x"), - proc_data_set(ins_df, "y") - ) %>% - filter(.y == -1) %>% - mutate(frame = 2, .x = .x + 1.5) - -ins <- - initial_set_dfs %>% - bind_rows(ins_step2) %>% - arrange(desc(frame)) %>% - plot_data_set("intersect(x, y)") %>% - animate_plot() - -ins <- animate(ins) - -anim_save(here::here("images", "intersect.gif"), ins) - -ins_g <- intersect(x, y) %>% - proc_data_set() %>% - mutate(.x = .x + 1.5) %>% - plot_data_set("intersect(x, y)") - -save_static_plot(ins_g, "intersect") diff --git a/R/left_join.R b/R/left_join.R deleted file mode 100644 index fab04b1..0000000 --- a/R/left_join.R +++ /dev/null @@ -1,27 +0,0 @@ -source(here::here("R/00_base_join.R")) - -lj_joined_dfs <- left_join(x, y, "id") %>% - proc_data("x") %>% - mutate(frame = 2, .x = .x + 1) - -lj_extra_blocks <- inner_join(x, y, "id") %>% - select(id) %>% - proc_data("y") %>% - mutate(frame = 2, .x = .x + 1) - -lj <- bind_rows( - initial_join_dfs, - lj_joined_dfs, - lj_extra_blocks -) %>% - mutate(color = ifelse(is.na(value), "#ffffff", color)) %>% - arrange(value) %>% - plot_data("left_join(x, y)") %>% - animate_plot() - -lj <- animate(lj) -anim_save(here::here("images", "left-join.gif"), lj) - -lj_g <- plot_data_join(lj_joined_dfs, "left_join(x, y)") - -save_static_plot(lj_g, "left-join") diff --git a/R/left_join_extra.R b/R/left_join_extra.R deleted file mode 100644 index 7dad0ac..0000000 --- a/R/left_join_extra.R +++ /dev/null @@ -1,71 +0,0 @@ -source(here::here("R/00_base_join.R")) - -y_extra <- bind_rows(y, data_frame(id = 2, y = "y5")) - -# I manually linked objects together, it was late and this was easier... -anim_df <- tibble::tribble( - ~.y, ~label, ~value, ~.x, ~.id, ~color, ~frame, ~obj, - -1L, "id", "1", 1, "x", "#E41A1C", 1, 1, - -2L, "id", "2", 1, "x", "#377EB8", 1, 2, - -2L, "id", "2", 1, "x", "#377EB8", 1, 3, - -3L, "id", "3", 1, "x", "#4DAF4A", 1, 4, - -1L, "x", "x1", 2, "x", "#d0d0d0", 1, 5, - -2L, "x", "x2", 2, "x", "#d0d0d0", 1, 6, - -3L, "x", "x3", 2, "x", "#d0d0d0", 1, 8, - -2L, "x", "x2", 2, "x", "#d0d0d0", 1, 7, - -1L, "id", "1", 4, "y", "#E41A1C", 1, 9, - -2L, "id", "2", 4, "y", "#377EB8", 1, 10, - -3L, "id", "4", 4, "y", "#984EA3", 1, 99, - -4L, "id", "2", 4, "y", "#377EB8", 1, 11, - -1L, "y", "y1", 5, "y", "#d0d0d0", 1, 12, - -2L, "y", "y2", 5, "y", "#d0d0d0", 1, 13, - -3L, "y", "y4", 5, "y", "#d0d0d0", 1, 98, - -4L, "y", "y5", 5, "y", "#d0d0d0", 1, 14, - -1L, "id", "1", 2, "x", "#E41A1C", 2, 1, - -2L, "id", "2", 2, "x", "#377EB8", 2, 2, - -3L, "id", "2", 2, "x", "#377EB8", 2, 3, - -4L, "id", "3", 2, "x", "#4DAF4A", 2, 4, - -1L, "x", "x1", 3, "x", "#d0d0d0", 2, 5, - -2L, "x", "x2", 3, "x", "#d0d0d0", 2, 6, - -3L, "x", "x2", 3, "x", "#d0d0d0", 2, 7, - -4L, "x", "x3", 3, "x", "#d0d0d0", 2, 8, - -1L, "y", "y1", 4, "x", "#d0d0d0", 2, 12, - -2L, "y", "y2", 4, "x", "#d0d0d0", 2, 13, - -3L, "y", "y5", 4, "x", "#d0d0d0", 2, 14, - -1L, "id", "1", 2, "y", "#E41A1C", 2, 9, - -2L, "id", "2", 2, "y", "#377EB8", 2, 10, - -3L, "id", "2", 2, "y", "#377EB8", 2, 11 -) - -lj_extra <- anim_df %>% - arrange(obj, frame) %>% - plot_data("left_join(x, y)") %>% - animate_plot() - -lj_extra <- animate(lj_extra) -anim_save(here::here("images", "left-join-extra.gif"), lj_extra) - -## Save static images -df_names <- data_frame( - .x = c(1.5, 4.5), .y = 0.25, - value = c("x", "y"), - size = 12, - color = "black" -) - -g_input <- proc_data(y_extra) %>% - mutate(.x = .x + 3) %>% - bind_rows(proc_data(x)) %>% - plot_data() + - geom_text(data = df_names, family = "Fira Mono", size = 24) + - annotate("text", label = "↑ duplicate keys in y", x = 4.5, y = -4.75, - family = "Fira Sans", color = "grey45") - -save_static_plot(g_input, "left-join-extra-input") - -lj_g <- left_join(x, y_extra, by = "id") %>% - proc_data() %>% - mutate(.x = .x + 1) %>% - plot_data_join("left_join(x, y)", ylims = ylim(-4.5, -0.5)) - -save_static_plot(lj_g, "left-join-extra") diff --git a/R/move_together.R b/R/move_together.R new file mode 100644 index 0000000..465e638 --- /dev/null +++ b/R/move_together.R @@ -0,0 +1,105 @@ + +#' Combines two processed datasets and combines them for a given method +#' +#' @param lhs the left-hand side dataset +#' @param rhs the righ-hand side dataset +#' @param type a string of the desired combination method, allowed are all dplyr +#' joins or sets +#' +#' @return processed dataset of the combined values +#' +#' @examples +#' NULL +move_together <- function(lhs, rhs, type) { + + all <- bind_rows(lhs, rhs) + + # separate column and row-filter (ids) + x_cols <- dplyr::distinct(lhs, .col) + y_cols <- dplyr::distinct(rhs, .col) + + # separate header columns from ids and treat them as columns + 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)) + y_headers <- filter(y_ids, grepl("^\\.header", .id_long)) + + x_ids <- x_ids %>% filter(!grepl("^\\.header", .id_long)) + y_ids <- y_ids %>% filter(!grepl("^\\.header", .id_long)) + + # assign two combiner functions depending on the type + # one for combining the columns (col_combiner) + # one for combining the rows (row_combiner) + if (type == "full_join") { + col_combiner <- dplyr::full_join + row_combiner <- dplyr::full_join + } else if (type == "inner_join") { + col_combiner <- dplyr::full_join + row_combiner <- dplyr::inner_join + } else if (type == "left_join") { + col_combiner <- dplyr::full_join + row_combiner <- dplyr::left_join + } else if (type == "right_join") { + col_combiner <- dplyr::full_join + row_combiner <- dplyr::right_join + } else if (type == "semi_join") { + col_combiner <- dplyr::left_join + row_combiner <- dplyr::semi_join + } else if (type == "anti_join") { + col_combiner <- dplyr::left_join + row_combiner <- dplyr::anti_join + } else if (type == "union") { + col_combiner <- dplyr::full_join + row_combiner <- dplyr::union + } else if (type == "union_all") { + col_combiner <- dplyr::full_join + row_combiner <- dplyr::union_all + } else if (type == "intersect") { + col_combiner <- dplyr::full_join + row_combiner <- dplyr::intersect + } else if (type == "setdiff") { + col_combiner <- dplyr::full_join + row_combiner <- dplyr::anti_join + } else if (type == "bind_rows") { + col_combiner <- dplyr::full_join + row_combiner <- dplyr::bind_rows + } else if (type == "bind_cols") { + col_combiner <- dplyr::full_join + row_combiner <- dplyr::left_join + } else { + stop("Unknown func") + } + + take_cols <- col_combiner(x_cols, y_cols, by = ".col") + take_ids <- row_combiner(x_ids, y_ids, by = c(".id", ".id_long")) + take_headers <- col_combiner(x_headers, y_headers, by = c(".id", ".id_long")) + + take_ids <- bind_rows(take_headers, take_ids) + + take <- tidyr::crossing(take_ids, take_cols) + + mid <- (2 + length(unique(lhs$.col)) + length(unique(rhs$.col))) / 2 + xvals <- 1:nrow(take_cols) + xvals <- xvals - mean(xvals) + mid + names(xvals) <- pull(take_cols, .col) + + yvals <- cumsum(ifelse(grepl("^\\.header", take_ids$.id_long), 0, -1)) + names(yvals) <- pull(take_ids, .id_long) + + take_vals <- semi_join(all, take %>% select(".id", ".col"), + by = c(".id", ".col")) %>% + mutate(.alpha = 1, + .x = xvals[.col], + .y = yvals[.id_long]) + + bind_rows( + # take, + take_vals, + # fade in place: + all %>% filter(!.id_long %in% take_ids$.id_long) %>% mutate(.alpha = 0), + # moving fade or fade in place as well: + all %>% filter(.id_long %in% take_ids$.id_long & !.col %in% take_cols$.col) %>% + mutate(.alpha = 0) + ) +} diff --git a/R/plot_helpers.R b/R/plot_helpers.R new file mode 100644 index 0000000..231542f --- /dev/null +++ b/R/plot_helpers.R @@ -0,0 +1,76 @@ +#' 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 +#' NULL +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 +#' +#' @inheritParams animate_plot +#' @inheritDotParams anim_options +#' +#' @return a ggplot +#' +#' @examples +#' NULL +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 (!".textcolor" %in% names(d)) + d <- d %>% mutate(.textcolor = choose_text_color(.color)) + + if (".id_long" %in% names(d)) { + d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-")) + } else { + # tidyr + d <- d %>% mutate(.item_id = .id) + } + + width <- ao$cell_width %||% 1 + height <- ao$cell_height %||% 1 + + ggplot(d, aes(x = .x * width, y = .y * height, fill = .color, alpha = .alpha, + group = .item_id)) + + geom_tile(width = 0.9 * width, height = 0.9 * height) + + coord_equal() + + geom_text(data = d %>% filter(!is.na(.val)), aes(label = .val, color = .textcolor), + family = ao$text_family, size = text_size) + + scale_fill_identity() + + scale_color_identity() + + scale_alpha_identity() + + labs(title = title) + + theme_void() + + theme(plot.title = element_text(family = ao$title_family, hjust = 0.5, size = title_size)) +} diff --git a/R/process_data_helpers.R b/R/process_data_helpers.R new file mode 100644 index 0000000..166c203 --- /dev/null +++ b/R/process_data_helpers.R @@ -0,0 +1,155 @@ + +#' Preprocess data +#' +#' @param x a left dataset +#' @param y a right dataset +#' @param by a by argument for joins / set operations +#' @param fill if missing ids should be filled +#' @param ... further arguments passed to add_color +#' @param ao anim_options() +#' +#' @return a preprocessed dataset +#' +#' @examples +#' NULL +process_join <- function(x, y, by, fill = TRUE, ..., + ao = anim_options(...)) { + + #' test for + #' a <- c("unique", "mult", "mult", "also unique") + #' add_duplicate_number(a) + add_duplicate_number <- function(a) { + data_frame(v = a) %>% + group_by(v) %>% + mutate(id = paste(v, 1:n(), sep = "-")) %>% + pull(id) + } + + x <- x %>% + tidyr::unite(dplyr::one_of(by), col = ".id", remove = FALSE) %>% + mutate(.id_long = add_duplicate_number(.id)) + + y <- y %>% + tidyr::unite(dplyr::one_of(by), col = ".id", remove = FALSE) %>% + mutate(.id_long = add_duplicate_number(.id)) + + ids <- dplyr::union(x %>% dplyr::select(.id, .id_long), + y %>% dplyr::select(.id, .id_long)) + + x_ <- process_data_join(x, ids, by, fill = fill, ao = ao) + y_ <- process_data_join(y, ids, by, fill = fill, ao = ao) %>% + mutate(.x = .x + ncol(x) - 1) + + list(x = x_, y = y_) +} + + +#' Processes the data +#' +#' @param x a preprocessed dataset +#' @param ids a data_frame of ids (.id and .id_long) +#' @param by a vector of by-arguments +#' @param width the width of the tiles +#' @param side the side (x or y, lhs or rhs, etc) +#' @param fill if missing ids should be filled +#' @param ... further arguments passed to add_color +#' @param ao anim_options +#' +#' @return a data_frame including all necessary information +#' +#' @examples +#' NULL +process_data_join <- function(x, ids, by, width = 1, side = NA, fill = TRUE, + ..., + ao = anim_options(...)) { + if (is.na(side)) side <- deparse(substitute(x)) + + x_names <- names(x)[grepl("^[^\\.]", names(x))] + x_keys <- 1:length(x_names) + names(x_keys) <- x_names + + special_vars <- names(x)[grepl("^\\.", names(x))] + + x <- x %>% + mutate(.r = row_number()) %>% + tidyr::gather_(key = ".col", value = ".val", names(x)[grepl("^[^.]", names(x))]) %>% + mutate(.x = x_keys[.col], + .y = -.r) %>% + bind_rows(data_frame(.id = ".header", + .id_long = paste(".header", x_names, sep = "_"), + .r = 0, + .col = x_names, + .val = x_names, + .x = x_keys, .y = 0), .) %>% + mutate(.width = width, + .side = side) + + # if there are multiple values in the ids (-2, -3 etc) but they are not present + # in x, because it is in the second/other dataset, add these values here + id_long <- ids$.id_long + mis_ids <- id_long[!id_long %in% x$.id_long] + # if the missing value is a -1, that means the missing value comes not from + # missing dublicate ids + mis_ids <- mis_ids[grepl("[^-1]$", mis_ids)] + if (length(mis_ids) > 0 && fill) { + mis_ids_short <- gsub("-[0-9]+$", "", mis_ids) + + # insert the missing ids at the right place + for (i in mis_ids_short) { + irow <- (1:nrow(x))[x$.id == i] + irow <- irow[1] + x <- bind_rows( + x %>% slice(1:irow), + x %>% filter(.id %in% mis_ids_short) %>% mutate(.id_long = mis_ids), + x %>% slice((irow + 1):nrow(x)) + ) + } + } + + add_color_join(x, rev(ids$.id), by, ao) +} + +#' Adds Color to a processed data_frame +#' +#' @param x a processed data_frame +#' @param ids a vector of ids for the color-matching +#' @param by a vector of column names that constitute the by-argument of joins/sets +#' @param color_header color for the header +#' @param color_other color for "inactive" values +#' @param color_missing color for missing values +#' @param color_fun the function to generate the colors +#' @param text_color the color for the text inside the tiles, +#' defaults to white/black depending on tile color +#' @param ... +#' +#' @return the processed data_frame with a new column .color +#' +#' @examples +#' NULL +add_color_join <- function(x, ids, by, ao, ...) { + + color_header <- ao$color_header %||% get_anim_opt("color_header") + color_other <- ao$color_other %||% get_anim_opt("color_other") + color_missing <- ao$color_missing %||% get_anim_opt("color_missing") + color_fun <- ao$color_fun %||% get_anim_opt("color_fun") + text_color <- ao$text_color %||% get_anim_opt("text_color") + + colors <- c(color_header, color_fun(length(ids))) + names(colors) <- c(".header", ids) + + res <- x %>% + mutate( + .color = ifelse(is.na(.val), + color_missing, + ifelse(.col %in% by, + colors[.id], + color_other)), + .color = ifelse(.id == ".header", color_header, .color), + .textcolor = text_color) + + if (is.na(text_color)) + res <- res %>% mutate(.textcolor = choose_text_color(.color)) + + return(res) +} + diff --git a/R/right_join.R b/R/right_join.R deleted file mode 100644 index 1e51849..0000000 --- a/R/right_join.R +++ /dev/null @@ -1,30 +0,0 @@ -source(here::here("R/00_base_join.R")) - -rj_joined_dfs <- right_join(x, y, "id") %>% - proc_data("y") %>% - mutate(frame = 2, .x = .x + 1) - -rj_extra_blocks <- inner_join(x, y, "id") %>% - select(id) %>% - proc_data("x") %>% - mutate(frame = 2, .x = .x + 1) - -rj <- bind_rows( - initial_join_dfs, - rj_joined_dfs, - rj_extra_blocks -) %>% - filter(!is.na(value)) %>% - mutate( - .id = ifelse(label == "x", label, .id), - removed = as.integer(grepl("3", value)) - ) %>% - arrange(removed, value, .id, frame) %>% - plot_data("right_join(x, y)") %>% - animate_plot() - -rj <- animate(rj) -anim_save(here::here("images", "right-join.gif"), rj) - -rj_g <- plot_data(rj_joined_dfs, "right_join(x, y)") -save_static_plot(rj_g, "right-join") diff --git a/R/semi_join.R b/R/semi_join.R deleted file mode 100644 index 291acd5..0000000 --- a/R/semi_join.R +++ /dev/null @@ -1,30 +0,0 @@ -source(here::here("R/00_base_join.R")) - -sj_joined_df <- semi_join(x, y, "id") %>% - proc_data("x") %>% - mutate(frame = 2, .x = .x + 1.5) - -sj_extra_blocks <- inner_join(x, y, "id") %>% - select(id) %>% - proc_data("y") %>% - mutate(frame = 2, .x = .x + 1.5) - -sj <- bind_rows( - initial_join_dfs, - sj_joined_df, - sj_extra_blocks -) %>% - arrange(value) %>% - plot_data("semi_join(x, y)") %>% - animate_plot() - -sj <- animate(sj) -anim_save(here::here("images", "semi-join.gif"), sj) - -# Static Images -sj_g <- semi_join(x, y, "id") %>% - proc_data() %>% - mutate(.x = .x + 1.5) %>% - plot_data_join("semi_join(x, y)") - -save_static_plot(sj_g, "semi-join") diff --git a/R/setdiff.R b/R/setdiff.R deleted file mode 100644 index a7facaf..0000000 --- a/R/setdiff.R +++ /dev/null @@ -1,102 +0,0 @@ -source(here::here("R/00_base_set.R")) - -# ---- setdiff(x, y) ---- - -# Dim elements unique to y -setd_step2 <- initial_set_dfs %>% - mutate( - frame = 2, - alpha = case_when( - .y == -1 ~ 0.55, - .id == "y" ~ 0.15, - TRUE ~ 1 - ) - ) - -# Merge, dim overlapping elements -setd_step3 <- initial_set_dfs %>% - filter(!(.id == "y" & .y == -2)) %>% - mutate( - frame = 3, - alpha = ifelse(.y == -1, 0.25, 1), - .x = ifelse(.id == "y", .x - 3, .x), - .x = .x + 1.5 - ) - -# Result of setdiff -setd_step4 <- setdiff(x, y) %>% - proc_data_set("xy") %>% - mutate(frame = 4, .x = .x + 1.5) - -setd <- bind_rows( - initial_set_dfs, - setd_step2, - setd_step3, - setd_step4 -) %>% - mutate(alpha = ifelse(is.na(alpha), 1, alpha)) %>% - arrange(frame, desc(.y), desc(.id)) %>% - plot_data_set(., "setdiff(x, y)") %>% - animate_plot() - -setd <- animate(setd) - -anim_save(here::here("images", "setdiff.gif"), setd) - -setd_g <- setdiff(x, y) %>% - proc_data_set() %>% - mutate(.x = .x + 1.5) %>% - plot_data_set("setdiff(x, y)") - -save_static_plot(setd_g, "setdiff") - - -# ---- setdiff(y, x) ---- - -# Dim elements unique to x -setd2_step2 <- initial_set_dfs %>% - mutate( - frame = 2, - alpha = case_when( - .y == -1 ~ 0.55, - .id == "x" ~ 0.15, - TRUE ~ 1 - ) - ) - -# Merge, dim overlapping elements -setd2_step3 <- initial_set_dfs %>% - filter(!(.id == "x" & .y <= -2)) %>% - mutate( - frame = 3, - alpha = ifelse(.y == -1, 0.25, 1), - .x = ifelse(.id == "y", .x - 3, .x), - .x = .x + 1.5 - ) - -# Result of setdiff -setd2_step4 <- setdiff(y, x) %>% - proc_data_set("xy") %>% - mutate(frame = 4, .x = .x + 1.5) - -setd2 <- bind_rows( - initial_set_dfs, - setd2_step2, - setd2_step3, - setd2_step4 -) %>% - mutate(alpha = ifelse(is.na(alpha), 1, alpha)) %>% - arrange(frame, desc(.y), .id) %>% - plot_data_set(., "setdiff(y, x)") %>% - animate_plot() - -setd2 <- animate(setd2) - -anim_save(here::here("images", "setdiff-rev.gif"), setd2) - -setd2_g <- setdiff(x, y) %>% - proc_data_set() %>% - mutate(.x = .x + 1.5) %>% - plot_data_set("setdiff(y, x)") - -save_static_plot(setd2_g, "setdiff-rev") diff --git a/R/tidyr_helpers.R b/R/tidyr_helpers.R new file mode 100644 index 0000000..594204d --- /dev/null +++ b/R/tidyr_helpers.R @@ -0,0 +1,355 @@ +#' Gets the ... names +#' +#' Used to get the -year +#' +#' @param ... arguments +#' +#' @return a vector of the names of ... +#' +#' @examples +#' x <- 1:10 +#' y <- 1 +#' get_quos_names(-x) +#' get_quos_names(x:y) +get_quos_names <- function(...) { + q <- rlang::quos(...) + purrr::map_chr(q, rlang::quo_name) +} + +#' Parses a simple vector so that it looks like its input +#' +#' @param x a vector +#' +#' @return a string +#' +#' @examples +#' dput_parser("x") +#' dput_parser(c("x", "y")) +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 +#' +#' @param x a processed data-frame as outputted by process_long or process_wide +#' @param key_values the unique key-values +#' @param color_fun the color function +#' @param color_header the color for the header +#' @param ... not used +#' +#' @return a data-frame with the colors +#' +#' @examples +#' NULL +add_color_tidyr <- function(x, key_values, + color_fun = scales::brewer_pal(type = "qual", "Set1"), + color_header = "#737373", + color_id = "#d0d0d0") { + + color_dict <- color_fun(3) + names(color_dict) <- c("id", "key", "value") + + x %>% mutate(.color = color_dict[.type]) +} + +#' Processes a wide dataframe and converts it into a dataset that can be plotted +#' +#' @param x a wide data frame +#' @param ids a vector of id-variables that are already in the tidy-format +#' @param key a vector of key-variables +#' @param color_id the color for the id-body +#' @param ... +#' +#' @return TODO +#' +#' @examples +#' wide <- data_frame( +#' year = 2010:2011, +#' Alice = c(105, 110), +#' Bob = c(100, 97), +#' Charlie = c(90, 95) +#' ) +#' process_wide(wide, ids = "year", key = "person") +#' process_wide(wide, ids = "year", key = "person") %>% static_plot +process_wide <- function(x, ids, key, color_id = "lightgray", ...) { + + if (!all(ids %in% names(x))) + stop("all ids must be in x") + + nr <- nrow(x) + nc <- ncol(x) + key_values <- names(x) + key_values <- key_values[!key_values %in% ids] + + 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()) %>% + tidyr::unite(dplyr::one_of(ids), col = ".id_map", remove = F) + + x <- x %>% + gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>% + mutate(.key_map = .col, + .type = ifelse(.col %in% ids, "id", "value"), + .val = as.character(.val), + .x = rep(1:nc, each = nr), + .y = -rep(1:nr, nc), + .header = F) + + # make sure that we have one id value per key + tmp <- x %>% filter(.key_map %in% ids) + x <- bind_rows( + left_join(tmp %>% select(-.key_map), + tmp %>% select(.id_map) %>% tidyr::crossing(.key_map = key_values), + by = ".id_map"), + x %>% filter(!.key_map %in% ids) + ) + + # add header: + crosser <- tidyr::crossing(.id_map = as.character(id_values$.id_map), + .key_map = key_values) + key_header <- data_frame( + .key_map = key_values, + .r = 0, + .col = key_values, + .val = key_values, + .type = "key", + .x = length(ids) + 1:length(key_values), + .y = 0, + .header = TRUE) %>% + left_join(crosser, by = ".key_map") + + id_header <- left_join( + data_frame(.id_map = ids, + .r = 0, + .col = ids, + .val = ids, + .type = "id", + .x = 1:length(ids), + .y = 0, + .header = TRUE), + tidyr::crossing(.id_map = ids, .key_map = key_values), + by = ".id_map" + ) + + x <- bind_rows(id_header, key_header, x) + + x <- x %>% tidyr::unite(.key_map, .id_map, .val, col = ".id", remove = F) + + x %>% + add_color_tidyr(key_values = key_values) %>% + mutate(.alpha = ifelse(.header == TRUE, 1, 0.6)) +} + +#' Processes a long dataframe and converts it into a dataset that can be plotted +#' +#' @param x a long data frame +#' @param ids a vector of id-variables that are already in the tidy-format +#' @param key a vector of key-variables +#' @param ... +#' +#' @return TODO +#' +#' @examples +#' long <- data_frame( +#' year = c(2010L, 2011L, 2010L, 2011L, 2010L, 2011L), +#' person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), +#' sales = c(105, 110, 100, 97, 90, 95) +#' ) +#' process_long(long, ids = "year", key = "person", value = "sales") +#' process_long(long, ids = "year", key = "person", value = "sales") %>% static_plot +process_long <- function(x, ids, key, value, ...) { + + if (!all(c(ids, key, value) %in% names(x))) + stop("all ids, key, and value must be names of x") + + nr <- nrow(x) + nc <- ncol(x) + xn <- names(x) + + x <- x %>% mutate(.r = row_number()) %>% + tidyr::unite(ids, col = ".id_map", remove = F) %>% + tidyr::unite(key, col = ".key_map", remove = F) + + key_values <- x %>% pull(key) %>% unique() + + type_dict <- c(rep("id", length(ids)), rep("key", length(key)), rep("value", length(value))) + names(type_dict) <- c(ids, key, value) + + x_dict <- 1:nc + names(x_dict) <- xn + + x <- x %>% + tidyr::gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>% + mutate( + .x = x_dict[.col], + .y = -rep(1:nr, nc), + .type = type_dict[.col], + .val = as.character(.val), + .header = FALSE + ) + + # add headers: + + id_headers <- tidyr::crossing(.id_map = ids, # x$.id_map %>% unique() + .key_map = key_values, + ) %>% + mutate( + .r = 0, + .col = "id", + .val = .id_map, + .x = x_dict[.val], + .y = 0, + .type = "id", + .header = TRUE + ) + + x <- x %>% + dplyr::add_row( + .before = T, + .id_map = c(rep("key", length(key)), rep("value", length(value))), + .key_map = c(rep("key", length(key)), rep("value", length(value))), + .r = 0, + .col = c(rep("key", length(key)), rep("value", length(value))), + .val = c(key, value), + .x = length(ids) + 1:length(c(key, value)), + .y = 0, + .type = c(rep("key", length(key)), rep("value", length(value))), + .header = TRUE + ) + + x <- bind_rows(id_headers, x) + + x <- x %>% + tidyr::unite(.key_map, .id_map, .val, col = ".id", remove = F) + + x %>% add_color_tidyr(key_values = key_values) %>% + mutate(.alpha = ifelse(.header == TRUE, 1, 0.6)) +} + +#' Animates a gather or spread function +#' +#' internally used by animate_spread and animate_gather +#' +#' @param lhs the (processed) dataset on the left-side +#' @param rhs the (processed) dataset on the right-side +#' @param sequence a named vector of the sequence titles +#' (current_state, final_state, operation, and reverse_operation) +#' @param key_values the unique key-values +#' @param export the export type, either gif, first or last. The latter two +#' export ggplots of the first/last state of the join +#' @param detailed boolean value if the animation should show one step for each +#' key value +#' @param ... further arguments passed to animate_plot +#' +#' @return the plot or the gif +#' +#' @examples +#' NULL +gather_spread <- function(lhs, rhs, sequence, key_values, export, detailed, ..., + anim_opts = anim_options(...)) { + # lhs is the one state of the df + # rhs is the target state + + # animate the four steps: inital with sequence[["current_state]], + # transformations by the unique key-values with sequence[["operation"]], + # final with sequence[["final_state"]] + # and back transformation with sequence[["reverse_operation]] + + # have lhs and rhs in the right format: preprocessed with ids, .x, .y etc. + # have a color function that makes coloring easier + # transformations: for each key-variable: respective ids "fly in", keys fly in and ids fly in (all in one step for one key. i.e., Alice) + + # how much is the rhs to the left of lhs? + + if (!detailed) { + anim_df <- bind_rows( + lhs %>% mutate(.frame = 0), + rhs %>% mutate(.frame = 1) + ) + frame_labels <- c(sequence[["operation"]], sequence[["reverse_operation"]]) + + title_string <- "{ifelse(transitioning, previous_state, ifelse(grepl('gather', next_state), 'Wide', 'Long'))}" + + tl <- 2 + sl <- 1 + + } else { + xshift <- 2 + + rhs <- rhs %>% mutate(.x = .x + max(lhs$.x) + xshift) + # the header rows + header_start <- lhs %>% filter(.header == TRUE, !.key_map %in% key_values) + header_end <- rhs %>% filter(.header == TRUE) + + state_start <- lhs %>% mutate(.frame = 0) + state_end <- rhs %>% mutate(.frame = length(key_values) + 2) + + step_0 <- lhs %>% mutate(.frame = 1) + # for each unique key-value move the respective entries + keys_remaining <- lhs %>% filter(.key_map %in% key_values) + keys_shifted <- lhs[0, ] + key_steps <- lhs[0, ] + f <- 1 + ids_remaining <- lhs %>% filter(.type == "id" & .header == FALSE) + + for (keyval in key_values) { + f <- f + 1 + move_rhs <- rhs %>% filter(.key_map == keyval) + + keys_remaining <- keys_remaining %>% filter(.key_map != keyval) + + if (keyval == key_values[length(key_values)]) { + header_start <- NULL + } + hd <- header_end %>% filter(.key_map == keyval | + (.type %in% c("key", "value") & + .col %in% c("key", "value"))) + keys_shifted <- bind_rows(keys_shifted, move_rhs) + round_n <- bind_rows(header_start, hd, + keys_remaining, keys_shifted) %>% + mutate(.frame = f) + + key_steps <- bind_rows(key_steps, round_n) + } + + anim_df <- bind_rows(state_start, step_0, key_steps, state_end) + + # form the .frame as proper factors + frame_labels <- c( + sequence[["current_state"]], + paste(sequence[["operation"]], key_values), + sequence[["final_state"]], + sequence[["reverse_operation"]] + ) + title_string <- "{gsub('\\\\) [a-zA-Z]+$', ')', previous_state)}" + + tl <- length(unique(anim_df$.frame)) * 2 + sl <- 1 + } + + frame_levels <- anim_df$.frame %>% unique() + + anim_df <- anim_df %>% + mutate(.frame = factor(.frame, + levels = frame_levels, + labels = frame_labels)) + + if (export == "gif") { + animate_plot(anim_df, title = title_string, anim_opts = anim_opts) + } else if (export == "first") { + static_plot(state_start, anim_opts = anim_opts) #.... + } else if (export == "last") { + static_plot(state_end, anim_opts = anim_opts) #.... + } + + # open issues: ... doesnt work properly. + # especially if the id-arguments are passed in the gather-style, i.e., -year, or year:var +} diff --git a/R/tidyr_spread_gather.R b/R/tidyr_spread_gather.R deleted file mode 100644 index 40b4570..0000000 --- a/R/tidyr_spread_gather.R +++ /dev/null @@ -1,97 +0,0 @@ -source(here::here("R", "00_base_tidyr.R")) - -sg_wide <- wide %>% - proc_data("0-wide", colorize_wide_tidyr) %>% - mutate(frame = 1, .id = "0-wide") - -sg_long <- wide %>% - tidyr::gather("key", "val", -id) %>% - proc_data("3-tall", color_fun = function(x, y) x) %>% - split(.$label) - -sg_long$id <- - sg_wide %>% - filter(label == "id") %>% - select(value, color) %>% - left_join(sg_long$id, ., by = "value") %>% - mutate(alpha = 1) - -sg_long$key <- - sg_wide %>% - filter(label != "id") %>% - select(label, color) %>% - left_join(sg_long$key, ., by = c("value" = "label")) %>% - distinct() %>% - mutate(alpha = 1) - -sg_long$val <- - sg_wide %>% - filter(label != "id", .y < 0) %>% - select(value, color) %>% - left_join(sg_long$val, ., by = "value") %>% - mutate(alpha = 0.6) - -sg_long <- bind_rows(sg_long) %>% mutate(frame = 2) - -sg_long_labels <- data_frame(id = 1, a = "id", x = "key", y = "val") %>% - proc_data("4-label") %>% - filter(label != "id") %>% - mutate(color = "#FFFFFF", .y = 0, .x = .x -1, frame = 2, alpha = 1, label = recode(label, "a" = "id")) - -sg_wide_labels <- data_frame(id = 1, a = "id") %>% - proc_data("2-label") %>% - filter(label != "id") %>% - mutate(color = "#FFFFFF", .y = 0, .x = .x -1, frame = 1, alpha = 1, label = recode(label, "a" = "id")) - -sg_long_extra_keys <- map_dfr( - seq_len(nrow(wide) - 1), - ~ filter(sg_wide, .y > -1) # Extra key blocks in long column -) - -n_key_cols <- length(setdiff(colnames(wide), "id")) - -sg_long_extra_id <- map_dfr( - seq_len(n_key_cols - 1), - ~ filter(sg_wide, .x == 1) # Extra id column blocks for long column -) - -sg_data <- bind_rows( - sg_wide, - sg_wide_labels, - sg_long, - sg_long_labels, - sg_long_extra_keys, - sg_long_extra_id -) %>% - mutate( - label = ifelse(value %in% setdiff(colnames(wide), "id"), "key", label), - label = ifelse(value %in% c("key", "val"), "zzz", label), - .text_color = ifelse(grepl("label", .id), "black", "white"), - .text_size = ifelse(grepl("label", .id), 8, 12) - ) %>% - arrange(label, .id, value) %>% - mutate(frame = factor(frame, labels = c('spread(long, key, val)', 'gather(wide, key, val, x:z)'))) %>% - select(.x, .y, everything()) - -sg_static <- - sg_data %>% - split(.$frame) %>% - imap(~ plot_data(.x, .y) + - ylim(-6.5, 0.5) + - labs(subtitle = "returns") + - theme(plot.subtitle = element_text(family = "Fira Sans", size = 14, color = "grey50", hjust = 0.5, margin = margin(25))) - ) - -save_static_plot(sg_static[[1]], "tidyr-spread") -save_static_plot(sg_static[[2]], "tidyr-gather") - -sg_anim <- - sg_data %>% - plot_data() %>% - animate_plot() + - view_follow() + - labs(title = "{ifelse(transitioning, next_state, ifelse(grepl('gather', next_state), 'long', 'wide'))}") + - ease_aes("sine-in-out", x = "exponential-out") - -sg_anim <- animate(sg_anim) -anim_save(here::here("images", "tidyr-spread-gather.gif"), sg_anim) diff --git a/R/union.R b/R/union.R deleted file mode 100644 index 2ccbfb0..0000000 --- a/R/union.R +++ /dev/null @@ -1,42 +0,0 @@ -source(here::here("R/00_base_set.R")) - -# ---- union(x, y) ---- -uxy <- bind_rows( - initial_set_dfs, - union(x, y) %>% proc_data_set("xy") %>% mutate(frame = 2, .x = .x + 1.5), - intersect(x, y) %>% proc_data_set("xy") %>% mutate(frame = 2, .y = -4, .x = .x + 1.5) -) %>% - plot_data_set("union(x, y)", ylims = ylim(-4.5, -0.5)) %>% - animate_plot() - -uxy <- animate(uxy) - -anim_save(here::here("images", "union.gif"), uxy) - -uxy_g <- union(x, y) %>% - proc_data_set() %>% - mutate(.x = .x + 1.5) %>% - plot_data_set("union(x, y)", ylims = ylim(-0.5, -4.5)) - -save_static_plot(uxy_g, "union") - - -# ---- union(y, x) ---- -uyx <- bind_rows( - initial_set_dfs, - union(y, x) %>% proc_data_set("xy") %>% mutate(frame = 2, .x = .x + 1.5), - intersect(y, x) %>% proc_data_set("xy") %>% mutate(frame = 2, .y = -4, .x = .x + 1.5) -) %>% - plot_data_set("union(y, x)", ylims = ylim(-4.5, -0.5)) %>% - animate_plot() - -uyx <- animate(uyx) - -anim_save(here::here("images", "union-rev.gif"), uyx) - -uyx_g <- union(y, x) %>% - proc_data_set() %>% - mutate(.x = .x + 1.5) %>% - plot_data_set("union(y, x)", ylims = ylim(-4.5, -0.5)) - -save_static_plot(uyx_g, "union-rev") diff --git a/R/union_all.R b/R/union_all.R deleted file mode 100644 index 4d6e1d7..0000000 --- a/R/union_all.R +++ /dev/null @@ -1,23 +0,0 @@ -source(here::here("R/00_base_set.R")) - -ua <- bind_rows( - initial_set_dfs, - initial_set_dfs %>% mutate(frame = 2, .y = ifelse(.id == "y", .y - 3, .y)), # fly y down - proc_data_set(x, "ux") %>% mutate(frame = 3, .x = .x + 1.5), # merge - proc_data_set(y, "uy") %>% mutate(frame = 3, .x = .x + 1.5, .y = .y - 3), # un-merge - initial_set_dfs %>% mutate(frame = 4, .y = ifelse(.id == "y", .y - 3, .y)) # fly y up -) %>% - arrange(desc(frame)) %>% - plot_data_set("union_all(x, y)", ylims = ylim(-5.5, -0.5)) + - transition_states(frame, 1, c(1, 0, 1, 0)) - -ua <- animate(ua) - -anim_save(here::here("images", "union-all.gif"), ua) - -ua_g <- union_all(x, y) %>% - proc_data_set() %>% - mutate(.x = .x + 1.5) %>% - plot_data_set("union_all(x, y)", ylims = ylim(-5.5, -0.5)) - -save_static_plot(ua_g, "union-all") diff --git a/R/utils-pipe.R b/R/utils-pipe.R new file mode 100644 index 0000000..fb8c818 --- /dev/null +++ b/R/utils-pipe.R @@ -0,0 +1,11 @@ +#' Pipe operator +#' +#' See \code{magrittr::\link[magrittr]{\%>\%}} for details. +#' +#' @name %>% +#' @rdname pipe +#' @keywords internal +#' @export +#' @importFrom magrittr %>% +#' @usage lhs \%>\% rhs +NULL diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..4a69aaf --- /dev/null +++ b/R/utils.R @@ -0,0 +1,26 @@ +`%||%` <- 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 +} diff --git a/R/zzzz-package.R b/R/zzzz-package.R new file mode 100644 index 0000000..42f207e --- /dev/null +++ b/R/zzzz-package.R @@ -0,0 +1,27 @@ +#' @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 slice data_frame row_number +#' @importFrom tidyr gather spread +#' @keywords internal +"_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, + color_header = "#737373", + color_other = "#d0d0d0", + color_missing = "#ffffff", + color_fun = scales::brewer_pal(type = "qual", "Set1"), + text_color = NA, + cell_width = 1, + cell_height = 1 +) + diff --git a/README.Rmd b/README.Rmd index 837e02f..b447f72 100644 --- a/README.Rmd +++ b/README.Rmd @@ -1,5 +1,7 @@ --- output: github_document +editor_options: + chunk_output_type: console --- @@ -8,47 +10,45 @@ output: github_document knitr::opts_chunk$set( collapse = TRUE, comment = "#>", - echo = FALSE, + echo = TRUE, warning = FALSE, message = FALSE, + fig.path = "man/figures/tidyexplain-", cache = TRUE ) +library(tidyexplain) +set_font_size(11, 26) ``` [gganimate]: https://github.com/thomasp85/gganimate#README [dplyr-two-table]: https://dplyr.tidyverse.org/articles/two-table.html -[r4ds]: http://r4ds.had.co.nz/ -[r4ds-relational]: http://r4ds.had.co.nz/relational-data.html -[r4ds-set-ops]: http://r4ds.had.co.nz/relational-data.html#set-operations -[r4ds-tidy-data]: http://r4ds.had.co.nz/tidy-data.html#tidy-data-1 -[tidyverse]: https://tidyverse.org -[tidyr]: https://tidyr.tidyverse.org +[r4ds-set-ops]: http://r4ds.had.co.nz/relation-data.html#set-operations # Tidy Animated Verbs -Garrick Aden-Buie -- [@grrrck](https://twitter.com/grrrck) -- [garrickadenbuie.com](https://www.garrickadenbuie.com). Set operations contributed by [Tyler Grant Smith](https://github.com/TylerGrantSmith). +Garrick Aden-Buie -- [@grrrck](https://twitter.com/grrrck) -- [garrickadenbuie.com](https://www.garrickadenbuie.com). + +David Zimmermann -- [@dav_zim](https://twitter.com/dav_zim) -- [datashenanigan.wordpress.com](https://datashenanigan.wordpress.com/) + +Set operations contributed by [Tyler Grant Smith](https://github.com/TylerGrantSmith). [![Binder](http://mybinder.org/badge.svg)](https://mybinder.org/v2/gh/gadenbuie/tidy-animated-verbs/master?urlpath=rstudio) [![CC0](https://img.shields.io/badge/license_(images)_-CC0-green.svg)](https://creativecommons.org/publicdomain/zero/1.0/) [![MIT](https://img.shields.io/badge/license_(code)_-MIT-green.svg)](https://opensource.org/licenses/MIT) -- [**Mutating Joins**](#mutating-joins) — [`inner_join()`](#inner-join), [`left_join()`](#left-join), - [`right_join()`](#right-join), [`full_join()`](#full-join) - -- [**Filtering Joins**](#filtering-joins) — [`semi_join()`](#semi-join), [`anti_join()`](#anti-join) +- Mutating Joins: [`inner_join()`](#inner-join), [`left_join()`](#left-join), +[`right_join()`](#right-join), [`full_join()`](#full-join) + +- Filtering Joins: [`semi_join()`](#semi-join), [`anti_join()`](#anti-join) -- [**Set Operations**](#set-operations) — [`union()`](#union), [`union_all()`](#union-all), [`intersect()`](#intersect), [`setdiff()`](#setdiff) +- Set Operations: [`union()`](#union), [`union_all()`](#union-all), [`intersect()`](#intersect), [`setdiff()`](#setdiff) -- [**Tidy Data**](#tidy-data) — [`spread()` and `gather()`](#spread-and-gather) +- Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) - Learn more about - - [Using the animations and images](#usage) - [Relational Data](#relational-data) - [gganimate](#gganimate) - -## Background -### Usage Please feel free to use these images for teaching or learning about action verbs from the [tidyverse](https://tidyverse.org). You can directly download the [original animations](images/) or static images in [svg](images/static/svg/) or [png](images/static/png/) formats, or you can use the [scripts](R/) to recreate the images locally. @@ -56,46 +56,35 @@ You can directly download the [original animations](images/) or static images in Currently, the animations cover the [dplyr two-table verbs][dplyr-two-table] and I'd like to expand the animations to include more verbs from the tidyverse. [Suggestions are welcome!](https://github.com/gadenbuie/tidy-animated-verbs/issues) -### Relational Data - -The [Relational Data][r4ds-relational] chapter of the -[R for Data Science][r4ds] book by Garrett Grolemund and Hadley Wickham -is an excellent resource for learning more about relational data. +## Installing -The [dplyr two-table verbs vignette][dplyr-two-table] -and Jenny Bryan's [Cheatsheet for dplyr join functions](http://stat545.com/bit001_dplyr-cheatsheet.html) -are also great resources. +The in-development version of `tidyexplain` can be installed with `devtools`: -### gganimate +```r +# install.package("devtools") +devtools::install_github("gadenbuie/tidy-animated-verbs") -The animations were made possible by the newly re-written [gganimate] package by -[Thomas Lin Pedersen](https://github.com/thomasp85) -(original by [Dave Robinson](https://github.com/dgrtwo)). -The [package readme][gganimate] provides an excellent (and quick) introduction to gganimte. +library(tidyexplain) +``` ## Mutating Joins -> A mutating join allows you to combine variables from two tables. It first matches observations by their keys, then copies across variables from one table to the other. -> [R for Data Science: Mutating joins](http://r4ds.had.co.nz/relational-data.html#mutating-joins) - ```{r intial-dfs} -source("R/00_base_join.R") -df_names <- data_frame( - .x = c(1.5, 4.5), .y = 0.25, - value = c("x", "y"), - size = 12, - color = "black" +x <- dplyr::data_frame( + id = 1:3, + x = paste0("x", 1:3) ) -g <- plot_data(initial_join_dfs) + - geom_text(data = df_names, family = "Fira Mono", size = 24) +y <- dplyr::data_frame( + id = (1:4)[-3], + y = paste0("y", (1:4)[-3]) +) -save_static_plot(g, "original-dfs") +animate_full_join(x, y, by = c("id"), export = "first") ``` - -```{r echo=TRUE} +```{r} x y ``` @@ -105,13 +94,12 @@ y > All rows from `x` where there are matching values in `y`, and all columns from `x` and `y`. ```{r inner-join} -source("R/inner_join.R") +animate_inner_join(x, y, by = "id") ``` -![](images/inner-join.gif) -```{r echo=TRUE} -inner_join(x, y, by = "id") +```{r} +dplyr::inner_join(x, y, by = "id") ``` ### Left Join @@ -119,13 +107,12 @@ inner_join(x, y, by = "id") > 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} -source("R/left_join.R") +animate_left_join(x, y, by = "id") ``` -![](images/left-join.gif) -```{r echo=TRUE} -left_join(x, y, by = "id") +```{r} +dplyr::left_join(x, y, by = "id") ``` ### Left Join (Extra Rows in y) @@ -133,14 +120,14 @@ left_join(x, y, by = "id") > ... If there are multiple matches between `x` and `y`, all combinations of the matches are returned. ```{r left-join-extra} -source("R/left_join_extra.R") -``` +y_extra <- dplyr::bind_rows(y, dplyr::data_frame(id = 2, y = "y5")) +y_extra # has multiple rows with the key from `x` -![](images/left-join-extra.gif) +animate_left_join(x, y_extra, by = "id", title_size = 22) +``` -```{r echo=TRUE} -y_extra # has multiple rows with the key from `x` -left_join(x, y_extra, by = "id") +```{r} +dplyr::left_join(x, y_extra, by = "id") ``` ### Right Join @@ -148,13 +135,12 @@ left_join(x, y_extra, by = "id") > 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} -source("R/right_join.R") +animate_right_join(x, y, by = "id") ``` -![](images/right-join.gif) -```{r echo=TRUE} -right_join(x, y, by = "id") +```{r} +dplyr::right_join(x, y, by = "id") ``` ### Full Join @@ -162,34 +148,27 @@ right_join(x, y, by = "id") > 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} -source("R/full_join.R") +animate_full_join(x, y, by = "id") ``` -![](images/full-join.gif) -```{r echo=TRUE} -full_join(x, y, by = "id") +```{r} +dplyr::full_join(x, y, by = "id") ``` ## Filtering Joins -> Filtering joins match observations in the same way as mutating joins, but affect the observations, not the variables. -> ... Semi-joins are useful for matching filtered summary tables back to the original rows. -> ... Anti-joins are useful for diagnosing join mismatches. -> [R for Data Science: Filtering Joins](http://r4ds.had.co.nz/relational-data.html#filtering-joins) - ### Semi Join > All rows from `x` where there are matching values in `y`, keeping just columns from `x`. ```{r semi-join} -source("R/semi_join.R") +animate_semi_join(x, y, by = "id") ``` -![](images/semi-join.gif) -```{r echo=TRUE} -semi_join(x, y, by = "id") +```{r} +dplyr::semi_join(x, y, by = "id") ``` ### Anti Join @@ -197,45 +176,31 @@ semi_join(x, y, by = "id") > All rows from `x` where there are not matching values in `y`, keeping just columns from `x`. ```{r anti-join} -source("R/anti_join.R") +animate_anti_join(x, y, by = "id") ``` -![](images/anti-join.gif) -```{r echo=TRUE} -anti_join(x, y, by = "id") +```{r} +dplyr::anti_join(x, y, by = "id") ``` ## Set Operations -> Set operations are occasionally useful when you want to break a single complex filter into simpler pieces. -> All these operations work with a complete row, comparing the values of every variable. -> These expect the x and y inputs to have the same variables, and treat the observations like sets. -> [R for Data Science: Set operations](http://r4ds.had.co.nz/relational-data.html#set-operations) - ```{r intial-dfs-so} -source("R/00_base_set.R") -df_names <- data_frame( - .x = c(2.5, 5.5), .y = 0.25, - value = c("x", "y"), - size = 12, - color = "black" +x <- dplyr::data_frame( + x = c(1, 1, 2), + y = c("a", "b", "a") +) +y <- dplyr::data_frame( + x = c(1, 2), + y = c("a", "b") ) -g <- plot_data_set(initial_set_dfs, "", NULL, NULL) + - geom_text(data = df_names, family = "Fira Mono", size = 24) - -save_static_plot(g, "original-dfs-set-ops") -``` - -```{r remove-set-ops-ids} -x <- x %>% select(-id) -y <- y %>% select(-id) +animate_union(x, y, export = "first") ``` - -```{r echo=TRUE} +```{r} x y ``` @@ -245,20 +210,20 @@ y > All unique rows from `x` and `y`. ```{r union} -source("R/union.R") -<> +animate_union(x, y) ``` -![](images/union.gif) -```{r echo=TRUE} -union(x, y) +```{r} +dplyr::union(x, y) ``` -![](images/union-rev.gif) -```{r echo=TRUE} -union(y, x) + +```{r union-y-x} +animate_union(y, x) + +dplyr::union(y, x) ``` ### Union All @@ -266,15 +231,13 @@ union(y, x) > All rows from `x` and `y`, keeping duplicates. ```{r union-all} -source("R/union_all.R") -<> +animate_union_all(x, y) ``` -![](images/union-all.gif) -```{r echo=TRUE} -union_all(x, y) +```{r} +dplyr::union_all(x, y) ``` @@ -283,14 +246,12 @@ union_all(x, y) > Common rows in both `x` and `y`, keeping just unique rows. ```{r intersect} -source("R/intersect.R") -<> +animate_intersect(x, y) ``` -![](images/intersect.gif) -```{r echo=TRUE} -intersect(x, y) +```{r} +dplyr::intersect(x, y) ``` ### Set Difference @@ -298,72 +259,91 @@ intersect(x, y) > All rows from `x` which are not also rows in `y`, keeping just unique rows. ```{r setdiff} -source("R/setdiff.R") -<> +animate_setdiff(x, y) ``` -![](images/setdiff.gif) -```{r echo=TRUE} -setdiff(x, y) +```{r} +dplyr::setdiff(x, y) ``` -![](images/setdiff-rev.gif) -```{r echo=TRUE} -setdiff(y, x) +```{r setdiff-y-x} +animate_setdiff(y, x) + +dplyr::setdiff(y, x) ``` -## Tidy Data +## Tidy Data and `gather()`, `spread()` functionality -[Tidy data][r4ds-tidy-data] follows the following three rules: +[Tidy data](http://r4ds.had.co.nz/tidy-data.html#tidy-data-1) follows +the following three rules: -1. Each variable has its own column. -1. Each observation has its own row. -1. Each value has its own cell. +1. Each variable has its own column. +2. Each observation has its own row. +3. Each value has its own cell. -Many of the tools in the [tidyverse] expect data to be formatted as a tidy dataset and the [tidyr] package provides functions to help you organize your data into tidy data. +Many of the tools in the [tidyverse](https://tidyverse.org) expect data +to be formatted as a tidy dataset and the +[tidyr](https://tidyr.tidyverse.org) package provides functions to help +you organize your data into tidy data. -```{r tidyr-wide-long} -source("R/tidyr_spread_gather.R") +```{r} +long <- dplyr::data_frame( + year = c(2010, 2011, 2010, 2011, 2010, 2011), + person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), + sales = c(105, 110, 100, 97, 90, 95) +) +wide <- dplyr::data_frame( + year = 2010:2011, + Alice = c(105, 110), + Bob = c(100, 97), + Charlie = c(90, 95) +) +``` -tidy_plots <- list() -tidy_plots$wide <- bind_rows(sg_wide, sg_wide_labels) -tidy_plots$long <- bind_rows(sg_long, sg_long_labels) +### Gather -tidy_plots <- map(tidy_plots, ~ mutate(., - .text_color = ifelse(grepl("id|key|val", value), "black", "white"), - .text_size = ifelse(grepl("id|key|val", value), 6, 10) -)) %>% - imap(~ plot_data(.x, .y)) +> 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. -tidy_plots$wide <- tidy_plots$wide + ylim(-6.5, 0.5) +```{r gather} +set_font_size(4, 15) +set_anim_options(anim_options(cell_width = 2)) +animate_gather(wide, key = "person", value = "sales", -year) +``` -save_static_plot(cowplot::plot_grid(plotlist = tidy_plots, axis = "t"), "original-dfs-tidy") +```{r} +tidyr::gather(wide, key = "person", value = "sales", -year) ``` -![](images/static/png/original-dfs-tidy.png) +### Spread + +> Spread a key-value pair across multiple columns. Use it when an a column contains observations from multiple variables. + +```{r spread} +animate_spread(long, key = "person", value = "sales") +``` -```{r echo=TRUE} -wide -long +```{r} +tidyr::spread(long, key = "person", value = "sales") ``` -### Spread and Gather -`spread(data, key, value)` +## Learn More -> Spread a key-value pair across multiple columns. -> Use it when an a column contains observations from multiple variables. +### Relational Data -`gather(data, key = "key", value = "value", ...)` +The [Relational Data](http://r4ds.had.co.nz/relation-data.html) chapter of the +[R for Data Science](http://r4ds.had.co.nz/) book by Garrett Grolemund and Hadley Wickham +is an excellent resource for learning more about relational data. -> 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. +The [dplyr two-table verbs vignette][dplyr-two-table] +and Jenny Bryan's [Cheatsheet for dplyr join functions](http://stat545.com/bit001_dplyr-cheatsheet.html) +are also great resources. -![](images/tidyr-spread-gather.gif) +### gganimate -```{r echo=TRUE} -gather(wide, key, val, x:z) -spread(long, key, val) -``` +The animations were made possible by the newly re-written [gganimate] package by +[Thomas Lin Pedersen](https://github.com/thomasp85) +(original by [Dave Robinson](https://github.com/dgrtwo)). +The [package readme][gganimate] provides an excellent (and quick) introduction to gganimte. diff --git a/README.md b/README.md index 24c6c21..a2cf4c3 100644 --- a/README.md +++ b/README.md @@ -4,38 +4,35 @@ # Tidy Animated Verbs Garrick Aden-Buie – [@grrrck](https://twitter.com/grrrck) – -[garrickadenbuie.com](https://www.garrickadenbuie.com). Set operations -contributed by [Tyler Grant +[garrickadenbuie.com](https://www.garrickadenbuie.com). + +David Zimmermann – [@dav\_zim](https://twitter.com/dav_zim) – +[datashenanigan.wordpress.com](https://datashenanigan.wordpress.com/) + +Set operations contributed by [Tyler Grant Smith](https://github.com/TylerGrantSmith). [![Binder](http://mybinder.org/badge.svg)](https://mybinder.org/v2/gh/gadenbuie/tidy-animated-verbs/master?urlpath=rstudio) [![CC0](https://img.shields.io/badge/license_\(images\)_-CC0-green.svg)](https://creativecommons.org/publicdomain/zero/1.0/) [![MIT](https://img.shields.io/badge/license_\(code\)_-MIT-green.svg)](https://opensource.org/licenses/MIT) - - [**Mutating Joins**](#mutating-joins) — - [`inner_join()`](#inner-join), [`left_join()`](#left-join), - [`right_join()`](#right-join), [`full_join()`](#full-join) + - Mutating Joins: [`inner_join()`](#inner-join), + [`left_join()`](#left-join), [`right_join()`](#right-join), + [`full_join()`](#full-join) - - [**Filtering Joins**](#filtering-joins) — - [`semi_join()`](#semi-join), [`anti_join()`](#anti-join) + - Filtering Joins: [`semi_join()`](#semi-join), + [`anti_join()`](#anti-join) - - [**Set Operations**](#set-operations) — [`union()`](#union), - [`union_all()`](#union-all), [`intersect()`](#intersect), - [`setdiff()`](#setdiff) + - Set Operations: [`union()`](#union), [`union_all()`](#union-all), + [`intersect()`](#intersect), [`setdiff()`](#setdiff) - - [**Tidy Data**](#tidy-data) — [`spread()` and - `gather()`](#spread-and-gather) + - Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) - Learn more about - - [Using the animations and images](#usage) - [Relational Data](#relational-data) - [gganimate](#gganimate) -## Background - -### Usage - Please feel free to use these images for teaching or learning about action verbs from the [tidyverse](https://tidyverse.org). You can directly download the [original animations](images/) or static images in @@ -48,37 +45,35 @@ to expand the animations to include more verbs from the tidyverse. [Suggestions are welcome\!](https://github.com/gadenbuie/tidy-animated-verbs/issues) -### Relational Data +## Installing -The [Relational Data](http://r4ds.had.co.nz/relational-data.html) -chapter of the [R for Data Science](http://r4ds.had.co.nz/) book by -Garrett Grolemund and Hadley Wickham is an excellent resource for -learning more about relational data. +The in-development version of `tidyexplain` can be installed with +`devtools`: -The [dplyr two-table verbs -vignette](https://dplyr.tidyverse.org/articles/two-table.html) and Jenny -Bryan’s [Cheatsheet for dplyr join -functions](http://stat545.com/bit001_dplyr-cheatsheet.html) are also -great resources. - -### gganimate +``` r +# install.package("devtools") +devtools::install_github("gadenbuie/tidy-animated-verbs") -The animations were made possible by the newly re-written -[gganimate](https://github.com/thomasp85/gganimate#README) package by -[Thomas Lin Pedersen](https://github.com/thomasp85) (original by [Dave -Robinson](https://github.com/dgrtwo)). The [package -readme](https://github.com/thomasp85/gganimate#README) provides an -excellent (and quick) introduction to gganimte. +library(tidyexplain) +``` ## Mutating Joins -> A mutating join allows you to combine variables from two tables. It -> first matches observations by their keys, then copies across variables -> from one table to the other. -> [R for Data Science: Mutating -> joins](http://r4ds.had.co.nz/relational-data.html#mutating-joins) +``` r +x <- dplyr::data_frame( + id = 1:3, + x = paste0("x", 1:3) +) + +y <- dplyr::data_frame( + id = (1:4)[-3], + y = paste0("y", (1:4)[-3]) +) - +animate_full_join(x, y, by = c("id"), export = "first") +``` + +![](man/figures/tidyexplain-intial-dfs-1.png) ``` r x @@ -102,10 +97,14 @@ y > All rows from `x` where there are matching values in `y`, and all > columns from `x` and `y`. -![](images/inner-join.gif) +``` r +animate_inner_join(x, y, by = "id") +``` + +![](man/figures/tidyexplain-inner-join-1.gif) ``` r -inner_join(x, y, by = "id") +dplyr::inner_join(x, y, by = "id") #> # A tibble: 2 x 3 #> id x y #> @@ -118,10 +117,14 @@ inner_join(x, y, by = "id") > 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. -![](images/left-join.gif) +``` r +animate_left_join(x, y, by = "id") +``` + +![](man/figures/tidyexplain-left-join-1.gif) ``` r -left_join(x, y, by = "id") +dplyr::left_join(x, y, by = "id") #> # A tibble: 3 x 3 #> id x y #> @@ -135,9 +138,8 @@ left_join(x, y, by = "id") > … If there are multiple matches between `x` and `y`, all combinations > of the matches are returned. -![](images/left-join-extra.gif) - ``` r +y_extra <- dplyr::bind_rows(y, dplyr::data_frame(id = 2, y = "y5")) y_extra # has multiple rows with the key from `x` #> # A tibble: 4 x 2 #> id y @@ -146,7 +148,14 @@ y_extra # has multiple rows with the key from `x` #> 2 2 y2 #> 3 4 y4 #> 4 2 y5 -left_join(x, y_extra, by = "id") + +animate_left_join(x, y_extra, by = "id", title_size = 22) +``` + +![](man/figures/tidyexplain-left-join-extra-1.gif) + +``` r +dplyr::left_join(x, y_extra, by = "id") #> # A tibble: 4 x 3 #> id x y #> @@ -161,10 +170,14 @@ left_join(x, y_extra, by = "id") > 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. -![](images/right-join.gif) +``` r +animate_right_join(x, y, by = "id") +``` + +![](man/figures/tidyexplain-right-join-1.gif) ``` r -right_join(x, y, by = "id") +dplyr::right_join(x, y, by = "id") #> # A tibble: 3 x 3 #> id x y #> @@ -178,10 +191,14 @@ right_join(x, y, by = "id") > All rows and all columns from both `x` and `y`. Where there are not > matching values, returns `NA` for the one missing. -![](images/full-join.gif) +``` r +animate_full_join(x, y, by = "id") +``` + +![](man/figures/tidyexplain-full-join-1.gif) ``` r -full_join(x, y, by = "id") +dplyr::full_join(x, y, by = "id") #> # A tibble: 4 x 3 #> id x y #> @@ -193,22 +210,19 @@ full_join(x, y, by = "id") ## Filtering Joins -> Filtering joins match observations in the same way as mutating joins, -> but affect the observations, not the variables. … Semi-joins are -> useful for matching filtered summary tables back to the original rows. -> … Anti-joins are useful for diagnosing join mismatches. -> [R for Data Science: Filtering -> Joins](http://r4ds.had.co.nz/relational-data.html#filtering-joins) - ### Semi Join > All rows from `x` where there are matching values in `y`, keeping just > columns from `x`. -![](images/semi-join.gif) +``` r +animate_semi_join(x, y, by = "id") +``` + +![](man/figures/tidyexplain-semi-join-1.gif) ``` r -semi_join(x, y, by = "id") +dplyr::semi_join(x, y, by = "id") #> # A tibble: 2 x 2 #> id x #> @@ -221,10 +235,14 @@ semi_join(x, y, by = "id") > All rows from `x` where there are not matching values in `y`, keeping > just columns from `x`. -![](images/anti-join.gif) +``` r +animate_anti_join(x, y, by = "id") +``` + +![](man/figures/tidyexplain-anti-join-1.gif) ``` r -anti_join(x, y, by = "id") +dplyr::anti_join(x, y, by = "id") #> # A tibble: 1 x 2 #> id x #> @@ -233,92 +251,114 @@ anti_join(x, y, by = "id") ## Set Operations -> Set operations are occasionally useful when you want to break a single -> complex filter into simpler pieces. All these operations work with a -> complete row, comparing the values of every variable. These expect the -> x and y inputs to have the same variables, and treat the observations -> like sets. -> [R for Data Science: Set -> operations](http://r4ds.had.co.nz/relational-data.html#set-operations) +``` r +x <- dplyr::data_frame( + x = c(1, 1, 2), + y = c("a", "b", "a") +) +y <- dplyr::data_frame( + x = c(1, 2), + y = c("a", "b") +) + +animate_union(x, y, export = "first") +``` - +![](man/figures/tidyexplain-intial-dfs-so-1.png) ``` r x #> # A tibble: 3 x 2 -#> x y -#> -#> 1 1 a -#> 2 1 b -#> 3 2 a +#> x y +#> +#> 1 1 a +#> 2 1 b +#> 3 2 a y #> # A tibble: 2 x 2 -#> x y -#> -#> 1 1 a -#> 2 2 b +#> x y +#> +#> 1 1 a +#> 2 2 b ``` ### Union > All unique rows from `x` and `y`. -![](images/union.gif) +``` r +animate_union(x, y) +``` + +![](man/figures/tidyexplain-union-1.gif) ``` r -union(x, y) +dplyr::union(x, y) #> # A tibble: 4 x 2 -#> x y -#> -#> 1 2 b -#> 2 2 a -#> 3 1 b -#> 4 1 a +#> x y +#> +#> 1 2 b +#> 2 2 a +#> 3 1 b +#> 4 1 a +``` + +``` r +animate_union(y, x) ``` -![](images/union-rev.gif) +![](man/figures/tidyexplain-union-y-x-1.gif) ``` r -union(y, x) + +dplyr::union(y, x) #> # A tibble: 4 x 2 -#> x y -#> -#> 1 2 a -#> 2 1 b -#> 3 2 b -#> 4 1 a +#> x y +#> +#> 1 2 a +#> 2 1 b +#> 3 2 b +#> 4 1 a ``` ### Union All > All rows from `x` and `y`, keeping duplicates. -![](images/union-all.gif) +``` r +animate_union_all(x, y) +``` + +![](man/figures/tidyexplain-union-all-1.gif) ``` r -union_all(x, y) +dplyr::union_all(x, y) #> # A tibble: 5 x 2 -#> x y -#> -#> 1 1 a -#> 2 1 b -#> 3 2 a -#> 4 1 a -#> 5 2 b +#> x y +#> +#> 1 1 a +#> 2 1 b +#> 3 2 a +#> 4 1 a +#> 5 2 b ``` ### Intersection > Common rows in both `x` and `y`, keeping just unique rows. -![](images/intersect.gif) +``` r +animate_intersect(x, y) +``` + +![](man/figures/tidyexplain-intersect-1.gif) ``` r -intersect(x, y) +dplyr::intersect(x, y) #> # A tibble: 1 x 2 -#> x y -#> -#> 1 1 a +#> x y +#> +#> 1 1 a ``` ### Set Difference @@ -326,28 +366,37 @@ intersect(x, y) > All rows from `x` which are not also rows in `y`, keeping just unique > rows. -![](images/setdiff.gif) +``` r +animate_setdiff(x, y) +``` + +![](man/figures/tidyexplain-setdiff-1.gif) ``` r -setdiff(x, y) +dplyr::setdiff(x, y) #> # A tibble: 2 x 2 -#> x y -#> -#> 1 1 b -#> 2 2 a +#> x y +#> +#> 1 1 b +#> 2 2 a ``` -![](images/setdiff-rev.gif) +``` r +animate_setdiff(y, x) +``` + +![](man/figures/tidyexplain-setdiff-y-x-1.gif) ``` r -setdiff(y, x) + +dplyr::setdiff(y, x) #> # A tibble: 1 x 2 -#> x y -#> -#> 1 2 b +#> x y +#> +#> 1 2 b ``` -## Tidy Data +## Tidy Data and `gather()`, `spread()` functionality [Tidy data](http://r4ds.had.co.nz/tidy-data.html#tidy-data-1) follows the following three rules: @@ -361,58 +410,88 @@ to be formatted as a tidy dataset and the [tidyr](https://tidyr.tidyverse.org) package provides functions to help you organize your data into tidy data. -![](images/static/png/original-dfs-tidy.png) +``` r +long <- dplyr::data_frame( + year = c(2010, 2011, 2010, 2011, 2010, 2011), + person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), + sales = c(105, 110, 100, 97, 90, 95) +) +wide <- dplyr::data_frame( + year = 2010:2011, + Alice = c(105, 110), + Bob = c(100, 97), + Charlie = c(90, 95) +) +``` + +### 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. ``` r -wide -#> # A tibble: 2 x 4 -#> id x y z -#> -#> 1 1 a c e -#> 2 2 b d f -long -#> # A tibble: 6 x 3 -#> id key val -#> -#> 1 1 x a -#> 2 2 x b -#> 3 1 y c -#> 4 2 y d -#> 5 1 z e -#> 6 2 z f +set_font_size(4, 15) +set_anim_options(anim_options(cell_width = 2)) +animate_gather(wide, key = "person", value = "sales", -year) ``` -### Spread and Gather +![](man/figures/tidyexplain-gather-1.gif) -`spread(data, key, value)` +``` r +tidyr::gather(wide, key = "person", value = "sales", -year) +#> # A tibble: 6 x 3 +#> year person sales +#> +#> 1 2010 Alice 105 +#> 2 2011 Alice 110 +#> 3 2010 Bob 100 +#> 4 2011 Bob 97 +#> 5 2010 Charlie 90 +#> 6 2011 Charlie 95 +``` + +### Spread > Spread a key-value pair across multiple columns. Use it when an a > column contains observations from multiple variables. -`gather(data, key = "key", value = "value", ...)` - -> 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 +animate_spread(long, key = "person", value = "sales") +``` -![](images/tidyr-spread-gather.gif) +![](man/figures/tidyexplain-spread-1.gif) ``` r -gather(wide, key, val, x:z) -#> # A tibble: 6 x 3 -#> id key val -#> -#> 1 1 x a -#> 2 2 x b -#> 3 1 y c -#> 4 2 y d -#> 5 1 z e -#> 6 2 z f -spread(long, key, val) +tidyr::spread(long, key = "person", value = "sales") #> # A tibble: 2 x 4 -#> id x y z -#> -#> 1 1 a c e -#> 2 2 b d f +#> year Alice Bob Charlie +#> +#> 1 2010 105 100 90 +#> 2 2011 110 97 95 ``` + +## Learn More + +### Relational Data + +The [Relational Data](http://r4ds.had.co.nz/relation-data.html) chapter +of the [R for Data Science](http://r4ds.had.co.nz/) book by Garrett +Grolemund and Hadley Wickham is an excellent resource for learning more +about relational data. + +The [dplyr two-table verbs +vignette](https://dplyr.tidyverse.org/articles/two-table.html) and Jenny +Bryan’s [Cheatsheet for dplyr join +functions](http://stat545.com/bit001_dplyr-cheatsheet.html) are also +great resources. + +### gganimate + +The animations were made possible by the newly re-written +[gganimate](https://github.com/thomasp85/gganimate#README) package by +[Thomas Lin Pedersen](https://github.com/thomasp85) (original by [Dave +Robinson](https://github.com/dgrtwo)). The [package +readme](https://github.com/thomasp85/gganimate#README) provides an +excellent (and quick) introduction to gganimte. diff --git a/images/anti-join.gif b/images/anti-join.gif deleted file mode 100644 index 5d2977a..0000000 Binary files a/images/anti-join.gif and /dev/null differ diff --git a/images/create_images.R b/images/create_images.R new file mode 100644 index 0000000..e8f3f2f --- /dev/null +++ b/images/create_images.R @@ -0,0 +1,160 @@ +library(tidyexplain) +library(here) +library(stringr) +set_font_size(title_size = 20) + +check_and_create <- function(ff) { + if (!dir.exists(ff)) dir.create(ff, recursive = T) +} + +check_and_create(here("images", "static", "png")) +check_and_create(here("images", "static", "svg")) +check_and_create(here("images", "gif")) + +### Animate Joins + +x <- dplyr::data_frame( + id = 1:3, + x = paste0("x", 1:3) +) + +y <- dplyr::data_frame( + id = (1:4)[-3], + y = paste0("y", (1:4)[-3]) +) + +joins <- c( + full_join = animate_full_join, + inner_join = animate_inner_join, + left_join = animate_left_join, + right_join = animate_right_join, + semi_join = animate_semi_join +) + +a <- sapply(1:length(joins), function(i) { + nam <- names(joins)[i] + nam <- str_replace(nam, "_", "-") + cat(nam, "\n") + + width <- 7 + height <- 7 + + gif_ <- joins[[i]](x, y, by = "id") + first_ <- joins[[i]](x, y, by = "id", export = "first") + last_ <- joins[[i]](x, y, by = "id", export = "last") + + save_animation(animate(gif_), here("images", "gif", paste0(nam, ".gif"))) + ggsave(here("images", "static", "png", paste0(nam, "-first.png")), first_, + height = height, width = width) + ggsave(here("images", "static", "svg", paste0(nam, "-first.svg")), first_, + height = height, width = width) + ggsave(here("images", "static", "png", paste0(nam, "-last.png")), last_, + height = height, width = width) + ggsave(here("images", "static", "svg", paste0(nam, "-last.svg")), last_, + height = height, width = width) +}) + +### Animate Sets + +x <- tibble::tribble( + ~x, ~y, + "1", "a", + "1", "b", + "2", "a" +) + +y <- tibble::tribble( + ~x, ~y, + "1", "a", + "2", "b" +) + +sets <- c( + union = animate_union, + union_all = animate_union_all, + intersect = animate_intersect, + setdiff = animate_setdiff +) + +a <- sapply(1:length(sets), function(i) { + nam <- names(sets)[i] + nam <- str_replace(nam, "_", "-") + + cat(nam, "\n") + + width <- 7 + height <- 7 + + gif_ <- sets[[i]](x, y) + first_ <- sets[[i]](x, y, export = "first") + last_ <- sets[[i]](x, y, export = "last") + + save_animation(animate(gif_), here("images", "gif", paste0(nam, ".gif"))) + ggsave(here("images", "static", "png", paste0(nam, "-first.png")), first_, + height = height, width = width) + ggsave(here("images", "static", "svg", paste0(nam, "-first.svg")), first_, + height = height, width = width) + ggsave(here("images", "static", "png", paste0(nam, "-last.png")), last_, + height = height, width = width) + ggsave(here("images", "static", "svg", paste0(nam, "-last.svg")), last_, + height = height, width = width) +}) + + +### Animate Gather Spread +set_font_size(text_size = 4) +set_anim_options(anim_options(cell_width = 2)) + +# Gather +wide <- dplyr::data_frame( + year = 2010:2011, + Alice = c(105, 110), + Bob = c(100, 97), + Charlie = c(90, 95) +) + +nam <- "gather" +cat(nam, "\n") + +width <- 7 +height <- 7 + +gif_ <- animate_gather(wide, key = "person", value = "sales", -year, cell_width = 2) +first_ <- animate_gather(wide, key = "person", value = "sales", -year, export = "first") +last_ <- animate_gather(wide, key = "person", value = "sales", -year, export = "last") + +save_animation(animate(gif_), here("images", "gif", paste0(nam, ".gif"))) +ggsave(here("images", "static", "png", paste0(nam, "-first.png")), first_, + height = height, width = width) +ggsave(here("images", "static", "svg", paste0(nam, "-first.svg")), first_, + height = height, width = width) +ggsave(here("images", "static", "png", paste0(nam, "-last.png")), last_, + height = height, width = width) +ggsave(here("images", "static", "svg", paste0(nam, "-last.svg")), last_, + height = height, width = width) + +# Spread +long <- dplyr::data_frame( + year = c(2010, 2011, 2010, 2011, 2010, 2011), + person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), + sales = c(105, 110, 100, 97, 90, 95) +) +nam <- "spread" +cat(nam, "\n") + +width <- 7 +height <- 7 + +gif_ <- animate_spread(long, key = "person", value = "sales") +first_ <- animate_spread(long, key = "person", value = "sales", export = "first") +last_ <- animate_spread(long, key = "person", value = "sales", export = "last") + +save_animation(animate(gif_), here("images", "gif", paste0(nam, ".gif"))) +ggsave(here("images", "static", "png", paste0(nam, "-first.png")), first_, + height = height, width = width) +ggsave(here("images", "static", "svg", paste0(nam, "-first.svg")), first_, + height = height, width = width) +ggsave(here("images", "static", "png", paste0(nam, "-last.png")), last_, + height = height, width = width) +ggsave(here("images", "static", "svg", paste0(nam, "-last.svg")), last_, + height = height, width = width) diff --git a/images/full-join.gif b/images/full-join.gif deleted file mode 100644 index d5e048a..0000000 Binary files a/images/full-join.gif and /dev/null differ diff --git a/images/gif/full-join.gif b/images/gif/full-join.gif new file mode 100644 index 0000000..082346a Binary files /dev/null and b/images/gif/full-join.gif differ diff --git a/images/gif/gather.gif b/images/gif/gather.gif new file mode 100644 index 0000000..73e49d0 Binary files /dev/null and b/images/gif/gather.gif differ diff --git a/images/gif/inner-join.gif b/images/gif/inner-join.gif new file mode 100644 index 0000000..cd6a5cb Binary files /dev/null and b/images/gif/inner-join.gif differ diff --git a/images/gif/intersect.gif b/images/gif/intersect.gif new file mode 100644 index 0000000..eb113e6 Binary files /dev/null and b/images/gif/intersect.gif differ diff --git a/images/gif/left-join.gif b/images/gif/left-join.gif new file mode 100644 index 0000000..dd84858 Binary files /dev/null and b/images/gif/left-join.gif differ diff --git a/images/gif/right-join.gif b/images/gif/right-join.gif new file mode 100644 index 0000000..998a5cd Binary files /dev/null and b/images/gif/right-join.gif differ diff --git a/images/gif/semi-join.gif b/images/gif/semi-join.gif new file mode 100644 index 0000000..12eec44 Binary files /dev/null and b/images/gif/semi-join.gif differ diff --git a/images/gif/setdiff.gif b/images/gif/setdiff.gif new file mode 100644 index 0000000..019f9c9 Binary files /dev/null and b/images/gif/setdiff.gif differ diff --git a/images/gif/spread.gif b/images/gif/spread.gif new file mode 100644 index 0000000..a28791c Binary files /dev/null and b/images/gif/spread.gif differ diff --git a/images/gif/union-all.gif b/images/gif/union-all.gif new file mode 100644 index 0000000..33c30d5 Binary files /dev/null and b/images/gif/union-all.gif differ diff --git a/images/gif/union.gif b/images/gif/union.gif new file mode 100644 index 0000000..0149d7a Binary files /dev/null and b/images/gif/union.gif differ diff --git a/images/inner-join.gif b/images/inner-join.gif deleted file mode 100644 index 0e2d8f8..0000000 Binary files a/images/inner-join.gif and /dev/null differ diff --git a/images/intersect.gif b/images/intersect.gif deleted file mode 100644 index 707871d..0000000 Binary files a/images/intersect.gif and /dev/null differ diff --git a/images/left-join-extra.gif b/images/left-join-extra.gif deleted file mode 100644 index 28e2b1f..0000000 Binary files a/images/left-join-extra.gif and /dev/null differ diff --git a/images/left-join.gif b/images/left-join.gif deleted file mode 100644 index 96f655e..0000000 Binary files a/images/left-join.gif and /dev/null differ diff --git a/images/right-join.gif b/images/right-join.gif deleted file mode 100644 index 0ba7440..0000000 Binary files a/images/right-join.gif and /dev/null differ diff --git a/images/semi-join.gif b/images/semi-join.gif deleted file mode 100644 index 6d2bbda..0000000 Binary files a/images/semi-join.gif and /dev/null differ diff --git a/images/setdiff-rev.gif b/images/setdiff-rev.gif deleted file mode 100644 index b2e8e57..0000000 Binary files a/images/setdiff-rev.gif and /dev/null differ diff --git a/images/setdiff.gif b/images/setdiff.gif deleted file mode 100644 index 7d169c6..0000000 Binary files a/images/setdiff.gif and /dev/null differ diff --git a/images/static/png/anti-join.png b/images/static/png/anti-join.png deleted file mode 100644 index 766a0c3..0000000 Binary files a/images/static/png/anti-join.png and /dev/null differ diff --git a/images/static/png/full-join-first.png b/images/static/png/full-join-first.png new file mode 100644 index 0000000..e709bb3 Binary files /dev/null and b/images/static/png/full-join-first.png differ diff --git a/images/static/png/full-join-last.png b/images/static/png/full-join-last.png new file mode 100644 index 0000000..1481816 Binary files /dev/null and b/images/static/png/full-join-last.png differ diff --git a/images/static/png/full-join.png b/images/static/png/full-join.png deleted file mode 100644 index f43c1b0..0000000 Binary files a/images/static/png/full-join.png and /dev/null differ diff --git a/images/static/png/gather-first.png b/images/static/png/gather-first.png new file mode 100644 index 0000000..44b7aed Binary files /dev/null and b/images/static/png/gather-first.png differ diff --git a/images/static/png/gather-last.png b/images/static/png/gather-last.png new file mode 100644 index 0000000..c1208d1 Binary files /dev/null and b/images/static/png/gather-last.png differ diff --git a/images/static/png/inner-join-first.png b/images/static/png/inner-join-first.png new file mode 100644 index 0000000..e709bb3 Binary files /dev/null and b/images/static/png/inner-join-first.png differ diff --git a/images/static/png/inner-join-last.png b/images/static/png/inner-join-last.png new file mode 100644 index 0000000..dc19770 Binary files /dev/null and b/images/static/png/inner-join-last.png differ diff --git a/images/static/png/inner-join.png b/images/static/png/inner-join.png deleted file mode 100644 index edda4c2..0000000 Binary files a/images/static/png/inner-join.png and /dev/null differ diff --git a/images/static/png/intersect-first.png b/images/static/png/intersect-first.png new file mode 100644 index 0000000..3cddadb Binary files /dev/null and b/images/static/png/intersect-first.png differ diff --git a/images/static/png/intersect-last.png b/images/static/png/intersect-last.png new file mode 100644 index 0000000..99a1a42 Binary files /dev/null and b/images/static/png/intersect-last.png differ diff --git a/images/static/png/intersect.png b/images/static/png/intersect.png deleted file mode 100644 index 09afcac..0000000 Binary files a/images/static/png/intersect.png and /dev/null differ diff --git a/images/static/png/left-join-extra-input.png b/images/static/png/left-join-extra-input.png deleted file mode 100644 index 88a236b..0000000 Binary files a/images/static/png/left-join-extra-input.png and /dev/null differ diff --git a/images/static/png/left-join-extra.png b/images/static/png/left-join-extra.png deleted file mode 100644 index c882551..0000000 Binary files a/images/static/png/left-join-extra.png and /dev/null differ diff --git a/images/static/png/left-join-first.png b/images/static/png/left-join-first.png new file mode 100644 index 0000000..e709bb3 Binary files /dev/null and b/images/static/png/left-join-first.png differ diff --git a/images/static/png/left-join-last.png b/images/static/png/left-join-last.png new file mode 100644 index 0000000..a6ebcad Binary files /dev/null and b/images/static/png/left-join-last.png differ diff --git a/images/static/png/left-join.png b/images/static/png/left-join.png deleted file mode 100644 index cd42121..0000000 Binary files a/images/static/png/left-join.png and /dev/null differ diff --git a/images/static/png/original-dfs-set-ops.png b/images/static/png/original-dfs-set-ops.png deleted file mode 100644 index 9422ba4..0000000 Binary files a/images/static/png/original-dfs-set-ops.png and /dev/null differ diff --git a/images/static/png/original-dfs-tidy.png b/images/static/png/original-dfs-tidy.png deleted file mode 100644 index 44b663e..0000000 Binary files a/images/static/png/original-dfs-tidy.png and /dev/null differ diff --git a/images/static/png/original-dfs.png b/images/static/png/original-dfs.png deleted file mode 100644 index 8d366f3..0000000 Binary files a/images/static/png/original-dfs.png and /dev/null differ diff --git a/images/static/png/right-join-first.png b/images/static/png/right-join-first.png new file mode 100644 index 0000000..e709bb3 Binary files /dev/null and b/images/static/png/right-join-first.png differ diff --git a/images/static/png/right-join-last.png b/images/static/png/right-join-last.png new file mode 100644 index 0000000..47ff60c Binary files /dev/null and b/images/static/png/right-join-last.png differ diff --git a/images/static/png/right-join.png b/images/static/png/right-join.png deleted file mode 100644 index 2b9d7a0..0000000 Binary files a/images/static/png/right-join.png and /dev/null differ diff --git a/images/static/png/semi-join-first.png b/images/static/png/semi-join-first.png new file mode 100644 index 0000000..e709bb3 Binary files /dev/null and b/images/static/png/semi-join-first.png differ diff --git a/images/static/png/semi-join-last.png b/images/static/png/semi-join-last.png new file mode 100644 index 0000000..6dc0cbe Binary files /dev/null and b/images/static/png/semi-join-last.png differ diff --git a/images/static/png/semi-join.png b/images/static/png/semi-join.png deleted file mode 100644 index bd635d3..0000000 Binary files a/images/static/png/semi-join.png and /dev/null differ diff --git a/images/static/png/setdiff-first.png b/images/static/png/setdiff-first.png new file mode 100644 index 0000000..3cddadb Binary files /dev/null and b/images/static/png/setdiff-first.png differ diff --git a/images/static/png/setdiff-last.png b/images/static/png/setdiff-last.png new file mode 100644 index 0000000..8a95a54 Binary files /dev/null and b/images/static/png/setdiff-last.png differ diff --git a/images/static/png/setdiff-rev.png b/images/static/png/setdiff-rev.png deleted file mode 100644 index bc232ef..0000000 Binary files a/images/static/png/setdiff-rev.png and /dev/null differ diff --git a/images/static/png/setdiff.png b/images/static/png/setdiff.png deleted file mode 100644 index efc9875..0000000 Binary files a/images/static/png/setdiff.png and /dev/null differ diff --git a/images/static/png/spread-first.png b/images/static/png/spread-first.png new file mode 100644 index 0000000..c1208d1 Binary files /dev/null and b/images/static/png/spread-first.png differ diff --git a/images/static/png/spread-last.png b/images/static/png/spread-last.png new file mode 100644 index 0000000..44b7aed Binary files /dev/null and b/images/static/png/spread-last.png differ diff --git a/images/static/png/tidyr-gather.png b/images/static/png/tidyr-gather.png deleted file mode 100644 index f0aad4f..0000000 Binary files a/images/static/png/tidyr-gather.png and /dev/null differ diff --git a/images/static/png/tidyr-spread.png b/images/static/png/tidyr-spread.png deleted file mode 100644 index b6760f7..0000000 Binary files a/images/static/png/tidyr-spread.png and /dev/null differ diff --git a/images/static/png/union-all-first.png b/images/static/png/union-all-first.png new file mode 100644 index 0000000..3cddadb Binary files /dev/null and b/images/static/png/union-all-first.png differ diff --git a/images/static/png/union-all-last.png b/images/static/png/union-all-last.png new file mode 100644 index 0000000..6f442cf Binary files /dev/null and b/images/static/png/union-all-last.png differ diff --git a/images/static/png/union-all.png b/images/static/png/union-all.png deleted file mode 100644 index 8bb4a49..0000000 Binary files a/images/static/png/union-all.png and /dev/null differ diff --git a/images/static/png/union-first.png b/images/static/png/union-first.png new file mode 100644 index 0000000..3cddadb Binary files /dev/null and b/images/static/png/union-first.png differ diff --git a/images/static/png/union-last.png b/images/static/png/union-last.png new file mode 100644 index 0000000..627d500 Binary files /dev/null and b/images/static/png/union-last.png differ diff --git a/images/static/png/union-rev.png b/images/static/png/union-rev.png deleted file mode 100644 index 835c401..0000000 Binary files a/images/static/png/union-rev.png and /dev/null differ diff --git a/images/static/png/union.png b/images/static/png/union.png deleted file mode 100644 index 9466802..0000000 Binary files a/images/static/png/union.png and /dev/null differ diff --git a/images/static/svg/anti-join.svg b/images/static/svg/anti-join.svg deleted file mode 100644 index 65c3ae3..0000000 --- a/images/static/svg/anti-join.svg +++ /dev/null @@ -1,44 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/full-join-first.svg b/images/static/svg/full-join-first.svg new file mode 100644 index 0000000..d99a448 --- /dev/null +++ b/images/static/svg/full-join-first.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +id +x +1 +2 +3 +x1 +x2 +x3 +id +y +1 +2 +4 +y1 +y2 +y4 + + + + + + diff --git a/images/static/svg/full-join-last.svg b/images/static/svg/full-join-last.svg new file mode 100644 index 0000000..38f0b83 --- /dev/null +++ b/images/static/svg/full-join-last.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +id +x +1 +2 +3 +x1 +x2 +x3 +id +y +1 +2 +4 +y1 +y2 +y4 + + + + + +full_join(x, y, by = "id") + diff --git a/images/static/svg/full-join.svg b/images/static/svg/full-join.svg deleted file mode 100644 index a30af8d..0000000 --- a/images/static/svg/full-join.svg +++ /dev/null @@ -1,67 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/gather-first.svg b/images/static/svg/gather-first.svg new file mode 100644 index 0000000..4779e8a --- /dev/null +++ b/images/static/svg/gather-first.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +year +year +year +Alice +Alice +Bob +Bob +Charlie +Charlie +2010 +2010 +2010 +2011 +2011 +2011 +105 +110 +100 +97 +90 +95 + + + + + + diff --git a/images/static/svg/gather-last.svg b/images/static/svg/gather-last.svg new file mode 100644 index 0000000..8cc7595 --- /dev/null +++ b/images/static/svg/gather-last.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +year +year +year +person +sales +2010 +2011 +2010 +2011 +2010 +2011 +Alice +Alice +Bob +Bob +Charlie +Charlie +105 +110 +100 +97 +90 +95 + + + + + + diff --git a/images/static/svg/inner-join-first.svg b/images/static/svg/inner-join-first.svg new file mode 100644 index 0000000..d99a448 --- /dev/null +++ b/images/static/svg/inner-join-first.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +id +x +1 +2 +3 +x1 +x2 +x3 +id +y +1 +2 +4 +y1 +y2 +y4 + + + + + + diff --git a/images/static/svg/inner-join-last.svg b/images/static/svg/inner-join-last.svg new file mode 100644 index 0000000..0355385 --- /dev/null +++ b/images/static/svg/inner-join-last.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +id +x +1 +2 +x1 +x2 +id +y +1 +2 +y1 +y2 +3 +x3 +4 +y4 + + + + + +inner_join(x, y, by = "id") + diff --git a/images/static/svg/inner-join.svg b/images/static/svg/inner-join.svg deleted file mode 100644 index 5bf9406..0000000 --- a/images/static/svg/inner-join.svg +++ /dev/null @@ -1,56 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/intersect-first.svg b/images/static/svg/intersect-first.svg new file mode 100644 index 0000000..72becc3 --- /dev/null +++ b/images/static/svg/intersect-first.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +x +y +1 +1 +2 +a +b +a +x +y +1 +2 +a +b + + + + + + diff --git a/images/static/svg/intersect-last.svg b/images/static/svg/intersect-last.svg new file mode 100644 index 0000000..a63fe96 --- /dev/null +++ b/images/static/svg/intersect-last.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +x +y +1 +a +x +y +1 +a +1 +2 +b +a +2 +b + + + + + +intersect(x, y) + diff --git a/images/static/svg/intersect.svg b/images/static/svg/intersect.svg deleted file mode 100644 index a2a47fe..0000000 --- a/images/static/svg/intersect.svg +++ /dev/null @@ -1,43 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/left-join-extra-input.svg b/images/static/svg/left-join-extra-input.svg deleted file mode 100644 index 30d9078..0000000 --- a/images/static/svg/left-join-extra-input.svg +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/left-join-extra.svg b/images/static/svg/left-join-extra.svg deleted file mode 100644 index 2c9c1e1..0000000 --- a/images/static/svg/left-join-extra.svg +++ /dev/null @@ -1,69 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/left-join-first.svg b/images/static/svg/left-join-first.svg new file mode 100644 index 0000000..d99a448 --- /dev/null +++ b/images/static/svg/left-join-first.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +id +x +1 +2 +3 +x1 +x2 +x3 +id +y +1 +2 +4 +y1 +y2 +y4 + + + + + + diff --git a/images/static/svg/left-join-last.svg b/images/static/svg/left-join-last.svg new file mode 100644 index 0000000..551fccb --- /dev/null +++ b/images/static/svg/left-join-last.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +id +x +1 +2 +3 +x1 +x2 +x3 +id +y +1 +2 +y1 +y2 +4 +y4 + + + + + +left_join(x, y, by = "id") + diff --git a/images/static/svg/left-join.svg b/images/static/svg/left-join.svg deleted file mode 100644 index cf6417d..0000000 --- a/images/static/svg/left-join.svg +++ /dev/null @@ -1,61 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/original-dfs-set-ops.svg b/images/static/svg/original-dfs-set-ops.svg deleted file mode 100644 index 6738292..0000000 --- a/images/static/svg/original-dfs-set-ops.svg +++ /dev/null @@ -1,47 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/original-dfs-tidy.svg b/images/static/svg/original-dfs-tidy.svg deleted file mode 100644 index 048f449..0000000 --- a/images/static/svg/original-dfs-tidy.svg +++ /dev/null @@ -1,115 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/original-dfs.svg b/images/static/svg/original-dfs.svg deleted file mode 100644 index 4ef93cf..0000000 --- a/images/static/svg/original-dfs.svg +++ /dev/null @@ -1,57 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/right-join-first.svg b/images/static/svg/right-join-first.svg new file mode 100644 index 0000000..d99a448 --- /dev/null +++ b/images/static/svg/right-join-first.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +id +x +1 +2 +3 +x1 +x2 +x3 +id +y +1 +2 +4 +y1 +y2 +y4 + + + + + + diff --git a/images/static/svg/right-join-last.svg b/images/static/svg/right-join-last.svg new file mode 100644 index 0000000..a41a397 --- /dev/null +++ b/images/static/svg/right-join-last.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +id +x +1 +2 +x1 +x2 +id +y +1 +2 +4 +y1 +y2 +y4 +3 +x3 + + + + + +right_join(x, y, by = "id") + diff --git a/images/static/svg/right-join.svg b/images/static/svg/right-join.svg deleted file mode 100644 index 443dc63..0000000 --- a/images/static/svg/right-join.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/semi-join-first.svg b/images/static/svg/semi-join-first.svg new file mode 100644 index 0000000..d99a448 --- /dev/null +++ b/images/static/svg/semi-join-first.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +id +x +1 +2 +3 +x1 +x2 +x3 +id +y +1 +2 +4 +y1 +y2 +y4 + + + + + + diff --git a/images/static/svg/semi-join-last.svg b/images/static/svg/semi-join-last.svg new file mode 100644 index 0000000..d50ac5b --- /dev/null +++ b/images/static/svg/semi-join-last.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +id +x +1 +2 +x1 +x2 +id +1 +2 +3 +x3 +y +4 +y4 +y1 +y2 + + + + + +semi_join(x, y, by = "id") + diff --git a/images/static/svg/semi-join.svg b/images/static/svg/semi-join.svg deleted file mode 100644 index 723e405..0000000 --- a/images/static/svg/semi-join.svg +++ /dev/null @@ -1,49 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/setdiff-first.svg b/images/static/svg/setdiff-first.svg new file mode 100644 index 0000000..72becc3 --- /dev/null +++ b/images/static/svg/setdiff-first.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +x +y +1 +1 +2 +a +b +a +x +y +1 +2 +a +b + + + + + + diff --git a/images/static/svg/setdiff-last.svg b/images/static/svg/setdiff-last.svg new file mode 100644 index 0000000..1965bb2 --- /dev/null +++ b/images/static/svg/setdiff-last.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +x +y +1 +2 +b +a +x +y +1 +a +1 +2 +a +b + + + + + +setdiff(x, y) + diff --git a/images/static/svg/setdiff-rev.svg b/images/static/svg/setdiff-rev.svg deleted file mode 100644 index 1334c8f..0000000 --- a/images/static/svg/setdiff-rev.svg +++ /dev/null @@ -1,45 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/setdiff.svg b/images/static/svg/setdiff.svg deleted file mode 100644 index f9b46dc..0000000 --- a/images/static/svg/setdiff.svg +++ /dev/null @@ -1,45 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/spread-first.svg b/images/static/svg/spread-first.svg new file mode 100644 index 0000000..8cc7595 --- /dev/null +++ b/images/static/svg/spread-first.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +year +year +year +person +sales +2010 +2011 +2010 +2011 +2010 +2011 +Alice +Alice +Bob +Bob +Charlie +Charlie +105 +110 +100 +97 +90 +95 + + + + + + diff --git a/images/static/svg/spread-last.svg b/images/static/svg/spread-last.svg new file mode 100644 index 0000000..4779e8a --- /dev/null +++ b/images/static/svg/spread-last.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +year +year +year +Alice +Alice +Bob +Bob +Charlie +Charlie +2010 +2010 +2010 +2011 +2011 +2011 +105 +110 +100 +97 +90 +95 + + + + + + diff --git a/images/static/svg/tidyr-gather.svg b/images/static/svg/tidyr-gather.svg deleted file mode 100644 index f1d5564..0000000 --- a/images/static/svg/tidyr-gather.svg +++ /dev/null @@ -1,103 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/tidyr-spread-gather.svg b/images/static/svg/tidyr-spread-gather.svg deleted file mode 100644 index 1e98091..0000000 --- a/images/static/svg/tidyr-spread-gather.svg +++ /dev/null @@ -1,179 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/tidyr-spread.svg b/images/static/svg/tidyr-spread.svg deleted file mode 100644 index 842af6e..0000000 --- a/images/static/svg/tidyr-spread.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/union-all-first.svg b/images/static/svg/union-all-first.svg new file mode 100644 index 0000000..72becc3 --- /dev/null +++ b/images/static/svg/union-all-first.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +x +y +1 +1 +2 +a +b +a +x +y +1 +2 +a +b + + + + + + diff --git a/images/static/svg/union-all-last.svg b/images/static/svg/union-all-last.svg new file mode 100644 index 0000000..9cb4272 --- /dev/null +++ b/images/static/svg/union-all-last.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +x +y +1 +1 +2 +a +b +a +x +y +1 +2 +a +b + + + + + +union_all(x, y) + diff --git a/images/static/svg/union-all.svg b/images/static/svg/union-all.svg deleted file mode 100644 index a26b9a4..0000000 --- a/images/static/svg/union-all.svg +++ /dev/null @@ -1,59 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/union-first.svg b/images/static/svg/union-first.svg new file mode 100644 index 0000000..72becc3 --- /dev/null +++ b/images/static/svg/union-first.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +x +y +1 +1 +2 +a +b +a +x +y +1 +2 +a +b + + + + + + diff --git a/images/static/svg/union-last.svg b/images/static/svg/union-last.svg new file mode 100644 index 0000000..1542222 --- /dev/null +++ b/images/static/svg/union-last.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +x +y +1 +1 +2 +a +b +a +x +y +1 +2 +a +b + + + + + +union(x, y) + diff --git a/images/static/svg/union-rev.svg b/images/static/svg/union-rev.svg deleted file mode 100644 index 6efe5e4..0000000 --- a/images/static/svg/union-rev.svg +++ /dev/null @@ -1,51 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/static/svg/union.svg b/images/static/svg/union.svg deleted file mode 100644 index 4817ccd..0000000 --- a/images/static/svg/union.svg +++ /dev/null @@ -1,51 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/images/tidyr-spread-gather.gif b/images/tidyr-spread-gather.gif deleted file mode 100644 index 52fa509..0000000 Binary files a/images/tidyr-spread-gather.gif and /dev/null differ diff --git a/images/union-all.gif b/images/union-all.gif deleted file mode 100644 index 363586c..0000000 Binary files a/images/union-all.gif and /dev/null differ diff --git a/images/union-rev.gif b/images/union-rev.gif deleted file mode 100644 index 34fbc82..0000000 Binary files a/images/union-rev.gif and /dev/null differ diff --git a/images/union.gif b/images/union.gif deleted file mode 100644 index cb1ec06..0000000 Binary files a/images/union.gif and /dev/null differ diff --git a/install.R b/install.R deleted file mode 100644 index d435aef..0000000 --- a/install.R +++ /dev/null @@ -1,7 +0,0 @@ -install.packages("tidyverse") -install.packages("rmarkdown") -install.packages("here") -install.packages(c("sysfonts", "jsonlite", "curl", "showtext")) -install.packages("cowplot") -install.packages("devtools") -devtools::install_github("thomasp85/gganimate") diff --git a/man/add_color_join.Rd b/man/add_color_join.Rd new file mode 100644 index 0000000..5470a56 --- /dev/null +++ b/man/add_color_join.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/process_data_helpers.R +\name{add_color_join} +\alias{add_color_join} +\title{Adds Color to a processed data_frame} +\usage{ +add_color_join(x, ids, by, ao, ...) +} +\arguments{ +\item{x}{a processed data_frame} + +\item{ids}{a vector of ids for the color-matching} + +\item{by}{a vector of column names that constitute the by-argument of joins/sets} + +\item{...}{} + +\item{color_header}{color for the header} + +\item{color_other}{color for "inactive" values} + +\item{color_missing}{color for missing values} + +\item{color_fun}{the function to generate the colors} + +\item{text_color}{the color for the text inside the tiles, +defaults to white/black depending on tile color} +} +\value{ +the processed data_frame with a new column .color +} +\description{ +Adds Color to a processed data_frame +} +\examples{ +NULL +} diff --git a/man/add_color_tidyr.Rd b/man/add_color_tidyr.Rd new file mode 100644 index 0000000..2e524e9 --- /dev/null +++ b/man/add_color_tidyr.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tidyr_helpers.R +\name{add_color_tidyr} +\alias{add_color_tidyr} +\title{Adds color to processed tidy data} +\usage{ +add_color_tidyr(x, key_values, color_fun = scales::brewer_pal(type = + "qual", "Set1"), color_header = "#737373", color_id = "#d0d0d0") +} +\arguments{ +\item{x}{a processed data-frame as outputted by process_long or process_wide} + +\item{key_values}{the unique key-values} + +\item{color_fun}{the color function} + +\item{color_header}{the color for the header} + +\item{...}{not used} +} +\value{ +a data-frame with the colors +} +\description{ +Adds color to processed tidy data +} +\examples{ +NULL +} diff --git a/man/anim_options.Rd b/man/anim_options.Rd new file mode 100644 index 0000000..4246920 --- /dev/null +++ b/man/anim_options.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/animate_options.R +\name{anim_options} +\alias{anim_options} +\alias{set_anim_options} +\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, color_header = NULL, + color_other = NULL, color_missing = NULL, color_fun = NULL, + text_color = NULL, cell_width = NULL, cell_height = NULL, ...) + +set_anim_options(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{color_header}{Color of the header row.} + +\item{color_other}{Color of the cells that are not highlighted otherwise.} + +\item{color_missing}{Color of the missing cells.} + +\item{color_fun}{A function that generates the colors for the highlighted +cells, default is \code{\link[scales:brewer_pal]{scales::brewer_pal()}} Set1.} + +\item{text_color}{Color of the text of the cells, default is a black or +white, based on the background color of the cell.} + +\item{cell_width}{Width of a cell, default is 1.} + +\item{cell_height}{Height of a cell, default is 1.} + +\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{set_anim_options}: Set default animation options for the current session. +}} + diff --git a/man/animate_gather.Rd b/man/animate_gather.Rd new file mode 100644 index 0000000..03027a2 --- /dev/null +++ b/man/animate_gather.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/animate_tidyr.R +\name{animate_gather} +\alias{animate_gather} +\title{Animates the gather function} +\usage{ +animate_gather(w, key, value, ..., export = "gif", detailed = TRUE, + anim_opts = anim_options()) +} +\arguments{ +\item{w}{a data_frame in the wide format} + +\item{key}{the key} + +\item{value}{the value} + +\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 +export ggplots of the first/last state of the join} + +\item{detailed}{boolean value if the animation should show one step for each +key value} + +\item{anim_opts}{An \code{\link[=anim_options]{anim_options()}} options list.} +} +\value{ +a gif or a ggplot +} +\description{ +Animates the gather function +} +\examples{ +wide <- data_frame( + year = 2010:2011, + Alice = c(105, 110), + Bob = c(100, 97), + Charlie = c(90, 95) +) +animate_gather(wide, "person", "sales", -year, export = "first") +animate_gather(wide, "person", "sales", -year, export = "last") + +\donttest{ + animate_gather(wide, "person", "sales", -year, export = "gif") + # if you want to have a less detailed animation, you can also use + animate_gather(wide, "person", "sales", -year, export = "gif", detailed = FALSE) +} +} diff --git a/man/animate_join.Rd b/man/animate_join.Rd new file mode 100644 index 0000000..8877724 --- /dev/null +++ b/man/animate_join.Rd @@ -0,0 +1,93 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/animate_joins.R +\name{animate_join} +\alias{animate_join} +\alias{animate_full_join} +\alias{animate_inner_join} +\alias{animate_left_join} +\alias{animate_right_join} +\alias{animate_semi_join} +\alias{animate_anti_join} +\title{Animates a join operation} +\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_inner_join(x, y, by, export = "gif", ...) + +animate_left_join(x, y, by, export = "gif", ...) + +animate_right_join(x, y, by, export = "gif", ...) + +animate_semi_join(x, y, by, export = "gif", ...) + +animate_anti_join(x, y, by, export = "gif", ...) +} +\arguments{ +\item{x}{the x dataset} + +\item{y}{the y dataset} + +\item{by}{the by arguments for the join} + +\item{export}{the export type, either gif, first or last. The latter two +export ggplots of the first/last state of the join} + +\item{...}{further arguments passed to anim_options()} +} +\value{ +either a gif or a ggplot +} +\description{ +Functions to visualise the join operations either static as a ggplot, or +dynamic as a gif. +} +\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])) + +# 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 = "last") + +# animate the transition as a gif (default) +\donttest{ +animate_full_join(x, y, by = "id", export = "gif") +} + +# different options include +\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, see also ?anim_options +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 +\donttest{ +# 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") +} +} +\seealso{ +\code{\link[dplyr]{join}} +} diff --git a/man/animate_plot.Rd b/man/animate_plot.Rd new file mode 100644 index 0000000..959caf3 --- /dev/null +++ b/man/animate_plot.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_helpers.R +\name{animate_plot} +\alias{animate_plot} +\title{Animate a Plot} +\usage{ +animate_plot(d, title = "", ..., anim_opts = anim_options(...)) +} +\arguments{ +\item{d}{a processed dataset} + +\item{title}{the title of the plot} + +\item{anim_opts}{Animation options generated with \code{\link[=anim_options]{anim_options()}}. Overrides +any options set in \code{...}.} +} +\value{ +a \code{gganim} object +} +\description{ +Animate a Plot +} +\examples{ +NULL +} diff --git a/man/animate_set.Rd b/man/animate_set.Rd new file mode 100644 index 0000000..e5477a6 --- /dev/null +++ b/man/animate_set.Rd @@ -0,0 +1,84 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/animate_sets.R +\name{animate_set} +\alias{animate_set} +\alias{animate_union} +\alias{animate_union_all} +\alias{animate_intersect} +\alias{animate_setdiff} +\title{Animates a set operation} +\usage{ +animate_set(x, y, type = c("union", "union_all", "intersect", "setdiff"), + export = c("gif", "first", "last"), ...) + +animate_union(x, y, export = "gif", ...) + +animate_union_all(x, y, export = "gif", ...) + +animate_intersect(x, y, export = "gif", ...) + +animate_setdiff(x, y, export = "gif", ...) +} +\arguments{ +\item{x}{the x 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 +export ggplots of the first/last state of the join} + +\item{...}{further argument passed to anim_options()} +} +\value{ +either a gif or a ggplot +} +\description{ +Functions to visualise the set operations either static as a ggplot, or +dynamic as a gif. +} +\examples{ +x <- data_frame(x = c(1, 1, 2), y = c("a", "b", "a")) +y <- data_frame(x = c(1, 2), y = c("a", "b")) + +# Animate the first or last state of the set +animate_union(x, y, export = "first") +animate_union(x, y, export = "last") + +# animate the transition as a gif (default) +\donttest{ +animate_union(x, y, export = "gif") +} + +# different options include +\donttest{ +animate_union(x, y) +animate_union_all(x, y) +animate_intersect(x, y) +animate_setdiff(x, y) + +# further arguments can be passed to all animate_* functions +animate_union( + x, y, + text_size = 5, title_size = 25, + color_header = "black", + color_fun = viridis::viridis +) +} + +# Save the results +\dontrun{ +# to save the ggplot, use +un <- animate_union(x, y, by = "id", export = "last") +ggsave("union.pdf", un) + +animate_union(x, y, by = "id", export = "gif") +# to save the gif, use +un <- animate_union(x, y, by = "id", export = "gif") +anim_save(un, "union.gif") +} +} +\seealso{ +\code{\link[dplyr]{setops}} +} diff --git a/man/animate_spread.Rd b/man/animate_spread.Rd new file mode 100644 index 0000000..bb84431 --- /dev/null +++ b/man/animate_spread.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/animate_tidyr.R +\name{animate_spread} +\alias{animate_spread} +\title{Animates the spread function} +\usage{ +animate_spread(l, key, value, export = "gif", detailed = TRUE, ..., + anim_opts = anim_options()) +} +\arguments{ +\item{l}{a data_frame in the long/tidy format} + +\item{key}{the key} + +\item{value}{the value} + +\item{export}{the export type, either gif, first or last. The latter two +export ggplots of the first/last state of the join} + +\item{detailed}{boolean value if the animation should show one step for each +key value} + +\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{ +a ggplot or a gif +} +\description{ +Animates the spread function +} +\examples{ +long <- data_frame( + year = c(2010L, 2011L, 2010L, 2011L, 2010L, 2011L), + person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), + sales = c(105, 110, 100, 97, 90, 95) +) +animate_spread(long, key = "person", value = "sales", export = "first") +animate_spread(long, key = "person", value = "sales", export = "last") + +\donttest{ + animate_spread(long, key = "person", value = "sales", export = "gif") + # if you want to have a less detailed animation, you can also use + animate_spread(long, key = "person", value = "sales", export = "gif", detailed = FALSE) +} +} diff --git a/man/dput_parser.Rd b/man/dput_parser.Rd new file mode 100644 index 0000000..0724a63 --- /dev/null +++ b/man/dput_parser.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tidyr_helpers.R +\name{dput_parser} +\alias{dput_parser} +\title{Parses a simple vector so that it looks like its input} +\usage{ +dput_parser(x) +} +\arguments{ +\item{x}{a vector} +} +\value{ +a string +} +\description{ +Parses a simple vector so that it looks like its input +} +\examples{ +dput_parser("x") +dput_parser(c("x", "y")) +} diff --git a/man/figures/tidyexplain-anti-join-1.gif b/man/figures/tidyexplain-anti-join-1.gif new file mode 100644 index 0000000..943302e Binary files /dev/null and b/man/figures/tidyexplain-anti-join-1.gif differ diff --git a/man/figures/tidyexplain-full-join-1.gif b/man/figures/tidyexplain-full-join-1.gif new file mode 100644 index 0000000..bf19d40 Binary files /dev/null and b/man/figures/tidyexplain-full-join-1.gif differ diff --git a/man/figures/tidyexplain-gather-1.gif b/man/figures/tidyexplain-gather-1.gif new file mode 100644 index 0000000..2801b07 Binary files /dev/null and b/man/figures/tidyexplain-gather-1.gif differ diff --git a/man/figures/tidyexplain-inner-join-1.gif b/man/figures/tidyexplain-inner-join-1.gif new file mode 100644 index 0000000..05494ea Binary files /dev/null and b/man/figures/tidyexplain-inner-join-1.gif differ diff --git a/man/figures/tidyexplain-intersect-1.gif b/man/figures/tidyexplain-intersect-1.gif new file mode 100644 index 0000000..f2f52b2 Binary files /dev/null and b/man/figures/tidyexplain-intersect-1.gif differ diff --git a/man/figures/tidyexplain-intial-dfs-1.png b/man/figures/tidyexplain-intial-dfs-1.png new file mode 100644 index 0000000..19cd568 Binary files /dev/null and b/man/figures/tidyexplain-intial-dfs-1.png differ diff --git a/man/figures/tidyexplain-intial-dfs-so-1.png b/man/figures/tidyexplain-intial-dfs-so-1.png new file mode 100644 index 0000000..0f227d0 Binary files /dev/null and b/man/figures/tidyexplain-intial-dfs-so-1.png differ diff --git a/man/figures/tidyexplain-left-join-1.gif b/man/figures/tidyexplain-left-join-1.gif new file mode 100644 index 0000000..a19b37d Binary files /dev/null and b/man/figures/tidyexplain-left-join-1.gif differ diff --git a/man/figures/tidyexplain-left-join-extra-1.gif b/man/figures/tidyexplain-left-join-extra-1.gif new file mode 100644 index 0000000..8013003 Binary files /dev/null and b/man/figures/tidyexplain-left-join-extra-1.gif differ diff --git a/man/figures/tidyexplain-right-join-1.gif b/man/figures/tidyexplain-right-join-1.gif new file mode 100644 index 0000000..c3b66c1 Binary files /dev/null and b/man/figures/tidyexplain-right-join-1.gif differ diff --git a/man/figures/tidyexplain-semi-join-1.gif b/man/figures/tidyexplain-semi-join-1.gif new file mode 100644 index 0000000..963b43d Binary files /dev/null and b/man/figures/tidyexplain-semi-join-1.gif differ diff --git a/man/figures/tidyexplain-setdiff-1.gif b/man/figures/tidyexplain-setdiff-1.gif new file mode 100644 index 0000000..b8e54ff Binary files /dev/null and b/man/figures/tidyexplain-setdiff-1.gif differ diff --git a/man/figures/tidyexplain-setdiff-y-x-1.gif b/man/figures/tidyexplain-setdiff-y-x-1.gif new file mode 100644 index 0000000..2e30e26 Binary files /dev/null and b/man/figures/tidyexplain-setdiff-y-x-1.gif differ diff --git a/man/figures/tidyexplain-spread-1.gif b/man/figures/tidyexplain-spread-1.gif new file mode 100644 index 0000000..13757b3 Binary files /dev/null and b/man/figures/tidyexplain-spread-1.gif differ diff --git a/man/figures/tidyexplain-union-1.gif b/man/figures/tidyexplain-union-1.gif new file mode 100644 index 0000000..632c3e4 Binary files /dev/null and b/man/figures/tidyexplain-union-1.gif differ diff --git a/man/figures/tidyexplain-union-all-1.gif b/man/figures/tidyexplain-union-all-1.gif new file mode 100644 index 0000000..9f19531 Binary files /dev/null and b/man/figures/tidyexplain-union-all-1.gif differ diff --git a/man/figures/tidyexplain-union-y-x-1.gif b/man/figures/tidyexplain-union-y-x-1.gif new file mode 100644 index 0000000..bb792ab Binary files /dev/null and b/man/figures/tidyexplain-union-y-x-1.gif differ diff --git a/man/gather_spread.Rd b/man/gather_spread.Rd new file mode 100644 index 0000000..271dd31 --- /dev/null +++ b/man/gather_spread.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tidyr_helpers.R +\name{gather_spread} +\alias{gather_spread} +\title{Animates a gather or spread function} +\usage{ +gather_spread(lhs, rhs, sequence, key_values, export, detailed, ..., + anim_opts = anim_options(...)) +} +\arguments{ +\item{lhs}{the (processed) dataset on the left-side} + +\item{rhs}{the (processed) dataset on the right-side} + +\item{sequence}{a named vector of the sequence titles +(current_state, final_state, operation, and reverse_operation)} + +\item{key_values}{the unique key-values} + +\item{export}{the export type, either gif, first or last. The latter two +export ggplots of the first/last state of the join} + +\item{detailed}{boolean value if the animation should show one step for each +key value} + +\item{...}{further arguments passed to animate_plot} +} +\value{ +the plot or the gif +} +\description{ +internally used by animate_spread and animate_gather +} +\examples{ +NULL +} diff --git a/man/get_quos_names.Rd b/man/get_quos_names.Rd new file mode 100644 index 0000000..3e81e50 --- /dev/null +++ b/man/get_quos_names.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tidyr_helpers.R +\name{get_quos_names} +\alias{get_quos_names} +\title{Gets the ... names} +\usage{ +get_quos_names(...) +} +\arguments{ +\item{...}{arguments} +} +\value{ +a vector of the names of ... +} +\description{ +Used to get the -year +} +\examples{ +x <- 1:10 +y <- 1 +get_quos_names(-x) +get_quos_names(x:y) +} diff --git a/man/move_together.Rd b/man/move_together.Rd new file mode 100644 index 0000000..4d951b0 --- /dev/null +++ b/man/move_together.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/move_together.R +\name{move_together} +\alias{move_together} +\title{Combines two processed datasets and combines them for a given method} +\usage{ +move_together(lhs, rhs, type) +} +\arguments{ +\item{lhs}{the left-hand side dataset} + +\item{rhs}{the righ-hand side dataset} + +\item{type}{a string of the desired combination method, allowed are all dplyr +joins or sets} +} +\value{ +processed dataset of the combined values +} +\description{ +Combines two processed datasets and combines them for a given method +} +\examples{ +NULL +} diff --git a/man/pipe.Rd b/man/pipe.Rd new file mode 100644 index 0000000..b7daf6a --- /dev/null +++ b/man/pipe.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-pipe.R +\name{\%>\%} +\alias{\%>\%} +\title{Pipe operator} +\usage{ +lhs \%>\% rhs +} +\description{ +See \code{magrittr::\link[magrittr]{\%>\%}} for details. +} +\keyword{internal} diff --git a/man/process_data_join.Rd b/man/process_data_join.Rd new file mode 100644 index 0000000..0554f50 --- /dev/null +++ b/man/process_data_join.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/process_data_helpers.R +\name{process_data_join} +\alias{process_data_join} +\title{Processes the data} +\usage{ +process_data_join(x, ids, by, width = 1, side = NA, fill = TRUE, ..., + ao = anim_options(...)) +} +\arguments{ +\item{x}{a preprocessed dataset} + +\item{ids}{a data_frame of ids (.id and .id_long)} + +\item{by}{a vector of by-arguments} + +\item{width}{the width of the tiles} + +\item{side}{the side (x or y, lhs or rhs, etc)} + +\item{fill}{if missing ids should be filled} + +\item{...}{further arguments passed to add_color} + +\item{ao}{anim_options} +} +\value{ +a data_frame including all necessary information +} +\description{ +Processes the data +} +\examples{ +NULL +} diff --git a/man/process_join.Rd b/man/process_join.Rd new file mode 100644 index 0000000..88b2859 --- /dev/null +++ b/man/process_join.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/process_data_helpers.R +\name{process_join} +\alias{process_join} +\title{Preprocess data} +\usage{ +process_join(x, y, by, fill = TRUE, ..., ao = anim_options(...)) +} +\arguments{ +\item{x}{a left dataset} + +\item{y}{a right dataset} + +\item{by}{a by argument for joins / set operations} + +\item{fill}{if missing ids should be filled} + +\item{...}{further arguments passed to add_color} + +\item{ao}{anim_options()} +} +\value{ +a preprocessed dataset +} +\description{ +Preprocess data +} +\examples{ +NULL +test for +a <- c("unique", "mult", "mult", "also unique") +add_duplicate_number(a) +} diff --git a/man/process_long.Rd b/man/process_long.Rd new file mode 100644 index 0000000..a142e70 --- /dev/null +++ b/man/process_long.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tidyr_helpers.R +\name{process_long} +\alias{process_long} +\title{Processes a long dataframe and converts it into a dataset that can be plotted} +\usage{ +process_long(x, ids, key, value, ...) +} +\arguments{ +\item{x}{a long data frame} + +\item{ids}{a vector of id-variables that are already in the tidy-format} + +\item{key}{a vector of key-variables} + +\item{...}{} +} +\value{ +TODO +} +\description{ +Processes a long dataframe and converts it into a dataset that can be plotted +} +\examples{ +long <- data_frame( + year = c(2010L, 2011L, 2010L, 2011L, 2010L, 2011L), + person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), + sales = c(105, 110, 100, 97, 90, 95) +) +process_long(long, ids = "year", key = "person", value = "sales") +process_long(long, ids = "year", key = "person", value = "sales") \%>\% static_plot +} diff --git a/man/process_wide.Rd b/man/process_wide.Rd new file mode 100644 index 0000000..9120a7f --- /dev/null +++ b/man/process_wide.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tidyr_helpers.R +\name{process_wide} +\alias{process_wide} +\title{Processes a wide dataframe and converts it into a dataset that can be plotted} +\usage{ +process_wide(x, ids, key, color_id = "lightgray", ...) +} +\arguments{ +\item{x}{a wide data frame} + +\item{ids}{a vector of id-variables that are already in the tidy-format} + +\item{key}{a vector of key-variables} + +\item{color_id}{the color for the id-body} + +\item{...}{} +} +\value{ +TODO +} +\description{ +Processes a wide dataframe and converts it into a dataset that can be plotted +} +\examples{ +wide <- data_frame( + year = 2010:2011, + Alice = c(105, 110), + Bob = c(100, 97), + Charlie = c(90, 95) +) +process_wide(wide, ids = "year", key = "person") +process_wide(wide, ids = "year", key = "person") \%>\% static_plot +} diff --git a/man/set_font_size.Rd b/man/set_font_size.Rd new file mode 100644 index 0000000..6637275 --- /dev/null +++ b/man/set_font_size.Rd @@ -0,0 +1,25 @@ +% 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 +}} + diff --git a/man/static_plot.Rd b/man/static_plot.Rd new file mode 100644 index 0000000..aebb46a --- /dev/null +++ b/man/static_plot.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_helpers.R +\name{static_plot} +\alias{static_plot} +\title{Prints the tiles for a processed dataset statically} +\usage{ +static_plot(d, title = "", ..., anim_opts = anim_options(...)) +} +\arguments{ +\item{d}{a processed dataset} + +\item{title}{the title of the plot} + +\item{...}{Arguments passed on to \code{anim_options} +\describe{ + \item{color_header}{Color of the header row.} + \item{color_other}{Color of the cells that are not highlighted otherwise.} + \item{color_missing}{Color of the missing cells.} + \item{color_fun}{A function that generates the colors for the highlighted +cells, default is \code{\link[scales:brewer_pal]{scales::brewer_pal()}} Set1.} + \item{text_color}{Color of the text of the cells, default is a black or +white, based on the background color of the cell.} + \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{cell_width}{Width of a cell, default is 1.} + \item{cell_height}{Height of a cell, default is 1.} + \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{anim_opts}{Animation options generated with \code{\link[=anim_options]{anim_options()}}. Overrides +any options set in \code{...}.} +} +\value{ +a ggplot +} +\description{ +Prints the tiles for a processed dataset statically +} +\examples{ +NULL +} diff --git a/man/tidyexplain-package.Rd b/man/tidyexplain-package.Rd new file mode 100644 index 0000000..4e7eddd --- /dev/null +++ b/man/tidyexplain-package.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/zzzz-package.R +\docType{package} +\name{tidyexplain-package} +\alias{tidyexplain} +\alias{tidyexplain-package} +\title{tidyexplain: Animated Explanations of Tidyverse Verbs} +\description{ +Animated explanations of the verbs in the tidyverse + using gganimate and ggplot2. +} +\author{ +\strong{Maintainer}: Garrick Aden-Buie \email{g.adenbuie@gmail.com} + +Authors: +\itemize{ + \item David Zimmermann \email{david_j_zimmermann@hotmail.com} +} + +Other contributors: +\itemize{ + \item Tyler Grant Smith [contributor] +} + +} +\keyword{internal} diff --git a/runtime.txt b/runtime.txt deleted file mode 100644 index ae3feab..0000000 --- a/runtime.txt +++ /dev/null @@ -1 +0,0 @@ -r-2018-08-15 diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..2732883 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(tidyverbs) + +test_check("tidyverbs") diff --git a/tests/testthat/test-anim_options.R b/tests/testthat/test-anim_options.R new file mode 100644 index 0000000..c0c6816 --- /dev/null +++ b/tests/testthat/test-anim_options.R @@ -0,0 +1,49 @@ +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() +}) diff --git a/tests/testthat/test-choose_text_color.R b/tests/testthat/test-choose_text_color.R new file mode 100644 index 0000000..8c90c00 --- /dev/null +++ b/tests/testthat/test-choose_text_color.R @@ -0,0 +1,6 @@ +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))) +}) diff --git a/tests/testthat/test-tidyr_helpers.R b/tests/testthat/test-tidyr_helpers.R new file mode 100644 index 0000000..fbcb7a1 --- /dev/null +++ b/tests/testthat/test-tidyr_helpers.R @@ -0,0 +1,12 @@ +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")') +}) diff --git a/tidy-animated-verbs.Rproj b/tidyexplain.Rproj similarity index 100% rename from tidy-animated-verbs.Rproj rename to tidyexplain.Rproj