David
7 years ago
79 changed files with 2783 additions and 1005 deletions
+ 3
- 0
.Rbuildignore
View File
| ^LICENSE\.md$ | |||||
| ^.*\.Rproj$ | |||||
| ^\.Rproj\.user$ |
+ 41
- 0
DESCRIPTION
View File
| 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 |
+ 2
- 116
LICENSE
View File
| 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 | |||||
| <http://creativecommons.org/publicdomain/zero/1.0/> | |||||
| YEAR: 2018 | |||||
| COPYRIGHT HOLDER: Garrick Aden-Buie |
+ 21
- 0
LICENSE.md
View File
| # 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. |
+ 41
- 0
NAMESPACE
View File
| # Generated by roxygen2: do not edit by hand | |||||
| S3method(print,anim_opts) | |||||
| export("%>%") | |||||
| export(anim_options) | |||||
| export(anim_options_set) | |||||
| 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_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) |
+ 0
- 37
R/00_base_join.R
View File
| # 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) |
+ 0
- 50
R/00_base_set.R
View File
| # Animated dplyr set opertaions with gganimate | |||||
| # * Contributed by Tyler Grant Smith <https://github.com/TylerGrantSmith> | |||||
| # * and Garrick Aden-Buie <https://www.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")) | |||||
| # 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) |
+ 0
- 7
R/01_register-fonts.R
View File
| # 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) |
+ 0
- 112
R/02_functions.R
View File
| 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) |
+ 0
- 5
R/03_check-folders.R
View File
| 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) |
+ 150
- 0
R/animate_joins.R
View File
| #' 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 static_plot | |||||
| #' | |||||
| #' @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 | |||||
| #' 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, ...) | |||||
| } |
+ 213
- 0
R/animate_options.R
View File
| #' Animation Options | |||||
| #' | |||||
| #' Helper function to set animation and plotting options to be passed to | |||||
| #' [animate_plot()] and [static_plot()]. | |||||
| #' | |||||
| #' @param text_family Font family for the plot text, default is "Fira Mono". Use | |||||
| #' [set_font_size()] to set global default font sizes. | |||||
| #' @param title_family Font family for the plot title, default is "Fira Mono". | |||||
| #' Use [set_font_size()] to set global default font sizes. | |||||
| #' @param text_size Font size of the plot text, default is 5. | |||||
| #' @param title_size Font size of the plot title, default is 17. | |||||
| #' @param ease_default Default aes easing function. See [tweenr::display_ease()] | |||||
| #' for more options. The tidyexplain default value is `sine-in-out`. | |||||
| #' @param ease_other Additional aes easing options, specified as a named list. | |||||
| #' List entries are named with the aesthetic to which the easeing should be | |||||
| #' applied, consistent with [gganimate::ease_aes()]. E.g. `list(color = | |||||
| #' "sine")`. | |||||
| #' @param enter Enter fading function applied to objects in the animation. See | |||||
| #' [gganimate::enter_exit] for a complete list of options. The tidyexplain | |||||
| #' default is [gganimate::enter_fade()]. | |||||
| #' @param exit Exit fading function applied to objects in the animation. See | |||||
| #' [gganimate::enter_exit] for a complete list of options. The tidyexplain | |||||
| #' default is [gganimate::exit_fade()]. | |||||
| #' @inheritParams gganimate::transition_states | |||||
| #' @export | |||||
| anim_options <- function( | |||||
| transition_length = NULL, | |||||
| state_length = NULL, | |||||
| ease_default = NULL, | |||||
| ease_other = NULL, | |||||
| enter = NULL, | |||||
| exit = NULL, | |||||
| text_family = NULL, | |||||
| title_family = NULL, | |||||
| text_size = NULL, | |||||
| title_size = NULL, | |||||
| ... | |||||
| ){ | |||||
| enter_name <- if (!missing(enter)) rlang::quo_name(rlang::enquo(enter)) | |||||
| exit_name <- if (!missing(exit)) rlang::quo_name(rlang::enquo(exit)) | |||||
| ao <- list( | |||||
| transition_length = transition_length, | |||||
| state_length = state_length, | |||||
| ease_default = ease_default, | |||||
| ease_other = ease_other, | |||||
| enter = if (!is.null(enter)) setNames(list(enter), enter_name), | |||||
| exit = if (!is.null(exit)) setNames(list(exit), exit_name), | |||||
| text_family = text_family, | |||||
| text_size = text_size, | |||||
| title_family = title_family, | |||||
| title_size = title_size, | |||||
| ... | |||||
| ) | |||||
| ao <- purrr::compact(ao) | |||||
| structure(ao, class = "anim_opts") | |||||
| } | |||||
| # Global Animation Options Setters and Getters ---------------------------- | |||||
| #' @describeIn anim_options Set default animation options for the current session. | |||||
| #' @param anim_opts An [anim_options()] options list. | |||||
| #' @export | |||||
| anim_options_set <- function(anim_opts = anim_options()) { | |||||
| stopifnot(is.anim_opts(anim_opts)) | |||||
| ao_old <- plot_settings$anim_opts | |||||
| plot_settings$anim_opts <- merge(anim_opts, plot_settings$anim_opts) | |||||
| invisible(ao_old) | |||||
| } | |||||
| get_anim_opt <- function(anim_opt = NULL) { | |||||
| if (is.null(anim_opt)) return(plot_settings$anim_opts) | |||||
| if (anim_opt %in% c("text_size", "title_size")) rlang::abort( | |||||
| "Use get_text_size() or get_title_size()" | |||||
| ) | |||||
| plot_settings$anim_opts[[anim_opt]] %||% plot_settings$default[[anim_opt]] | |||||
| } | |||||
| # Animation Options Methods ----------------------------------------------- | |||||
| #' @export | |||||
| print.anim_opts <- function(x) { | |||||
| # Replace ggproto (enter/exit functions) with their names | |||||
| if ("enter" %in% names(x)) x$enter <- paste("ggproto:", names(x$enter)) | |||||
| if ("exit" %in% names(x)) x$exit <- paste("ggproto:", names(x$exit)) | |||||
| anim_opts <- capture.output(str(x, no.list = TRUE)) | |||||
| cat( | |||||
| paste0("<anim_options: ", length(x), " options>"), | |||||
| anim_opts, sep = "\n" | |||||
| ) | |||||
| } | |||||
| #' @export | |||||
| is.anim_opts <- function(ao) inherits(ao, "anim_opts") | |||||
| # Fill, Validate, Merge Animation Options --------------------------------- | |||||
| # Fills in default animation options | |||||
| fill_anim_opts <- function(ao) { | |||||
| ao$transition_length <- ao$transition_length %||% get_anim_opt("transition_length") | |||||
| ao$state_length <- ao$state_length %||% get_anim_opt("state_length") | |||||
| ao$ease_default <- ao$ease_default %||% get_anim_opt("ease_default") | |||||
| ao$ease_other <- ao$ease_other %||% get_anim_opt("ease_other") | |||||
| ao$enter <- ao$enter %||% get_anim_opt("enter") | |||||
| ao$exit <- ao$exit %||% get_anim_opt("exit") | |||||
| ao$text_family <- ao$text_family %||% get_anim_opt("text_family") | |||||
| ao$title_family <- ao$title_family %||% get_anim_opt("title_family") | |||||
| ao | |||||
| } | |||||
| validate_anim_opts <- function(ao, quiet = FALSE, strict = getOption("tidyexplain.strict_dots", FALSE)) { | |||||
| if (!inherits(ao, "anim_opts")) { | |||||
| rlang::warn("Use `anim_options()` to set `anim_opts`") | |||||
| } | |||||
| ao <- fill_anim_opts(ao) | |||||
| stopifnot(is.ggproto(ao$enter[[1]]), is.ggproto(ao$exit[[1]])) | |||||
| extra_names <- setdiff(names(ao), names(formals(anim_options))) | |||||
| if (!quiet && length(extra_names)) { | |||||
| extra_names <- paste0(sprintf("`%s`", extra_names), collapse = ", ") | |||||
| msg <- paste("Unknown animation options will be ignored:", extra_names) | |||||
| if (isTrue(strict)) rlang::abort(msg) else rlang::warn(msg) | |||||
| } | |||||
| invisible(ao) | |||||
| } | |||||
| merge.anim_opts <- function(ao_new, ao_base = anim_options()) { | |||||
| ao_new <- purrr::discard(ao_new, is.null) | |||||
| ao_base <- purrr::discard(ao_base, is.null) | |||||
| unique_base <- setdiff(names(ao_base), names(ao_new)) | |||||
| ao <- append(ao_new, ao_base[unique_base]) | |||||
| ao <- ao[names(formals(anim_options))] | |||||
| ao <- purrr::discard(ao, is.null) | |||||
| class(ao) <- "anim_opts" | |||||
| ao | |||||
| } | |||||
| # Default Animation Options for Verb Families ----------------------------- | |||||
| default_anim_opts <- function(family, ao_custom = NULL) { | |||||
| family_options <- c("join", "set", "gather", "spread") | |||||
| family <- match.arg(family, family_options, several.ok = FALSE) | |||||
| ao_default <- switch( | |||||
| family, | |||||
| "gather" = anim_options(enter = enter_fade(), exit = exit_fade(), | |||||
| ease_default = "sine-in-out", | |||||
| ease_other = list(y = "cubic-out", x = "cubic-in")), | |||||
| "spread" = anim_options(enter = enter_fade(), exit = exit_fade(), | |||||
| ease_default = "sine-in-out", | |||||
| ease_other = list(y = "cubic-out", x = "cubic-in")), | |||||
| anim_options() | |||||
| ) | |||||
| if (is.null(ao_custom)) { | |||||
| # User set globals override defaults | |||||
| ao_custom <- get_anim_opt() | |||||
| } else { | |||||
| # Opts from function call override user-set globals | |||||
| ao_custom <- merge(ao_custom, get_anim_opt()) | |||||
| } | |||||
| # function > user-set global > default (> global default) | |||||
| if (!is.null(ao_custom)) merge(ao_custom, ao_default) else ao_default | |||||
| } | |||||
| # Font Size Setters and Getters ------------------------------------------- | |||||
| #' Set Default Text Sizes for Animation Plots | |||||
| #' | |||||
| #' Sets the default text sizes for the animated and static plots produced by | |||||
| #' this package during the current session. | |||||
| #' | |||||
| #' @param text_size Font size of value labels inside the data frame squares | |||||
| #' @param title_size Font size of the function call or plot title | |||||
| #' @export | |||||
| set_font_size <- function(text_size = NULL, title_size = NULL) { | |||||
| old <- list() | |||||
| if (!is.null(text_size)) old$text_size <- set_text_size(text_size) | |||||
| if (!is.null(title_size)) old$title_size <- set_title_size(title_size) | |||||
| invisible(old) | |||||
| } | |||||
| #' @describeIn set_font_size Get current global font sizes | |||||
| #' @export | |||||
| get_font_size <- function() { | |||||
| list("text_size" = get_text_size(), "title_size" = get_title_size()) | |||||
| } | |||||
| set_text_size <- function(size) { | |||||
| old <- plot_settings$text_size | |||||
| anim_options_set(anim_options(text_size = size)) | |||||
| invisible(old) | |||||
| } | |||||
| set_title_size <- function(size) { | |||||
| old <- plot_settings$title_size | |||||
| anim_options_set(anim_options(title_size = size)) | |||||
| invisible(old) | |||||
| } | |||||
| get_text_size <- function(x = NULL) { | |||||
| if (!is.null(x)) return(x) | |||||
| plot_settings$anim_opts$text_size %||% | |||||
| getFromNamespace("theme_env", "ggplot2")$current$text$size %||% | |||||
| plot_settings$default$text_size | |||||
| } | |||||
| get_title_size <- function(x = NULL) { | |||||
| if (!is.null(x)) return(x) | |||||
| plot_settings$anim_opts$title_size %||% | |||||
| getFromNamespace("theme_env", "ggplot2")$current$plot.title$size %||% | |||||
| plot_settings$default$title_size | |||||
| } |
+ 134
- 0
R/animate_sets.R
View File
| #' Animates a set operation | |||||
| #' | |||||
| #' Functions to visualise the set operations either static as a ggplot, or | |||||
| #' dynamic as a gif. | |||||
| #' | |||||
| #' @param x the x dataset | |||||
| #' @param y the y dataset | |||||
| #' @param export the export type, either gif, first or last. The latter two | |||||
| #' export ggplots of the first/last state of the join | |||||
| #' @param type type of the set, i.e., intersect, setdiff, etc. | |||||
| #' @param ... further argument passed to static_plot | |||||
| #' | |||||
| #' @return either a gif or a ggplot | |||||
| #' | |||||
| #' @seealso \code{\link[dplyr]{setops}} | |||||
| #' | |||||
| #' @examples | |||||
| #' x <- data_frame(x = c(1, 1, 2), y = c("a", "b", "a")) | |||||
| #' y <- data_frame(x = c(1, 2), y = c("a", "b")) | |||||
| #' | |||||
| #' # Animate the first or last state of the set | |||||
| #' animate_union(x, y, export = "first") | |||||
| #' animate_union(x, y, export = "last") | |||||
| #' | |||||
| #' # animate the transition as a gif (default) | |||||
| #' \donttest{ | |||||
| #' animate_union(x, y, export = "gif") | |||||
| #' } | |||||
| #' | |||||
| #' # different options include | |||||
| #' \donttest{ | |||||
| #' animate_union(x, y) | |||||
| #' animate_union_all(x, y) | |||||
| #' animate_intersect(x, y) | |||||
| #' animate_setdiff(x, y) | |||||
| #' | |||||
| #' # further arguments can be passed to all animate_* functions | |||||
| #' animate_union( | |||||
| #' x, y, | |||||
| #' text_size = 5, title_size = 25, | |||||
| #' color_header = "black", | |||||
| #' color_other = "lightblue", | |||||
| #' color_fun = viridis::viridis | |||||
| #' ) | |||||
| #' } | |||||
| #' | |||||
| #' # Save the results | |||||
| #' \dontrun{ | |||||
| #' # to save the ggplot, use | |||||
| #' un <- animate_union(x, y, by = "id", export = "last") | |||||
| #' ggsave("union.pdf", un) | |||||
| #' | |||||
| #' animate_union(x, y, by = "id", export = "gif") | |||||
| #' # to save the gif, use | |||||
| #' un <- animate_union(x, y, by = "id", export = "gif") | |||||
| #' anim_save(un, "union.gif") | |||||
| #' } | |||||
| animate_set <- function( | |||||
| x, y, | |||||
| type = c("union", "union_all", "intersect", "setdiff"), | |||||
| export = c("gif", "first", "last"), | |||||
| ... | |||||
| ) { | |||||
| type <- match.arg(type) | |||||
| export <- match.arg(export) | |||||
| x_name <- get_input_text(x) | |||||
| y_name <- get_input_text(y) | |||||
| data <- make_named_data(x, y) | |||||
| col_names <- purrr::map(data, names) | |||||
| if (!all(names(data$x) %in% names(data$y)) && ncol(data$x) == ncol(data$y)) | |||||
| stop("x and y must have the same variables/column-names") | |||||
| title <- sprintf(paste0(type, "(%s, %s)"), x_name, y_name) | |||||
| if (type %in% c("union", "intersect", "setdiff")) { | |||||
| data <- purrr::map(data, dplyr::distinct) | |||||
| } | |||||
| if (type == "union_all") { | |||||
| ll <- process_join(data$x, data$y, by = names(data$x), fill = FALSE, ...) | |||||
| ll <- purrr::map(ll, ~ mutate(., .id_long = paste(.id_long, .side, sep = "-"))) | |||||
| } else { | |||||
| ll <- process_join(data$x, data$y, by = names(data$x), ...) | |||||
| } | |||||
| step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1) | |||||
| step1 <- move_together(ll$x, ll$y, type) %>% mutate(.frame = 1) | |||||
| all <- bind_rows(step0, step1) | |||||
| if (export == "gif") { | |||||
| animate_plot(all, title, ...) %>% animate() | |||||
| } else if (export == "first") { | |||||
| title <- "" | |||||
| static_plot(step0, title, ...) | |||||
| } else if (export == "last") { | |||||
| static_plot(step1, title, ...) | |||||
| } | |||||
| } | |||||
| #' @rdname animate_set | |||||
| #' @export | |||||
| animate_union <- function(x, y, export = "gif", ...) { | |||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_set(x, y, type = "union", export = export, ...) | |||||
| } | |||||
| #' @rdname animate_set | |||||
| #' @export | |||||
| animate_union_all <- function(x, y, export = "gif", ...) { | |||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_set(x, y, type = "union_all", export = export, ...) | |||||
| } | |||||
| #' @rdname animate_set | |||||
| #' @export | |||||
| animate_intersect <- function(x, y, export = "gif", ...) { | |||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_set(x, y, type = "intersect", export = export, ...) | |||||
| } | |||||
| #' @rdname animate_set | |||||
| #' @export | |||||
| animate_setdiff <- function(x, y, export = "gif", ...) { | |||||
| x <- rlang::enquo(x) | |||||
| y <- rlang::enquo(y) | |||||
| animate_set(x, y, type = "setdiff", export = export, ...) | |||||
| } |
+ 123
- 0
R/animate_tidyr.R
View File
| #' 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) | |||||
| } |
+ 0
- 48
R/anti_join.R
View File
| 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") |
+ 0
- 29
R/full_join.R
View File
| 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") |
+ 0
- 29
R/inner_join.R
View File
| 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") |
+ 0
- 28
R/intersect.R
View File
| 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") |
+ 0
- 27
R/left_join.R
View File
| 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") |
+ 0
- 71
R/left_join_extra.R
View File
| 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") |
+ 105
- 0
R/move_together.R
View File
| #' 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) | |||||
| ) | |||||
| } |
+ 72
- 0
R/plot_helpers.R
View File
| #' 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) | |||||
| } | |||||
| ggplot(d, aes(x = .x, y = .y, fill = .color, alpha = .alpha, group = .item_id)) + | |||||
| geom_tile(width = 0.9, height = 0.9) + | |||||
| 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)) | |||||
| } |
+ 148
- 0
R/process_data_helpers.R
View File
| #' 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 | |||||
| #' | |||||
| #' @return a preprocessed dataset | |||||
| #' | |||||
| #' @examples | |||||
| #' NULL | |||||
| process_join <- function(x, y, by, fill = TRUE, ...) { | |||||
| #' 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, ...) | |||||
| y_ <- process_data_join(y, ids, by, fill = fill, ...) %>% | |||||
| 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 | |||||
| #' | |||||
| #' @return a data_frame including all necessary information | |||||
| #' | |||||
| #' @examples | |||||
| #' NULL | |||||
| process_data_join <- function(x, ids, by, width = 1, side = NA, fill = TRUE, ...) { | |||||
| 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()) %>% | |||||
| # TODO re-evaluate gather_ here | |||||
| 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, ...) | |||||
| } | |||||
| #' 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, | |||||
| color_header = "#737373", color_other = "#d0d0d0", | |||||
| color_missing = "#ffffff", | |||||
| color_fun = scales::brewer_pal(type = "qual", "Set1"), | |||||
| text_color = NA, ...) { | |||||
| 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) | |||||
| } | |||||
+ 0
- 30
R/right_join.R
View File
| 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") |
+ 0
- 30
R/semi_join.R
View File
| 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") |
+ 0
- 102
R/setdiff.R
View File
| 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") |
+ 354
- 0
R/tidyr_helpers.R
View File
| #' 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 | |||||
| } |
+ 0
- 42
R/union.R
View File
| 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") |
+ 0
- 23
R/union_all.R
View File
| 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") |
+ 11
- 0
R/utils-pipe.R
View File
| #' Pipe operator | |||||
| #' | |||||
| #' See \code{magrittr::\link[magrittr]{\%>\%}} for details. | |||||
| #' | |||||
| #' @name %>% | |||||
| #' @rdname pipe | |||||
| #' @keywords internal | |||||
| #' @export | |||||
| #' @importFrom magrittr %>% | |||||
| #' @usage lhs \%>\% rhs | |||||
| NULL |
+ 26
- 0
R/utils.R
View File
| `%||%` <- 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 | |||||
| } |
+ 20
- 0
R/zzzz-package.R
View File
| #' @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 | |||||
| ) | |||||
+ 141
- 109
README.Rmd
View File
| --- | --- | ||||
| output: github_document | output: github_document | ||||
| editor_options: | |||||
| chunk_output_type: console | |||||
| --- | --- | ||||
| <!-- README.md is generated from README.Rmd. Please edit that file --> | <!-- README.md is generated from README.Rmd. Please edit that file --> | ||||
| knitr::opts_chunk$set( | knitr::opts_chunk$set( | ||||
| collapse = TRUE, | collapse = TRUE, | ||||
| comment = "#>", | comment = "#>", | ||||
| echo = FALSE, | |||||
| echo = TRUE, | |||||
| warning = FALSE, | warning = FALSE, | ||||
| message = FALSE, | message = FALSE, | ||||
| fig.path = "man/figures/tidyexplain-", | |||||
| cache = TRUE | cache = TRUE | ||||
| ) | ) | ||||
| library(tidyexplain) | |||||
| set_font_size(11, 26) | |||||
| ``` | ``` | ||||
| [gganimate]: https://github.com/thomasp85/gganimate#README | [gganimate]: https://github.com/thomasp85/gganimate#README | ||||
| # Tidy Animated Verbs | # 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). | |||||
| [](https://mybinder.org/v2/gh/gadenbuie/tidy-animated-verbs/master?urlpath=rstudio) | [](https://mybinder.org/v2/gh/gadenbuie/tidy-animated-verbs/master?urlpath=rstudio) | ||||
| [_-CC0-green.svg)](https://creativecommons.org/publicdomain/zero/1.0/) | [_-CC0-green.svg)](https://creativecommons.org/publicdomain/zero/1.0/) | ||||
| [_-MIT-green.svg)](https://opensource.org/licenses/MIT) | [_-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) | |||||
| - [**Set Operations**](#set-operations) — [`union()`](#union), [`union_all()`](#union-all), [`intersect()`](#intersect), [`setdiff()`](#setdiff) | |||||
| - Filtering Joins: [`semi_join()`](#semi-join), [`anti_join()`](#anti-join) | |||||
| - [**Tidy Data**](#tidy-data) — [`spread()` and `gather()`](#spread-and-gather) | |||||
| - Set Operations: [`union()`](#union), [`union_all()`](#union-all), [`intersect()`](#intersect), [`setdiff()`](#setdiff) | |||||
| - Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) | |||||
| - Learn more about | - Learn more about | ||||
| - [Using the animations and images](#usage) | - [Using the animations and images](#usage) | ||||
| - [Relational Data](#relational-data) | - [Relational Data](#relational-data) | ||||
| - [gganimate](#gganimate) | - [gganimate](#gganimate) | ||||
| ## Background | |||||
| ### Usage | |||||
| Please feel free to use these images for teaching or learning about action verbs from the [tidyverse](https://tidyverse.org). | Please feel free to use these images for teaching or learning about action verbs from the [tidyverse](https://tidyverse.org). | ||||
| 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. | 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. | ||||
| 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. | 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) | [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 | ## Mutating Joins | ||||
| > [R for Data Science: Mutating joins](http://r4ds.had.co.nz/relational-data.html#mutating-joins) | > [R for Data Science: Mutating joins](http://r4ds.had.co.nz/relational-data.html#mutating-joins) | ||||
| ```{r intial-dfs} | ```{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") | |||||
| ``` | ``` | ||||
| <img src="images/static/png/original-dfs.png" width="480px" /> | |||||
| ```{r echo=TRUE} | |||||
| ```{r} | |||||
| x | x | ||||
| y | y | ||||
| ``` | ``` | ||||
| > All rows from `x` where there are matching values in `y`, and all columns from `x` and `y`. | > All rows from `x` where there are matching values in `y`, and all columns from `x` and `y`. | ||||
| ```{r inner-join} | ```{r inner-join} | ||||
| source("R/inner_join.R") | |||||
| animate_inner_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| inner_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::inner_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ### Left Join | ### Left Join | ||||
| > All rows from `x`, and all columns from `x` and `y`. Rows in `x` with no match in `y` will have `NA` values in the new columns. | > All rows from `x`, and all columns from `x` and `y`. Rows in `x` with no match in `y` will have `NA` values in the new columns. | ||||
| ```{r left-join} | ```{r left-join} | ||||
| source("R/left_join.R") | |||||
| animate_left_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| left_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::left_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ### Left Join (Extra Rows in y) | ### Left Join (Extra Rows in y) | ||||
| > ... If there are multiple matches between `x` and `y`, all combinations of the matches are returned. | > ... If there are multiple matches between `x` and `y`, all combinations of the matches are returned. | ||||
| ```{r left-join-extra} | ```{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` | |||||
|  | |||||
| animate_left_join(x, y_extra, by = "id", | |||||
| anim_opts = anim_options(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 | ### Right Join | ||||
| > All rows from y, and all columns from `x` and `y`. Rows in `y` with no match in `x` will have `NA` values in the new columns. | > All rows from y, and all columns from `x` and `y`. Rows in `y` with no match in `x` will have `NA` values in the new columns. | ||||
| ```{r right-join} | ```{r right-join} | ||||
| source("R/right_join.R") | |||||
| animate_right_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| right_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::right_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ### Full Join | ### Full Join | ||||
| > All rows and all columns from both `x` and `y`. Where there are not matching values, returns `NA` for the one missing. | > All rows and all columns from both `x` and `y`. Where there are not matching values, returns `NA` for the one missing. | ||||
| ```{r full-join} | ```{r full-join} | ||||
| source("R/full_join.R") | |||||
| animate_full_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| full_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::full_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ## Filtering Joins | ## Filtering Joins | ||||
| > All rows from `x` where there are matching values in `y`, keeping just columns from `x`. | > All rows from `x` where there are matching values in `y`, keeping just columns from `x`. | ||||
| ```{r semi-join} | ```{r semi-join} | ||||
| source("R/semi_join.R") | |||||
| animate_semi_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| semi_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::semi_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ### Anti Join | ### Anti Join | ||||
| > All rows from `x` where there are not matching values in `y`, keeping just columns from `x`. | > All rows from `x` where there are not matching values in `y`, keeping just columns from `x`. | ||||
| ```{r anti-join} | ```{r anti-join} | ||||
| source("R/anti_join.R") | |||||
| animate_anti_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| anti_join(x, y, by = "id") | |||||
| ```{r} | |||||
| dplyr::anti_join(x, y, by = "id") | |||||
| ``` | ``` | ||||
| ## Set Operations | ## Set Operations | ||||
| > [R for Data Science: Set operations](http://r4ds.had.co.nz/relational-data.html#set-operations) | > [R for Data Science: Set operations](http://r4ds.had.co.nz/relational-data.html#set-operations) | ||||
| ```{r intial-dfs-so} | ```{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") | |||||
| ``` | ``` | ||||
| <img src="images/static/png/original-dfs-set-ops.png" width="480px" /> | |||||
| ```{r echo=TRUE} | |||||
| ```{r} | |||||
| x | x | ||||
| y | y | ||||
| ``` | ``` | ||||
| > All unique rows from `x` and `y`. | > All unique rows from `x` and `y`. | ||||
| ```{r union} | ```{r union} | ||||
| source("R/union.R") | |||||
| <<remove-set-ops-ids>> | |||||
| animate_union(x, y) | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| union(x, y) | |||||
| ```{r} | |||||
| dplyr::union(x, y) | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| union(y, x) | |||||
| ```{r union-y-x} | |||||
| animate_union(y, x) | |||||
| dplyr::union(y, x) | |||||
| ``` | ``` | ||||
| ### Union All | ### Union All | ||||
| > All rows from `x` and `y`, keeping duplicates. | > All rows from `x` and `y`, keeping duplicates. | ||||
| ```{r union-all} | ```{r union-all} | ||||
| source("R/union_all.R") | |||||
| <<remove-set-ops-ids>> | |||||
| animate_union_all(x, y) | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| union_all(x, y) | |||||
| ```{r} | |||||
| dplyr::union_all(x, y) | |||||
| ``` | ``` | ||||
| > Common rows in both `x` and `y`, keeping just unique rows. | > Common rows in both `x` and `y`, keeping just unique rows. | ||||
| ```{r intersect} | ```{r intersect} | ||||
| source("R/intersect.R") | |||||
| <<remove-set-ops-ids>> | |||||
| animate_intersect(x, y) | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| intersect(x, y) | |||||
| ```{r} | |||||
| dplyr::intersect(x, y) | |||||
| ``` | ``` | ||||
| ### Set Difference | ### Set Difference | ||||
| > All rows from `x` which are not also rows in `y`, keeping just unique rows. | > All rows from `x` which are not also rows in `y`, keeping just unique rows. | ||||
| ```{r setdiff} | ```{r setdiff} | ||||
| source("R/setdiff.R") | |||||
| <<remove-set-ops-ids>> | |||||
| animate_setdiff(x, y) | |||||
| ``` | ``` | ||||
|  | |||||
| ```{r echo=TRUE} | |||||
| setdiff(x, y) | |||||
| ```{r} | |||||
| dplyr::setdiff(x, y) | |||||
| ``` | ``` | ||||
|  | |||||
| ```{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](http://r4ds.had.co.nz/tidy-data.html#tidy-data-1) follows | |||||
| the following three rules: | |||||
| 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](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} | |||||
| 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 gather} | |||||
| set_font_size(4.5, 15) | |||||
| animate_gather(wide, key = "person", value = "sales", -year) | |||||
| ``` | |||||
| ```{r} | |||||
| tidyr::gather(wide, key = "person", value = "sales", -year) | |||||
| ``` | |||||
| ### 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} | |||||
| tidyr::spread(long, key = "person", value = "sales") | |||||
| ``` | |||||
| ## Learn More | |||||
| [Tidy data][r4ds-tidy-data] follows the following three rules: | [Tidy data][r4ds-tidy-data] follows the following three rules: | ||||
+ 238
- 102
README.md
View File
| # Tidy Animated Verbs | # Tidy Animated Verbs | ||||
| Garrick Aden-Buie – [@grrrck](https://twitter.com/grrrck) – | 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). | Smith](https://github.com/TylerGrantSmith). | ||||
| [](https://mybinder.org/v2/gh/gadenbuie/tidy-animated-verbs/master?urlpath=rstudio) | [](https://mybinder.org/v2/gh/gadenbuie/tidy-animated-verbs/master?urlpath=rstudio) | ||||
| [`union_all()`](#union-all), [`intersect()`](#intersect), | [`union_all()`](#union-all), [`intersect()`](#intersect), | ||||
| [`setdiff()`](#setdiff) | [`setdiff()`](#setdiff) | ||||
| - [**Tidy Data**](#tidy-data) — [`spread()` and | |||||
| `gather()`](#spread-and-gather) | |||||
| - Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) | |||||
| - Learn more about | - Learn more about | ||||
| [Suggestions are | [Suggestions are | ||||
| welcome\!](https://github.com/gadenbuie/tidy-animated-verbs/issues) | 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 | ## 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") | |||||
| ``` | |||||
| <img src="images/static/png/original-dfs.png" width="480px" /> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| x | x | ||||
| > All rows from `x` where there are matching values in `y`, and all | > All rows from `x` where there are matching values in `y`, and all | ||||
| > columns from `x` and `y`. | > columns from `x` and `y`. | ||||
|  | |||||
| ``` r | |||||
| animate_inner_join(x, y, by = "id") | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| inner_join(x, y, by = "id") | |||||
| dplyr::inner_join(x, y, by = "id") | |||||
| #> # A tibble: 2 x 3 | #> # A tibble: 2 x 3 | ||||
| #> id x y | #> id x y | ||||
| #> <int> <chr> <chr> | #> <int> <chr> <chr> | ||||
| > All rows from `x`, and all columns from `x` and `y`. Rows in `x` with | > 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. | > no match in `y` will have `NA` values in the new columns. | ||||
|  | |||||
| ``` r | |||||
| animate_left_join(x, y, by = "id") | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| left_join(x, y, by = "id") | |||||
| dplyr::left_join(x, y, by = "id") | |||||
| #> # A tibble: 3 x 3 | #> # A tibble: 3 x 3 | ||||
| #> id x y | #> id x y | ||||
| #> <int> <chr> <chr> | #> <int> <chr> <chr> | ||||
| > … If there are multiple matches between `x` and `y`, all combinations | > … If there are multiple matches between `x` and `y`, all combinations | ||||
| > of the matches are returned. | > of the matches are returned. | ||||
|  | |||||
| ``` r | ``` r | ||||
| y_extra <- dplyr::bind_rows(y, dplyr::data_frame(id = 2, y = "y5")) | |||||
| y_extra # has multiple rows with the key from `x` | y_extra # has multiple rows with the key from `x` | ||||
| #> # A tibble: 4 x 2 | #> # A tibble: 4 x 2 | ||||
| #> id y | #> id y | ||||
| #> 2 2 y2 | #> 2 2 y2 | ||||
| #> 3 4 y4 | #> 3 4 y4 | ||||
| #> 4 2 y5 | #> 4 2 y5 | ||||
| left_join(x, y_extra, by = "id") | |||||
| animate_left_join(x, y_extra, by = "id", | |||||
| anim_opts = anim_options(title_size = 22)) | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | |||||
| dplyr::left_join(x, y_extra, by = "id") | |||||
| #> # A tibble: 4 x 3 | #> # A tibble: 4 x 3 | ||||
| #> id x y | #> id x y | ||||
| #> <dbl> <chr> <chr> | #> <dbl> <chr> <chr> | ||||
| > All rows from y, and all columns from `x` and `y`. Rows in `y` with no | > 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. | > match in `x` will have `NA` values in the new columns. | ||||
|  | |||||
| ``` r | |||||
| animate_right_join(x, y, by = "id") | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| right_join(x, y, by = "id") | |||||
| dplyr::right_join(x, y, by = "id") | |||||
| #> # A tibble: 3 x 3 | #> # A tibble: 3 x 3 | ||||
| #> id x y | #> id x y | ||||
| #> <int> <chr> <chr> | #> <int> <chr> <chr> | ||||
| > All rows and all columns from both `x` and `y`. Where there are not | > All rows and all columns from both `x` and `y`. Where there are not | ||||
| > matching values, returns `NA` for the one missing. | > matching values, returns `NA` for the one missing. | ||||
|  | |||||
| ``` r | |||||
| animate_full_join(x, y, by = "id") | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| full_join(x, y, by = "id") | |||||
| dplyr::full_join(x, y, by = "id") | |||||
| #> # A tibble: 4 x 3 | #> # A tibble: 4 x 3 | ||||
| #> id x y | #> id x y | ||||
| #> <int> <chr> <chr> | #> <int> <chr> <chr> | ||||
| > All rows from `x` where there are matching values in `y`, keeping just | > All rows from `x` where there are matching values in `y`, keeping just | ||||
| > columns from `x`. | > columns from `x`. | ||||
|  | |||||
| ``` r | |||||
| animate_semi_join(x, y, by = "id") | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| semi_join(x, y, by = "id") | |||||
| dplyr::semi_join(x, y, by = "id") | |||||
| #> # A tibble: 2 x 2 | #> # A tibble: 2 x 2 | ||||
| #> id x | #> id x | ||||
| #> <int> <chr> | #> <int> <chr> | ||||
| > All rows from `x` where there are not matching values in `y`, keeping | > All rows from `x` where there are not matching values in `y`, keeping | ||||
| > just columns from `x`. | > just columns from `x`. | ||||
|  | |||||
| ``` r | |||||
| animate_anti_join(x, y, by = "id") | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| anti_join(x, y, by = "id") | |||||
| dplyr::anti_join(x, y, by = "id") | |||||
| #> # A tibble: 1 x 2 | #> # A tibble: 1 x 2 | ||||
| #> id x | #> id x | ||||
| #> <int> <chr> | #> <int> <chr> | ||||
| ## Set Operations | ## Set Operations | ||||
| > 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") | |||||
| ``` | |||||
| <img src="images/static/png/original-dfs-set-ops.png" width="480px" /> | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| x | x | ||||
| #> # A tibble: 3 x 2 | #> # A tibble: 3 x 2 | ||||
| #> x y | |||||
| #> <chr> <chr> | |||||
| #> 1 1 a | |||||
| #> 2 1 b | |||||
| #> 3 2 a | |||||
| #> x y | |||||
| #> <dbl> <chr> | |||||
| #> 1 1 a | |||||
| #> 2 1 b | |||||
| #> 3 2 a | |||||
| y | y | ||||
| #> # A tibble: 2 x 2 | #> # A tibble: 2 x 2 | ||||
| #> x y | |||||
| #> <chr> <chr> | |||||
| #> 1 1 a | |||||
| #> 2 2 b | |||||
| #> x y | |||||
| #> <dbl> <chr> | |||||
| #> 1 1 a | |||||
| #> 2 2 b | |||||
| ``` | ``` | ||||
| ### Union | ### Union | ||||
| > All unique rows from `x` and `y`. | > All unique rows from `x` and `y`. | ||||
|  | |||||
| ``` r | |||||
| animate_union(x, y) | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| union(x, y) | |||||
| dplyr::union(x, y) | |||||
| #> # A tibble: 4 x 2 | #> # A tibble: 4 x 2 | ||||
| #> x y | |||||
| #> <chr> <chr> | |||||
| #> 1 2 b | |||||
| #> 2 2 a | |||||
| #> 3 1 b | |||||
| #> 4 1 a | |||||
| #> x y | |||||
| #> <dbl> <chr> | |||||
| #> 1 2 b | |||||
| #> 2 2 a | |||||
| #> 3 1 b | |||||
| #> 4 1 a | |||||
| ``` | ``` | ||||
|  | |||||
| ``` r | |||||
| animate_union(y, x) | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| union(y, x) | |||||
| dplyr::union(y, x) | |||||
| #> # A tibble: 4 x 2 | #> # A tibble: 4 x 2 | ||||
| #> x y | |||||
| #> <chr> <chr> | |||||
| #> 1 2 a | |||||
| #> 2 1 b | |||||
| #> 3 2 b | |||||
| #> 4 1 a | |||||
| #> x y | |||||
| #> <dbl> <chr> | |||||
| #> 1 2 a | |||||
| #> 2 1 b | |||||
| #> 3 2 b | |||||
| #> 4 1 a | |||||
| ``` | ``` | ||||
| ### Union All | ### Union All | ||||
| > All rows from `x` and `y`, keeping duplicates. | > All rows from `x` and `y`, keeping duplicates. | ||||
|  | |||||
| ``` r | |||||
| animate_union_all(x, y) | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| union_all(x, y) | |||||
| dplyr::union_all(x, y) | |||||
| #> # A tibble: 5 x 2 | #> # A tibble: 5 x 2 | ||||
| #> x y | |||||
| #> <chr> <chr> | |||||
| #> 1 1 a | |||||
| #> 2 1 b | |||||
| #> 3 2 a | |||||
| #> 4 1 a | |||||
| #> 5 2 b | |||||
| #> x y | |||||
| #> <dbl> <chr> | |||||
| #> 1 1 a | |||||
| #> 2 1 b | |||||
| #> 3 2 a | |||||
| #> 4 1 a | |||||
| #> 5 2 b | |||||
| ``` | ``` | ||||
| ### Intersection | ### Intersection | ||||
| > Common rows in both `x` and `y`, keeping just unique rows. | > Common rows in both `x` and `y`, keeping just unique rows. | ||||
|  | |||||
| ``` r | |||||
| animate_intersect(x, y) | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| intersect(x, y) | |||||
| dplyr::intersect(x, y) | |||||
| #> # A tibble: 1 x 2 | #> # A tibble: 1 x 2 | ||||
| #> x y | |||||
| #> <chr> <chr> | |||||
| #> 1 1 a | |||||
| #> x y | |||||
| #> <dbl> <chr> | |||||
| #> 1 1 a | |||||
| ``` | ``` | ||||
| ### Set Difference | ### Set Difference | ||||
| > All rows from `x` which are not also rows in `y`, keeping just unique | > All rows from `x` which are not also rows in `y`, keeping just unique | ||||
| > rows. | > rows. | ||||
|  | |||||
| ``` r | |||||
| animate_setdiff(x, y) | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| setdiff(x, y) | |||||
| dplyr::setdiff(x, y) | |||||
| #> # A tibble: 2 x 2 | #> # A tibble: 2 x 2 | ||||
| #> x y | |||||
| #> <chr> <chr> | |||||
| #> 1 1 b | |||||
| #> 2 2 a | |||||
| #> x y | |||||
| #> <dbl> <chr> | |||||
| #> 1 1 b | |||||
| #> 2 2 a | |||||
| ``` | ``` | ||||
|  | |||||
| ``` r | |||||
| animate_setdiff(y, x) | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | ``` r | ||||
| setdiff(y, x) | |||||
| dplyr::setdiff(y, x) | |||||
| #> # A tibble: 1 x 2 | #> # A tibble: 1 x 2 | ||||
| #> x y | |||||
| #> <chr> <chr> | |||||
| #> 1 2 b | |||||
| #> x y | |||||
| #> <dbl> <chr> | |||||
| #> 1 2 b | |||||
| ``` | |||||
| ## Tidy Data and `gather()`, `spread()` functionality | |||||
| [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. | |||||
| 2. Each observation has its own row. | |||||
| 3. Each value has its own cell. | |||||
| 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 | |||||
| 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 | |||||
| set_font_size(4.5, 15) | |||||
| animate_gather(wide, key = "person", value = "sales", -year) | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | |||||
| tidyr::gather(wide, key = "person", value = "sales", -year) | |||||
| #> # A tibble: 6 x 3 | |||||
| #> year person sales | |||||
| #> <int> <chr> <dbl> | |||||
| #> 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. | |||||
| ``` r | |||||
| animate_spread(long, key = "person", value = "sales") | |||||
| ``` | |||||
| <!-- --> | |||||
| ``` r | |||||
| tidyr::spread(long, key = "person", value = "sales") | |||||
| #> # A tibble: 2 x 4 | |||||
| #> year Alice Bob Charlie | |||||
| #> <dbl> <dbl> <dbl> <dbl> | |||||
| #> 1 2010 105 100 90 | |||||
| #> 2 2011 110 97 95 | |||||
| ``` | ``` | ||||
| ## Tidy Data | |||||
| ## Learn More | |||||
| [Tidy data](http://r4ds.had.co.nz/tidy-data.html#tidy-data-1) follows | [Tidy data](http://r4ds.had.co.nz/tidy-data.html#tidy-data-1) follows | ||||
| the following three rules: | the following three rules: |
+ 96
- 0
images/create_images.R
View File
| library(tidyAnimatedVerbs) | |||||
| library(here) | |||||
| check_and_create <- function(ff) { | |||||
| if (!dir.exists(ff)) dir.create(ff, recursive = T) | |||||
| } | |||||
| x <- data_frame( | |||||
| id = 1:3, | |||||
| x = paste0("x", 1:3) | |||||
| ) | |||||
| y <- data_frame( | |||||
| id = (1:4)[-3], | |||||
| y = paste0("y", (1:4)[-3]) | |||||
| ) | |||||
| check_and_create(here("images", "static", "png")) | |||||
| 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(gif_, here("images", 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) | |||||
| }) | |||||
| # instr_extra <- instr %>% slice(c(1, 1:n())) | |||||
| # animate_left_join(singer, instr_extra, by = c("name", "band")) # <- NOT WORKING | |||||
| 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(gif_, here("images", 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) | |||||
| }) |
+ 0
- 7
install.R
View File
| 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") |
+ 40
- 0
man/add_color_join.Rd
View File
| % 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, color_header = "#737373", | |||||
| color_other = "#d0d0d0", color_missing = "#ffffff", | |||||
| color_fun = scales::brewer_pal(type = "qual", "Set1"), | |||||
| text_color = NA, ...) | |||||
| } | |||||
| \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{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} | |||||
| \item{...}{} | |||||
| } | |||||
| \value{ | |||||
| the processed data_frame with a new column .color | |||||
| } | |||||
| \description{ | |||||
| Adds Color to a processed data_frame | |||||
| } | |||||
| \examples{ | |||||
| NULL | |||||
| } |
+ 29
- 0
man/add_color_tidyr.Rd
View File
| % 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 | |||||
| } |
+ 57
- 0
man/anim_options.Rd
View File
| % Generated by roxygen2: do not edit by hand | |||||
| % Please edit documentation in R/animate_options.R | |||||
| \name{anim_options} | |||||
| \alias{anim_options} | |||||
| \alias{anim_options_set} | |||||
| \title{Animation Options} | |||||
| \usage{ | |||||
| anim_options(transition_length = NULL, state_length = NULL, | |||||
| ease_default = NULL, ease_other = NULL, enter = NULL, | |||||
| exit = NULL, text_family = NULL, title_family = NULL, | |||||
| text_size = NULL, title_size = NULL, ...) | |||||
| anim_options_set(anim_opts = anim_options()) | |||||
| } | |||||
| \arguments{ | |||||
| \item{transition_length}{The relative length of the transition. Will be | |||||
| recycled to match the number of states in the data} | |||||
| \item{state_length}{The relative length of the pause at the states. Will be | |||||
| recycled to match the number of states in the data} | |||||
| \item{ease_default}{Default aes easing function. See \code{\link[tweenr:display_ease]{tweenr::display_ease()}} | |||||
| for more options. The tidyexplain default value is \code{sine-in-out}.} | |||||
| \item{ease_other}{Additional aes easing options, specified as a named list. | |||||
| List entries are named with the aesthetic to which the easeing should be | |||||
| applied, consistent with \code{\link[gganimate:ease_aes]{gganimate::ease_aes()}}. E.g. \code{list(color = "sine")}.} | |||||
| \item{enter}{Enter fading function applied to objects in the animation. See | |||||
| \link[gganimate:enter_exit]{gganimate::enter_exit} for a complete list of options. The tidyexplain | |||||
| default is \code{\link[gganimate:enter_fade]{gganimate::enter_fade()}}.} | |||||
| \item{exit}{Exit fading function applied to objects in the animation. See | |||||
| \link[gganimate:enter_exit]{gganimate::enter_exit} for a complete list of options. The tidyexplain | |||||
| default is \code{\link[gganimate:exit_fade]{gganimate::exit_fade()}}.} | |||||
| \item{text_family}{Font family for the plot text, default is "Fira Mono". Use | |||||
| \code{\link[=set_font_size]{set_font_size()}} to set global default font sizes.} | |||||
| \item{title_family}{Font family for the plot title, default is "Fira Mono". | |||||
| Use \code{\link[=set_font_size]{set_font_size()}} to set global default font sizes.} | |||||
| \item{text_size}{Font size of the plot text, default is 5.} | |||||
| \item{title_size}{Font size of the plot title, default is 17.} | |||||
| \item{anim_opts}{An \code{\link[=anim_options]{anim_options()}} options list.} | |||||
| } | |||||
| \description{ | |||||
| Helper function to set animation and plotting options to be passed to | |||||
| \code{\link[=animate_plot]{animate_plot()}} and \code{\link[=static_plot]{static_plot()}}. | |||||
| } | |||||
| \section{Functions}{ | |||||
| \itemize{ | |||||
| \item \code{anim_options_set}: Set default animation options for the current session. | |||||
| }} | |||||
+ 49
- 0
man/animate_gather.Rd
View File
| % 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) | |||||
| } | |||||
| } |
+ 93
- 0
man/animate_join.Rd
View File
| % 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 static_plot} | |||||
| } | |||||
| \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 | |||||
| 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}} | |||||
| } |
+ 25
- 0
man/animate_plot.Rd
View File
| % 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 | |||||
| } |
+ 85
- 0
man/animate_set.Rd
View File
| % 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 static_plot} | |||||
| } | |||||
| \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_other = "lightblue", | |||||
| color_fun = viridis::viridis | |||||
| ) | |||||
| } | |||||
| # Save the results | |||||
| \dontrun{ | |||||
| # to save the ggplot, use | |||||
| un <- animate_union(x, y, by = "id", export = "last") | |||||
| ggsave("union.pdf", un) | |||||
| animate_union(x, y, by = "id", export = "gif") | |||||
| # to save the gif, use | |||||
| un <- animate_union(x, y, by = "id", export = "gif") | |||||
| anim_save(un, "union.gif") | |||||
| } | |||||
| } | |||||
| \seealso{ | |||||
| \code{\link[dplyr]{setops}} | |||||
| } |
+ 47
- 0
man/animate_spread.Rd
View File
| % 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) | |||||
| } | |||||
| } |
+ 21
- 0
man/dput_parser.Rd
View File
| % 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")) | |||||
| } |
BIN
man/figures/tidyexplain-anti-join-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 922KB |
BIN
man/figures/tidyexplain-full-join-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 887KB |
BIN
man/figures/tidyexplain-gather-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 599KB |
BIN
man/figures/tidyexplain-inner-join-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 937KB |
BIN
man/figures/tidyexplain-intersect-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 543KB |
BIN
man/figures/tidyexplain-intial-dfs-1.png
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 14KB |
BIN
man/figures/tidyexplain-intial-dfs-so-1.png
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 9.1KB |
BIN
man/figures/tidyexplain-left-join-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 962KB |
BIN
man/figures/tidyexplain-left-join-extra-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 1.0MB |
BIN
man/figures/tidyexplain-right-join-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 952KB |
BIN
man/figures/tidyexplain-semi-join-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 923KB |
BIN
man/figures/tidyexplain-setdiff-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 595KB |
BIN
man/figures/tidyexplain-setdiff-y-x-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 568KB |
BIN
man/figures/tidyexplain-spread-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 628KB |
BIN
man/figures/tidyexplain-union-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 575KB |
BIN
man/figures/tidyexplain-union-all-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 565KB |
BIN
man/figures/tidyexplain-union-y-x-1.gif
View File
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 573KB |
+ 36
- 0
man/gather_spread.Rd
View File
| % 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 | |||||
| } |
+ 23
- 0
man/get_quos_names.Rd
View File
| % 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) | |||||
| } |
+ 25
- 0
man/move_together.Rd
View File
| % 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 | |||||
| } |
+ 12
- 0
man/pipe.Rd
View File
| % 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} |
+ 32
- 0
man/process_data_join.Rd
View File
| % 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, ...) | |||||
| } | |||||
| \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} | |||||
| } | |||||
| \value{ | |||||
| a data_frame including all necessary information | |||||
| } | |||||
| \description{ | |||||
| Processes the data | |||||
| } | |||||
| \examples{ | |||||
| NULL | |||||
| } |
+ 31
- 0
man/process_join.Rd
View File
| % 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, ...) | |||||
| } | |||||
| \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} | |||||
| } | |||||
| \value{ | |||||
| a preprocessed dataset | |||||
| } | |||||
| \description{ | |||||
| Preprocess data | |||||
| } | |||||
| \examples{ | |||||
| NULL | |||||
| test for | |||||
| a <- c("unique", "mult", "mult", "also unique") | |||||
| add_duplicate_number(a) | |||||
| } |
+ 32
- 0
man/process_long.Rd
View File
| % 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 | |||||
| } |
+ 35
- 0
man/process_wide.Rd
View File
| % 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 | |||||
| } |
+ 25
- 0
man/set_font_size.Rd
View File
| % 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 | |||||
| }} | |||||
+ 50
- 0
man/static_plot.Rd
View File
| % 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{text_family}{Font family for the plot text, default is "Fira Mono". Use | |||||
| \code{\link[=set_font_size]{set_font_size()}} to set global default font sizes.} | |||||
| \item{title_family}{Font family for the plot title, default is "Fira Mono". | |||||
| Use \code{\link[=set_font_size]{set_font_size()}} to set global default font sizes.} | |||||
| \item{text_size}{Font size of the plot text, default is 5.} | |||||
| \item{title_size}{Font size of the plot title, default is 17.} | |||||
| \item{ease_default}{Default aes easing function. See \code{\link[tweenr:display_ease]{tweenr::display_ease()}} | |||||
| for more options. The tidyexplain default value is \code{sine-in-out}.} | |||||
| \item{ease_other}{Additional aes easing options, specified as a named list. | |||||
| List entries are named with the aesthetic to which the easeing should be | |||||
| applied, consistent with \code{\link[gganimate:ease_aes]{gganimate::ease_aes()}}. E.g. \code{list(color = "sine")}.} | |||||
| \item{enter}{Enter fading function applied to objects in the animation. See | |||||
| \link[gganimate:enter_exit]{gganimate::enter_exit} for a complete list of options. The tidyexplain | |||||
| default is \code{\link[gganimate:enter_fade]{gganimate::enter_fade()}}.} | |||||
| \item{exit}{Exit fading function applied to objects in the animation. See | |||||
| \link[gganimate:enter_exit]{gganimate::enter_exit} for a complete list of options. The tidyexplain | |||||
| default is \code{\link[gganimate:exit_fade]{gganimate::exit_fade()}}.} | |||||
| \item{transition_length}{The relative length of the transition. Will be | |||||
| recycled to match the number of states in the data} | |||||
| \item{state_length}{The relative length of the pause at the states. Will be | |||||
| recycled to match the number of states in the data} | |||||
| }} | |||||
| \item{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 | |||||
| } |
+ 26
- 0
man/tidyexplain-package.Rd
View File
| % 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} |
+ 0
- 1
runtime.txt
View File
| r-2018-08-15 |
+ 4
- 0
tests/testthat.R
View File
| library(testthat) | |||||
| library(tidyverbs) | |||||
| test_check("tidyverbs") |
+ 49
- 0
tests/testthat/test-anim_options.R
View File
| 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() | |||||
| }) |
+ 6
- 0
tests/testthat/test-choose_text_color.R
View File
| 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))) | |||||
| }) |
+ 12
- 0
tests/testthat/test-tidyr_helpers.R
View File
| 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")') | |||||
| }) |
tidy-animated-verbs.Rproj → tidyexplain.Rproj
View File
Loading…