David
il y a 7 ans
79 fichiers modifiés avec 2783 ajouts et 1005 suppressions
+ 3
- 0
.Rbuildignore
Voir le fichier
| @@ -0,0 +1,3 @@ | |||
| ^LICENSE\.md$ | |||
| ^.*\.Rproj$ | |||
| ^\.Rproj\.user$ | |||
+ 41
- 0
DESCRIPTION
Voir le fichier
| @@ -0,0 +1,41 @@ | |||
| Type: Package | |||
| Package: tidyexplain | |||
| Title: Animated Explanations of Tidyverse Verbs | |||
| Version: 0.0.1.9000 | |||
| Date: 2018-08-27 | |||
| Authors@R: | |||
| c(person(given = "Garrick", | |||
| family = "Aden-Buie", | |||
| role = c("aut", "cre"), | |||
| email = "g.adenbuie@gmail.com"), | |||
| person(given = "David", | |||
| family = "Zimmermann", | |||
| role = "aut", | |||
| email = "david_j_zimmermann@hotmail.com"), | |||
| person(given = "Tyler Grant", | |||
| family = "Smith", | |||
| role = "ctb")) | |||
| Description: Animated explanations of the verbs in the tidyverse | |||
| using gganimate and ggplot2. | |||
| License: MIT + file LICENSE | |||
| Depends: | |||
| gganimate (>= 0.9.9.9999), | |||
| ggplot2 (>= 3.0.0) | |||
| Imports: | |||
| dplyr, | |||
| magrittr, | |||
| purrr, | |||
| rlang (>= 0.1.2), | |||
| scales, | |||
| tidyr, | |||
| tidyselect | |||
| Suggests: | |||
| knitr, | |||
| roxygen2, | |||
| testthat, | |||
| viridis | |||
| VignetteBuilder: | |||
| knitr | |||
| Encoding: UTF-8 | |||
| Roxygen: list(markdown = TRUE) | |||
| RoxygenNote: 6.1.1 | |||
+ 2
- 116
LICENSE
Voir le fichier
| @@ -1,116 +1,2 @@ | |||
| CC0 1.0 Universal | |||
| Statement of Purpose | |||
| The laws of most jurisdictions throughout the world automatically confer | |||
| exclusive Copyright and Related Rights (defined below) upon the creator and | |||
| subsequent owner(s) (each and all, an "owner") of an original work of | |||
| authorship and/or a database (each, a "Work"). | |||
| Certain owners wish to permanently relinquish those rights to a Work for the | |||
| purpose of contributing to a commons of creative, cultural and scientific | |||
| works ("Commons") that the public can reliably and without fear of later | |||
| claims of infringement build upon, modify, incorporate in other works, reuse | |||
| and redistribute as freely as possible in any form whatsoever and for any | |||
| purposes, including without limitation commercial purposes. These owners may | |||
| contribute to the Commons to promote the ideal of a free culture and the | |||
| further production of creative, cultural and scientific works, or to gain | |||
| reputation or greater distribution for their Work in part through the use and | |||
| efforts of others. | |||
| For these and/or other purposes and motivations, and without any expectation | |||
| of additional consideration or compensation, the person associating CC0 with a | |||
| Work (the "Affirmer"), to the extent that he or she is an owner of Copyright | |||
| and Related Rights in the Work, voluntarily elects to apply CC0 to the Work | |||
| and publicly distribute the Work under its terms, with knowledge of his or her | |||
| Copyright and Related Rights in the Work and the meaning and intended legal | |||
| effect of CC0 on those rights. | |||
| 1. Copyright and Related Rights. A Work made available under CC0 may be | |||
| protected by copyright and related or neighboring rights ("Copyright and | |||
| Related Rights"). Copyright and Related Rights include, but are not limited | |||
| to, the following: | |||
| i. the right to reproduce, adapt, distribute, perform, display, communicate, | |||
| and translate a Work; | |||
| ii. moral rights retained by the original author(s) and/or performer(s); | |||
| iii. publicity and privacy rights pertaining to a person's image or likeness | |||
| depicted in a Work; | |||
| iv. rights protecting against unfair competition in regards to a Work, | |||
| subject to the limitations in paragraph 4(a), below; | |||
| v. rights protecting the extraction, dissemination, use and reuse of data in | |||
| a Work; | |||
| vi. database rights (such as those arising under Directive 96/9/EC of the | |||
| European Parliament and of the Council of 11 March 1996 on the legal | |||
| protection of databases, and under any national implementation thereof, | |||
| including any amended or successor version of such directive); and | |||
| vii. other similar, equivalent or corresponding rights throughout the world | |||
| based on applicable law or treaty, and any national implementations thereof. | |||
| 2. Waiver. To the greatest extent permitted by, but not in contravention of, | |||
| applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and | |||
| unconditionally waives, abandons, and surrenders all of Affirmer's Copyright | |||
| and Related Rights and associated claims and causes of action, whether now | |||
| known or unknown (including existing as well as future claims and causes of | |||
| action), in the Work (i) in all territories worldwide, (ii) for the maximum | |||
| duration provided by applicable law or treaty (including future time | |||
| extensions), (iii) in any current or future medium and for any number of | |||
| copies, and (iv) for any purpose whatsoever, including without limitation | |||
| commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes | |||
| the Waiver for the benefit of each member of the public at large and to the | |||
| detriment of Affirmer's heirs and successors, fully intending that such Waiver | |||
| shall not be subject to revocation, rescission, cancellation, termination, or | |||
| any other legal or equitable action to disrupt the quiet enjoyment of the Work | |||
| by the public as contemplated by Affirmer's express Statement of Purpose. | |||
| 3. Public License Fallback. Should any part of the Waiver for any reason be | |||
| judged legally invalid or ineffective under applicable law, then the Waiver | |||
| shall be preserved to the maximum extent permitted taking into account | |||
| Affirmer's express Statement of Purpose. In addition, to the extent the Waiver | |||
| is so judged Affirmer hereby grants to each affected person a royalty-free, | |||
| non transferable, non sublicensable, non exclusive, irrevocable and | |||
| unconditional license to exercise Affirmer's Copyright and Related Rights in | |||
| the Work (i) in all territories worldwide, (ii) for the maximum duration | |||
| provided by applicable law or treaty (including future time extensions), (iii) | |||
| in any current or future medium and for any number of copies, and (iv) for any | |||
| purpose whatsoever, including without limitation commercial, advertising or | |||
| promotional purposes (the "License"). The License shall be deemed effective as | |||
| of the date CC0 was applied by Affirmer to the Work. Should any part of the | |||
| License for any reason be judged legally invalid or ineffective under | |||
| applicable law, such partial invalidity or ineffectiveness shall not | |||
| invalidate the remainder of the License, and in such case Affirmer hereby | |||
| affirms that he or she will not (i) exercise any of his or her remaining | |||
| Copyright and Related Rights in the Work or (ii) assert any associated claims | |||
| and causes of action with respect to the Work, in either case contrary to | |||
| Affirmer's express Statement of Purpose. | |||
| 4. Limitations and Disclaimers. | |||
| a. No trademark or patent rights held by Affirmer are waived, abandoned, | |||
| surrendered, licensed or otherwise affected by this document. | |||
| b. Affirmer offers the Work as-is and makes no representations or warranties | |||
| of any kind concerning the Work, express, implied, statutory or otherwise, | |||
| including without limitation warranties of title, merchantability, fitness | |||
| for a particular purpose, non infringement, or the absence of latent or | |||
| other defects, accuracy, or the present or absence of errors, whether or not | |||
| discoverable, all to the greatest extent permissible under applicable law. | |||
| c. Affirmer disclaims responsibility for clearing rights of other persons | |||
| that may apply to the Work or any use thereof, including without limitation | |||
| any person's Copyright and Related Rights in the Work. Further, Affirmer | |||
| disclaims responsibility for obtaining any necessary consents, permissions | |||
| or other rights required for any use of the Work. | |||
| d. Affirmer understands and acknowledges that Creative Commons is not a | |||
| party to this document and has no duty or obligation with respect to this | |||
| CC0 or use of the Work. | |||
| For more information, please see | |||
| <http://creativecommons.org/publicdomain/zero/1.0/> | |||
| YEAR: 2018 | |||
| COPYRIGHT HOLDER: Garrick Aden-Buie | |||
+ 21
- 0
LICENSE.md
Voir le fichier
| @@ -0,0 +1,21 @@ | |||
| # MIT License | |||
| Copyright (c) 2018 Garrick Aden-Buie | |||
| Permission is hereby granted, free of charge, to any person obtaining a copy | |||
| of this software and associated documentation files (the "Software"), to deal | |||
| in the Software without restriction, including without limitation the rights | |||
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |||
| copies of the Software, and to permit persons to whom the Software is | |||
| furnished to do so, subject to the following conditions: | |||
| The above copyright notice and this permission notice shall be included in all | |||
| copies or substantial portions of the Software. | |||
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | |||
| IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |||
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | |||
| AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |||
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, | |||
| OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE | |||
| SOFTWARE. | |||
+ 41
- 0
NAMESPACE
Voir le fichier
| @@ -0,0 +1,41 @@ | |||
| # 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
Voir le fichier
| @@ -1,37 +0,0 @@ | |||
| # Animated dplyr joins with gganimate | |||
| # * Garrick Aden-Buie | |||
| # * garrickadenbuie.com | |||
| # * MIT License: https://opensource.org/licenses/MIT | |||
| library(tidyverse) | |||
| library(gganimate) | |||
| if (!getOption("tidy_verb_anim.font_registered", FALSE)) { | |||
| source(here::here("R", "01_register-fonts.R")) | |||
| } | |||
| if (!getOption("tidy_verb_anim.functions_loaded", FALSE)) { | |||
| source(here::here("R", "02_functions.R")) | |||
| } | |||
| source(here::here("R", "03_check-folders.R")) | |||
| plot_data_join <- function(x, title = "", xlims = xlim(0.5, 5.5), ylims = ylim(-3.5, -0.5)) { | |||
| plot_data(x, title) + | |||
| xlims + ylims | |||
| } | |||
| # Data ---- | |||
| x <- data_frame( | |||
| id = 1:3, | |||
| x = paste0("x", 1:3) | |||
| ) | |||
| y <- data_frame( | |||
| id = (1:4)[-3], | |||
| y = paste0("y", (1:4)[-3]) | |||
| ) | |||
| initial_join_dfs <- proc_data(x, "x") %>% | |||
| bind_rows(mutate(proc_data(y, "y"), .x = .x + 3)) %>% | |||
| mutate(frame = 1) | |||
+ 0
- 50
R/00_base_set.R
Voir le fichier
| @@ -1,50 +0,0 @@ | |||
| # 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
Voir le fichier
| @@ -1,7 +0,0 @@ | |||
| # Note: I used Fira Sans and Mono (downloaded here from Google Fonts). | |||
| # Feel free to change font names below for desired fonts. | |||
| sysfonts::font_add_google("Fira Sans") | |||
| sysfonts::font_add_google("Fira Mono") | |||
| showtext::showtext_auto() | |||
| options(tidy_verb_anim.font_registered = TRUE) | |||
+ 0
- 112
R/02_functions.R
Voir le fichier
| @@ -1,112 +0,0 @@ | |||
| proc_data <- function(x, .id = "x", color_fun = colorize_keys, color_when = c("after", "before"), ...) { | |||
| color_when <- match.arg(color_when) | |||
| n_colors <- max(x$id) | |||
| if (color_when == "before") x <- color_fun(x, n_colors, ...) | |||
| x <- x %>% | |||
| mutate(.y = -row_number()) %>% | |||
| tidyr::gather("label", "value", setdiff(colnames(x), c(".y", "color"))) %>% | |||
| mutate(value = as.character(value)) %>% | |||
| group_by(.y) %>% | |||
| mutate( | |||
| .x = 1:n(), | |||
| .id = .id, | |||
| .width = 1 | |||
| ) %>% | |||
| ungroup(.y) | |||
| if (color_when == "after") x <- color_fun(x, n_colors, ...) | |||
| x | |||
| } | |||
| colorize_keys <- function(df, n_colors, key_col = "id", color_other = "#d0d0d0", color_missing = "#ffffff") { | |||
| # Assumes that key_col is integer | |||
| colors <- scales::brewer_pal(type = "qual", "Set1")(n_colors) | |||
| mutate( | |||
| df, | |||
| color = ifelse(label == key_col, value, n_colors + 1), | |||
| color = colors[as.integer(color)], | |||
| color = ifelse(is.na(color), "#d0d0d0", color), | |||
| color = ifelse(is.na(value), "#ffffff", color) | |||
| ) | |||
| } | |||
| colorize_row_id <- function(df, n_colors, key_col = "id") { | |||
| # Assumes that key_col is integer | |||
| colors <- scales::brewer_pal(type = "qual", "Set1")(n_colors) | |||
| df$color <- colors[df[[key_col]]] | |||
| df | |||
| } | |||
| colorize_wide_tidyr <- function(df, n_colors, key_col = "id") { | |||
| n_colors <- n_colors + length(setdiff(unique(df$label), key_col)) | |||
| colors <- scales::brewer_pal(type = "qual", "Set1")(n_colors) | |||
| df$value_int <- as.integer(gsub("[a-zA-Z]", "0", df$value)) | |||
| max_id_color <- max(df$value_int) | |||
| df %>% | |||
| bind_rows( | |||
| filter(df, .y == "-1") %>% mutate(.y = 0) | |||
| ) %>% | |||
| mutate( | |||
| idcp = max_id_color - 1L, | |||
| idc = case_when( | |||
| label == "id" ~ value_int, | |||
| TRUE ~ map_int(label, ~which(. == unique(label))) + idcp | |||
| ) | |||
| ) %>% | |||
| select(-idcp, -value_int) %>% | |||
| mutate( | |||
| idc = ifelse(.y == 0 & label == "id", 100, idc), | |||
| value = ifelse(.y == 0, label, value), | |||
| .id = ifelse(.y == 0, "n", .id), | |||
| color = colors[idc], | |||
| ) %>% | |||
| filter(!is.na(color)) %>% | |||
| mutate(alpha = ifelse(label != "id" & .y < 0, 0.6, 1.0)) %>% | |||
| select(-idc) | |||
| } | |||
| plot_data <- function(x, title = "") { | |||
| if (!"alpha" %in% colnames(x)) x$alpha <- 1 | |||
| if (!".text_color" %in% colnames(x)) x$`.text_color` <- "white" | |||
| if (!".text_size" %in% colnames(x)) x$`.text_size` <- 12 | |||
| ggplot(x) + | |||
| aes(.x, .y, fill = color, label = value) + | |||
| geom_tile(aes(alpha = alpha), width = 0.9, height = 0.9) + | |||
| geom_text(aes(x = .x, color = .text_color, size = .text_size), hjust = 0.5, family = "Fira Sans") + | |||
| scale_fill_identity() + | |||
| scale_alpha_identity() + | |||
| scale_color_identity() + | |||
| scale_size_identity() + | |||
| coord_equal() + | |||
| ggtitle(title) + | |||
| theme_void() + | |||
| theme(plot.title = element_text(family = "Fira Mono", hjust = 0.5, size = 24)) + | |||
| guides(fill = FALSE) | |||
| } | |||
| animate_plot <- function(x, transition_length = 2, state_length = 1) { | |||
| x + | |||
| transition_states(frame, transition_length, state_length) + | |||
| enter_fade() + | |||
| exit_fade() + | |||
| ease_aes("sine-in-out") | |||
| } | |||
| save_static_plot <- function(g, filename, formats = c("png", "svg")) { | |||
| filenames <- formats %>% | |||
| purrr::set_names() %>% | |||
| purrr::map_chr(static_plot_filename, x = filename) %>% | |||
| purrr::iwalk( | |||
| ~ ggsave(filename = .x, plot = g, dev = .y) | |||
| ) | |||
| } | |||
| static_plot_filename <- function(x, ext) { | |||
| here::here("images", "static", ext, paste0(x, ".", ext)) | |||
| } | |||
| options(tidy_verb_anim.functions_loaded = TRUE) | |||
+ 0
- 5
R/03_check-folders.R
Voir le fichier
| @@ -1,5 +0,0 @@ | |||
| if (!dir.exists(here::here("images"))) dir.create(here::here("images")) | |||
| png_path <- here::here("images", "static", "png") | |||
| svg_path <- here::here("images", "static", "svg") | |||
| if (!dir.exists(png_path)) dir.create(png_path, recursive = TRUE) | |||
| if (!dir.exists(svg_path)) dir.create(svg_path, recursive = TRUE) | |||
+ 150
- 0
R/animate_joins.R
Voir le fichier
| @@ -0,0 +1,150 @@ | |||
| #' Animates a join operation | |||
| #' | |||
| #' Functions to visualise the join operations either static as a ggplot, or | |||
| #' dynamic as a gif. | |||
| #' | |||
| #' @param x the x dataset | |||
| #' @param y the y dataset | |||
| #' @param by the by arguments for the join | |||
| #' @param export the export type, either gif, first or last. The latter two | |||
| #' export ggplots of the first/last state of the join | |||
| #' @param ... further arguments passed to 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
Voir le fichier
| @@ -0,0 +1,213 @@ | |||
| #' 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
Voir le fichier
| @@ -0,0 +1,134 @@ | |||
| #' 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
Voir le fichier
| @@ -0,0 +1,123 @@ | |||
| #' Animates the gather function | |||
| #' | |||
| #' @param w a data_frame in the wide format | |||
| #' @param key the key | |||
| #' @param value the value | |||
| #' @param ... further arguments passed to [tidyr::gather()], [process_wide()], | |||
| #' or [process_long()] | |||
| #' @param detailed boolean value if the animation should show one step for each | |||
| #' key value | |||
| #' @inheritParams animate_join | |||
| #' @inheritParams anim_options | |||
| #' | |||
| #' @return a gif or a ggplot | |||
| #' @export | |||
| #' | |||
| #' @examples | |||
| #' wide <- data_frame( | |||
| #' year = 2010:2011, | |||
| #' Alice = c(105, 110), | |||
| #' Bob = c(100, 97), | |||
| #' Charlie = c(90, 95) | |||
| #' ) | |||
| #' animate_gather(wide, "person", "sales", -year, export = "first") | |||
| #' animate_gather(wide, "person", "sales", -year, export = "last") | |||
| #' | |||
| #' \donttest{ | |||
| #' animate_gather(wide, "person", "sales", -year, export = "gif") | |||
| #' # if you want to have a less detailed animation, you can also use | |||
| #' animate_gather(wide, "person", "sales", -year, export = "gif", detailed = FALSE) | |||
| #' } | |||
| animate_gather <- function(w, key, value, ..., export = "gif", detailed = TRUE, anim_opts = anim_options()) { | |||
| anim_opts <- default_anim_opts("gather", anim_opts) | |||
| lhs <- w | |||
| rhs <- tidyr::gather(w, !!key, !!value, ...) | |||
| # construct the title sequence | |||
| wname <- deparse(substitute(w)) | |||
| tidyr_selection <- get_quos_names(...) | |||
| ids <- setdiff(colnames(w), tidyselect::vars_select(colnames(w), ...)) | |||
| id_string <- paste0(", ", paste(sprintf("%s", tidyr_selection), collapse = ", ")) | |||
| sequence <- c( | |||
| current_state = "wide", | |||
| final_state = "long", | |||
| operation = sprintf("gather(%s, %s, %s%s)", | |||
| wname, | |||
| dput_parser(key), | |||
| dput_parser(value), | |||
| id_string), | |||
| reverse_operation = sprintf("spread(%s, %s, %s)", | |||
| "long", | |||
| dput_parser(key), | |||
| dput_parser(value)) | |||
| ) | |||
| key_values <- rhs %>% pull(key) %>% unique() | |||
| lhs_proc <- process_wide(lhs, ids, key, key_values, value, ...) | |||
| rhs_proc <- process_long(rhs, ids, key, value, ...) | |||
| gather_spread(lhs_proc, rhs_proc, sequence = sequence, key_values = key_values, | |||
| export = export, detailed = detailed, ..., anim_opts = anim_opts) | |||
| } | |||
| #' Animates the spread function | |||
| #' | |||
| #' @param l a data_frame in the long/tidy format | |||
| #' @param ... further arguments passed to [process_long] or [process_wide] | |||
| #' @inheritParams animate_gather | |||
| #' @inheritParams animate_join | |||
| #' @inheritParams anim_options | |||
| #' | |||
| #' @return a ggplot or a gif | |||
| #' @export | |||
| #' | |||
| #' @examples | |||
| #' long <- data_frame( | |||
| #' year = c(2010L, 2011L, 2010L, 2011L, 2010L, 2011L), | |||
| #' person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), | |||
| #' sales = c(105, 110, 100, 97, 90, 95) | |||
| #' ) | |||
| #' animate_spread(long, key = "person", value = "sales", export = "first") | |||
| #' animate_spread(long, key = "person", value = "sales", export = "last") | |||
| #' | |||
| #' \donttest{ | |||
| #' animate_spread(long, key = "person", value = "sales", export = "gif") | |||
| #' # if you want to have a less detailed animation, you can also use | |||
| #' animate_spread(long, key = "person", value = "sales", export = "gif", detailed = FALSE) | |||
| #' } | |||
| animate_spread <- function(l, key, value, export = "gif", detailed = TRUE, ..., anim_opts = anim_options()) { | |||
| anim_opts <- default_anim_opts("spread", anim_opts) | |||
| lhs <- l | |||
| rhs <- tidyr::spread(l, key = key, value = value) | |||
| # construct the title sequence | |||
| lname <- deparse(substitute(l)) | |||
| ids <- names(lhs) | |||
| ids <- ids[!ids %in% c(key, value)] | |||
| id_string <- paste0(", ", paste(sprintf("-%s", ids), collapse = ", ")) | |||
| sequence <- c( | |||
| current_state = "long", | |||
| final_state = "wide", | |||
| operation = sprintf("spread(%s, %s, %s)", | |||
| lname, | |||
| dput_parser(key), | |||
| dput_parser(value)), | |||
| reverse_operation = sprintf("gather(%s, %s, %s%s)", | |||
| "wide", | |||
| dput_parser(key), | |||
| dput_parser(value), | |||
| id_string) | |||
| ) | |||
| lhs_proc <- process_long(lhs, ids, key, value, ...) | |||
| rhs_proc <- process_wide(rhs, ids, key, value, ...) | |||
| key_values <- lhs %>% pull(key) %>% unique() | |||
| gather_spread(lhs_proc, rhs_proc, sequence, key_values, export, detailed, ..., anim_opts = anim_opts) | |||
| } | |||
+ 0
- 48
R/anti_join.R
Voir le fichier
| @@ -1,48 +0,0 @@ | |||
| source(here::here("R/00_base_join.R")) | |||
| initial_join_dfs <- initial_join_dfs %>% | |||
| arrange(.x, .y) %>% | |||
| mutate(.obj = row_number(), .obj = .obj + 90 * as.integer(.id == "y")) | |||
| aj_step2 <- initial_join_dfs %>% | |||
| filter(.id == "x" | value %in% paste(1:2)) %>% | |||
| mutate(frame = 2, | |||
| .x = ifelse(.id == "y", 2.5, .x + 1.5), | |||
| alpha = case_when( | |||
| .x > 3 && .id == "x" ~ 0.5, | |||
| .y > -2.5 ~ 0.25, | |||
| TRUE ~ 1 | |||
| )) | |||
| aj_step3 <- aj_step2 %>% | |||
| filter(alpha == 1) %>% | |||
| mutate(frame = 3) | |||
| aj_step4 <- aj_step2 %>% | |||
| filter(alpha == 1) %>% | |||
| mutate(frame = 4, .y = -1) | |||
| aj <- bind_rows( | |||
| initial_join_dfs, | |||
| aj_step2, | |||
| aj_step3, | |||
| aj_step4 | |||
| ) %>% | |||
| mutate( | |||
| alpha = ifelse(is.na(alpha), 1, alpha), | |||
| .obj = ifelse(value == 4, 0, .obj) | |||
| ) %>% | |||
| arrange(.obj, frame) %>% | |||
| plot_data("anti_join(x, y)") %>% | |||
| animate_plot(transition_length = c(2, 1, 2), | |||
| state_length = c(1, 0, 0, 1)) | |||
| aj <- animate(aj) | |||
| anim_save(here::here("images", "anti-join.gif"), aj) | |||
| aj_g <- anti_join(x, y, by = "id") %>% | |||
| proc_data() %>% | |||
| mutate(.x = .x + 1.5) %>% | |||
| plot_data_join("anti_join(x, y)") | |||
| save_static_plot(aj_g, "anti-join") | |||
+ 0
- 29
R/full_join.R
Voir le fichier
| @@ -1,29 +0,0 @@ | |||
| source(here::here("R/00_base_join.R")) | |||
| fj_joined_df <- full_join(x, y, "id") %>% | |||
| proc_data("x") %>% | |||
| mutate(.id = ifelse(value %in% c("4", "y4"), "y", .id)) %>% | |||
| mutate(frame = 2, .x = .x + 1) | |||
| fj_extra_blocks <- inner_join(x, y, "id") %>% | |||
| select(id) %>% | |||
| proc_data("y") %>% | |||
| mutate(frame = 2, .x = .x + 1) | |||
| fj <- initial_join_dfs %>% | |||
| bind_rows(fj_joined_df, fj_extra_blocks) %>% | |||
| plot_data("full_join(x, y)") + | |||
| transition_states(frame, transition_length = 2, state_length = 1) + | |||
| enter_appear() + | |||
| exit_disappear(early = TRUE) + | |||
| ease_aes("sine-in-out") | |||
| fj <- animate(fj) | |||
| anim_save(here::here("images", "full-join.gif"), fj) | |||
| fj_g <- full_join(x, y, "id") %>% | |||
| proc_data() %>% | |||
| mutate(.x = .x + 1) %>% | |||
| plot_data_join("full_join(x, y)", ylims = ylim(-4.5, -0.5)) | |||
| save_static_plot(fj_g, "full-join") | |||
+ 0
- 29
R/inner_join.R
Voir le fichier
| @@ -1,29 +0,0 @@ | |||
| source(here::here("R/00_base_join.R")) | |||
| ij_joined_df <- inner_join(x, y, "id") | |||
| ij_joined_df <- bind_rows( | |||
| proc_data(ij_joined_df, "x"), | |||
| proc_data(ij_joined_df, "y") | |||
| ) %>% | |||
| filter(!(label == "x" & .id == "y") & !(label == "y" & .id == "x")) %>% | |||
| mutate(frame = 2, .x = .x + 1) | |||
| ij <- bind_rows( | |||
| initial_join_dfs, | |||
| ij_joined_df | |||
| ) %>% | |||
| mutate(removed = value %in% c("3", "4", "x3", "y4"), | |||
| removed = as.integer(removed)) %>% | |||
| arrange(desc(frame), removed, desc(.id)) %>% | |||
| plot_data("inner_join(x, y)") %>% | |||
| animate_plot() | |||
| ij <- animate(ij) | |||
| anim_save(here::here("images", "inner-join.gif"), ij) | |||
| ij_g <- inner_join(x, y, by = "id") %>% | |||
| proc_data() %>% | |||
| mutate(.x = .x + 1) %>% | |||
| plot_data_join("inner_join(x, y)") | |||
| save_static_plot(ij_g, "inner-join") | |||
+ 0
- 28
R/intersect.R
Voir le fichier
| @@ -1,28 +0,0 @@ | |||
| source(here::here("R/00_base_set.R")) | |||
| ins_df <- intersect(x,y) | |||
| ins_step2 <- | |||
| bind_rows( | |||
| proc_data_set(ins_df, "x"), | |||
| proc_data_set(ins_df, "y") | |||
| ) %>% | |||
| filter(.y == -1) %>% | |||
| mutate(frame = 2, .x = .x + 1.5) | |||
| ins <- | |||
| initial_set_dfs %>% | |||
| bind_rows(ins_step2) %>% | |||
| arrange(desc(frame)) %>% | |||
| plot_data_set("intersect(x, y)") %>% | |||
| animate_plot() | |||
| ins <- animate(ins) | |||
| anim_save(here::here("images", "intersect.gif"), ins) | |||
| ins_g <- intersect(x, y) %>% | |||
| proc_data_set() %>% | |||
| mutate(.x = .x + 1.5) %>% | |||
| plot_data_set("intersect(x, y)") | |||
| save_static_plot(ins_g, "intersect") | |||
+ 0
- 27
R/left_join.R
Voir le fichier
| @@ -1,27 +0,0 @@ | |||
| source(here::here("R/00_base_join.R")) | |||
| lj_joined_dfs <- left_join(x, y, "id") %>% | |||
| proc_data("x") %>% | |||
| mutate(frame = 2, .x = .x + 1) | |||
| lj_extra_blocks <- inner_join(x, y, "id") %>% | |||
| select(id) %>% | |||
| proc_data("y") %>% | |||
| mutate(frame = 2, .x = .x + 1) | |||
| lj <- bind_rows( | |||
| initial_join_dfs, | |||
| lj_joined_dfs, | |||
| lj_extra_blocks | |||
| ) %>% | |||
| mutate(color = ifelse(is.na(value), "#ffffff", color)) %>% | |||
| arrange(value) %>% | |||
| plot_data("left_join(x, y)") %>% | |||
| animate_plot() | |||
| lj <- animate(lj) | |||
| anim_save(here::here("images", "left-join.gif"), lj) | |||
| lj_g <- plot_data_join(lj_joined_dfs, "left_join(x, y)") | |||
| save_static_plot(lj_g, "left-join") | |||
+ 0
- 71
R/left_join_extra.R
Voir le fichier
| @@ -1,71 +0,0 @@ | |||
| source(here::here("R/00_base_join.R")) | |||
| y_extra <- bind_rows(y, data_frame(id = 2, y = "y5")) | |||
| # I manually linked objects together, it was late and this was easier... | |||
| anim_df <- tibble::tribble( | |||
| ~.y, ~label, ~value, ~.x, ~.id, ~color, ~frame, ~obj, | |||
| -1L, "id", "1", 1, "x", "#E41A1C", 1, 1, | |||
| -2L, "id", "2", 1, "x", "#377EB8", 1, 2, | |||
| -2L, "id", "2", 1, "x", "#377EB8", 1, 3, | |||
| -3L, "id", "3", 1, "x", "#4DAF4A", 1, 4, | |||
| -1L, "x", "x1", 2, "x", "#d0d0d0", 1, 5, | |||
| -2L, "x", "x2", 2, "x", "#d0d0d0", 1, 6, | |||
| -3L, "x", "x3", 2, "x", "#d0d0d0", 1, 8, | |||
| -2L, "x", "x2", 2, "x", "#d0d0d0", 1, 7, | |||
| -1L, "id", "1", 4, "y", "#E41A1C", 1, 9, | |||
| -2L, "id", "2", 4, "y", "#377EB8", 1, 10, | |||
| -3L, "id", "4", 4, "y", "#984EA3", 1, 99, | |||
| -4L, "id", "2", 4, "y", "#377EB8", 1, 11, | |||
| -1L, "y", "y1", 5, "y", "#d0d0d0", 1, 12, | |||
| -2L, "y", "y2", 5, "y", "#d0d0d0", 1, 13, | |||
| -3L, "y", "y4", 5, "y", "#d0d0d0", 1, 98, | |||
| -4L, "y", "y5", 5, "y", "#d0d0d0", 1, 14, | |||
| -1L, "id", "1", 2, "x", "#E41A1C", 2, 1, | |||
| -2L, "id", "2", 2, "x", "#377EB8", 2, 2, | |||
| -3L, "id", "2", 2, "x", "#377EB8", 2, 3, | |||
| -4L, "id", "3", 2, "x", "#4DAF4A", 2, 4, | |||
| -1L, "x", "x1", 3, "x", "#d0d0d0", 2, 5, | |||
| -2L, "x", "x2", 3, "x", "#d0d0d0", 2, 6, | |||
| -3L, "x", "x2", 3, "x", "#d0d0d0", 2, 7, | |||
| -4L, "x", "x3", 3, "x", "#d0d0d0", 2, 8, | |||
| -1L, "y", "y1", 4, "x", "#d0d0d0", 2, 12, | |||
| -2L, "y", "y2", 4, "x", "#d0d0d0", 2, 13, | |||
| -3L, "y", "y5", 4, "x", "#d0d0d0", 2, 14, | |||
| -1L, "id", "1", 2, "y", "#E41A1C", 2, 9, | |||
| -2L, "id", "2", 2, "y", "#377EB8", 2, 10, | |||
| -3L, "id", "2", 2, "y", "#377EB8", 2, 11 | |||
| ) | |||
| lj_extra <- anim_df %>% | |||
| arrange(obj, frame) %>% | |||
| plot_data("left_join(x, y)") %>% | |||
| animate_plot() | |||
| lj_extra <- animate(lj_extra) | |||
| anim_save(here::here("images", "left-join-extra.gif"), lj_extra) | |||
| ## Save static images | |||
| df_names <- data_frame( | |||
| .x = c(1.5, 4.5), .y = 0.25, | |||
| value = c("x", "y"), | |||
| size = 12, | |||
| color = "black" | |||
| ) | |||
| g_input <- proc_data(y_extra) %>% | |||
| mutate(.x = .x + 3) %>% | |||
| bind_rows(proc_data(x)) %>% | |||
| plot_data() + | |||
| geom_text(data = df_names, family = "Fira Mono", size = 24) + | |||
| annotate("text", label = "↑ duplicate keys in y", x = 4.5, y = -4.75, | |||
| family = "Fira Sans", color = "grey45") | |||
| save_static_plot(g_input, "left-join-extra-input") | |||
| lj_g <- left_join(x, y_extra, by = "id") %>% | |||
| proc_data() %>% | |||
| mutate(.x = .x + 1) %>% | |||
| plot_data_join("left_join(x, y)", ylims = ylim(-4.5, -0.5)) | |||
| save_static_plot(lj_g, "left-join-extra") | |||
+ 105
- 0
R/move_together.R
Voir le fichier
| @@ -0,0 +1,105 @@ | |||
| #' Combines two processed datasets and combines them for a given method | |||
| #' | |||
| #' @param lhs the left-hand side dataset | |||
| #' @param rhs the righ-hand side dataset | |||
| #' @param type a string of the desired combination method, allowed are all dplyr | |||
| #' joins or sets | |||
| #' | |||
| #' @return processed dataset of the combined values | |||
| #' | |||
| #' @examples | |||
| #' NULL | |||
| move_together <- function(lhs, rhs, type) { | |||
| all <- bind_rows(lhs, rhs) | |||
| # separate column and row-filter (ids) | |||
| x_cols <- dplyr::distinct(lhs, .col) | |||
| y_cols <- dplyr::distinct(rhs, .col) | |||
| # separate header columns from ids and treat them as columns | |||
| x_ids <- dplyr::distinct(lhs, .id, .id_long) | |||
| y_ids <- dplyr::distinct(rhs, .id, .id_long) | |||
| x_headers <- filter(x_ids, grepl("^\\.header", .id_long)) | |||
| y_headers <- filter(y_ids, grepl("^\\.header", .id_long)) | |||
| x_ids <- x_ids %>% filter(!grepl("^\\.header", .id_long)) | |||
| y_ids <- y_ids %>% filter(!grepl("^\\.header", .id_long)) | |||
| # assign two combiner functions depending on the type | |||
| # one for combining the columns (col_combiner) | |||
| # one for combining the rows (row_combiner) | |||
| if (type == "full_join") { | |||
| col_combiner <- dplyr::full_join | |||
| row_combiner <- dplyr::full_join | |||
| } else if (type == "inner_join") { | |||
| col_combiner <- dplyr::full_join | |||
| row_combiner <- dplyr::inner_join | |||
| } else if (type == "left_join") { | |||
| col_combiner <- dplyr::full_join | |||
| row_combiner <- dplyr::left_join | |||
| } else if (type == "right_join") { | |||
| col_combiner <- dplyr::full_join | |||
| row_combiner <- dplyr::right_join | |||
| } else if (type == "semi_join") { | |||
| col_combiner <- dplyr::left_join | |||
| row_combiner <- dplyr::semi_join | |||
| } else if (type == "anti_join") { | |||
| col_combiner <- dplyr::left_join | |||
| row_combiner <- dplyr::anti_join | |||
| } else if (type == "union") { | |||
| col_combiner <- dplyr::full_join | |||
| row_combiner <- dplyr::union | |||
| } else if (type == "union_all") { | |||
| col_combiner <- dplyr::full_join | |||
| row_combiner <- dplyr::union_all | |||
| } else if (type == "intersect") { | |||
| col_combiner <- dplyr::full_join | |||
| row_combiner <- dplyr::intersect | |||
| } else if (type == "setdiff") { | |||
| col_combiner <- dplyr::full_join | |||
| row_combiner <- dplyr::anti_join | |||
| } else if (type == "bind_rows") { | |||
| col_combiner <- dplyr::full_join | |||
| row_combiner <- dplyr::bind_rows | |||
| } else if (type == "bind_cols") { | |||
| col_combiner <- dplyr::full_join | |||
| row_combiner <- dplyr::left_join | |||
| } else { | |||
| stop("Unknown func") | |||
| } | |||
| take_cols <- col_combiner(x_cols, y_cols, by = ".col") | |||
| take_ids <- row_combiner(x_ids, y_ids, by = c(".id", ".id_long")) | |||
| take_headers <- col_combiner(x_headers, y_headers, by = c(".id", ".id_long")) | |||
| take_ids <- bind_rows(take_headers, take_ids) | |||
| take <- tidyr::crossing(take_ids, take_cols) | |||
| mid <- (2 + length(unique(lhs$.col)) + length(unique(rhs$.col))) / 2 | |||
| xvals <- 1:nrow(take_cols) | |||
| xvals <- xvals - mean(xvals) + mid | |||
| names(xvals) <- pull(take_cols, .col) | |||
| yvals <- cumsum(ifelse(grepl("^\\.header", take_ids$.id_long), 0, -1)) | |||
| names(yvals) <- pull(take_ids, .id_long) | |||
| take_vals <- semi_join(all, take %>% select(".id", ".col"), | |||
| by = c(".id", ".col")) %>% | |||
| mutate(.alpha = 1, | |||
| .x = xvals[.col], | |||
| .y = yvals[.id_long]) | |||
| bind_rows( | |||
| # take, | |||
| take_vals, | |||
| # fade in place: | |||
| all %>% filter(!.id_long %in% take_ids$.id_long) %>% mutate(.alpha = 0), | |||
| # moving fade or fade in place as well: | |||
| all %>% filter(.id_long %in% take_ids$.id_long & !.col %in% take_cols$.col) %>% | |||
| mutate(.alpha = 0) | |||
| ) | |||
| } | |||
+ 72
- 0
R/plot_helpers.R
Voir le fichier
| @@ -0,0 +1,72 @@ | |||
| #' 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
Voir le fichier
| @@ -0,0 +1,148 @@ | |||
| #' 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
Voir le fichier
| @@ -1,30 +0,0 @@ | |||
| source(here::here("R/00_base_join.R")) | |||
| rj_joined_dfs <- right_join(x, y, "id") %>% | |||
| proc_data("y") %>% | |||
| mutate(frame = 2, .x = .x + 1) | |||
| rj_extra_blocks <- inner_join(x, y, "id") %>% | |||
| select(id) %>% | |||
| proc_data("x") %>% | |||
| mutate(frame = 2, .x = .x + 1) | |||
| rj <- bind_rows( | |||
| initial_join_dfs, | |||
| rj_joined_dfs, | |||
| rj_extra_blocks | |||
| ) %>% | |||
| filter(!is.na(value)) %>% | |||
| mutate( | |||
| .id = ifelse(label == "x", label, .id), | |||
| removed = as.integer(grepl("3", value)) | |||
| ) %>% | |||
| arrange(removed, value, .id, frame) %>% | |||
| plot_data("right_join(x, y)") %>% | |||
| animate_plot() | |||
| rj <- animate(rj) | |||
| anim_save(here::here("images", "right-join.gif"), rj) | |||
| rj_g <- plot_data(rj_joined_dfs, "right_join(x, y)") | |||
| save_static_plot(rj_g, "right-join") | |||
+ 0
- 30
R/semi_join.R
Voir le fichier
| @@ -1,30 +0,0 @@ | |||
| source(here::here("R/00_base_join.R")) | |||
| sj_joined_df <- semi_join(x, y, "id") %>% | |||
| proc_data("x") %>% | |||
| mutate(frame = 2, .x = .x + 1.5) | |||
| sj_extra_blocks <- inner_join(x, y, "id") %>% | |||
| select(id) %>% | |||
| proc_data("y") %>% | |||
| mutate(frame = 2, .x = .x + 1.5) | |||
| sj <- bind_rows( | |||
| initial_join_dfs, | |||
| sj_joined_df, | |||
| sj_extra_blocks | |||
| ) %>% | |||
| arrange(value) %>% | |||
| plot_data("semi_join(x, y)") %>% | |||
| animate_plot() | |||
| sj <- animate(sj) | |||
| anim_save(here::here("images", "semi-join.gif"), sj) | |||
| # Static Images | |||
| sj_g <- semi_join(x, y, "id") %>% | |||
| proc_data() %>% | |||
| mutate(.x = .x + 1.5) %>% | |||
| plot_data_join("semi_join(x, y)") | |||
| save_static_plot(sj_g, "semi-join") | |||
+ 0
- 102
R/setdiff.R
Voir le fichier
| @@ -1,102 +0,0 @@ | |||
| source(here::here("R/00_base_set.R")) | |||
| # ---- setdiff(x, y) ---- | |||
| # Dim elements unique to y | |||
| setd_step2 <- initial_set_dfs %>% | |||
| mutate( | |||
| frame = 2, | |||
| alpha = case_when( | |||
| .y == -1 ~ 0.55, | |||
| .id == "y" ~ 0.15, | |||
| TRUE ~ 1 | |||
| ) | |||
| ) | |||
| # Merge, dim overlapping elements | |||
| setd_step3 <- initial_set_dfs %>% | |||
| filter(!(.id == "y" & .y == -2)) %>% | |||
| mutate( | |||
| frame = 3, | |||
| alpha = ifelse(.y == -1, 0.25, 1), | |||
| .x = ifelse(.id == "y", .x - 3, .x), | |||
| .x = .x + 1.5 | |||
| ) | |||
| # Result of setdiff | |||
| setd_step4 <- setdiff(x, y) %>% | |||
| proc_data_set("xy") %>% | |||
| mutate(frame = 4, .x = .x + 1.5) | |||
| setd <- bind_rows( | |||
| initial_set_dfs, | |||
| setd_step2, | |||
| setd_step3, | |||
| setd_step4 | |||
| ) %>% | |||
| mutate(alpha = ifelse(is.na(alpha), 1, alpha)) %>% | |||
| arrange(frame, desc(.y), desc(.id)) %>% | |||
| plot_data_set(., "setdiff(x, y)") %>% | |||
| animate_plot() | |||
| setd <- animate(setd) | |||
| anim_save(here::here("images", "setdiff.gif"), setd) | |||
| setd_g <- setdiff(x, y) %>% | |||
| proc_data_set() %>% | |||
| mutate(.x = .x + 1.5) %>% | |||
| plot_data_set("setdiff(x, y)") | |||
| save_static_plot(setd_g, "setdiff") | |||
| # ---- setdiff(y, x) ---- | |||
| # Dim elements unique to x | |||
| setd2_step2 <- initial_set_dfs %>% | |||
| mutate( | |||
| frame = 2, | |||
| alpha = case_when( | |||
| .y == -1 ~ 0.55, | |||
| .id == "x" ~ 0.15, | |||
| TRUE ~ 1 | |||
| ) | |||
| ) | |||
| # Merge, dim overlapping elements | |||
| setd2_step3 <- initial_set_dfs %>% | |||
| filter(!(.id == "x" & .y <= -2)) %>% | |||
| mutate( | |||
| frame = 3, | |||
| alpha = ifelse(.y == -1, 0.25, 1), | |||
| .x = ifelse(.id == "y", .x - 3, .x), | |||
| .x = .x + 1.5 | |||
| ) | |||
| # Result of setdiff | |||
| setd2_step4 <- setdiff(y, x) %>% | |||
| proc_data_set("xy") %>% | |||
| mutate(frame = 4, .x = .x + 1.5) | |||
| setd2 <- bind_rows( | |||
| initial_set_dfs, | |||
| setd2_step2, | |||
| setd2_step3, | |||
| setd2_step4 | |||
| ) %>% | |||
| mutate(alpha = ifelse(is.na(alpha), 1, alpha)) %>% | |||
| arrange(frame, desc(.y), .id) %>% | |||
| plot_data_set(., "setdiff(y, x)") %>% | |||
| animate_plot() | |||
| setd2 <- animate(setd2) | |||
| anim_save(here::here("images", "setdiff-rev.gif"), setd2) | |||
| setd2_g <- setdiff(x, y) %>% | |||
| proc_data_set() %>% | |||
| mutate(.x = .x + 1.5) %>% | |||
| plot_data_set("setdiff(y, x)") | |||
| save_static_plot(setd2_g, "setdiff-rev") | |||
+ 354
- 0
R/tidyr_helpers.R
Voir le fichier
| @@ -0,0 +1,354 @@ | |||
| #' 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
Voir le fichier
| @@ -1,42 +0,0 @@ | |||
| source(here::here("R/00_base_set.R")) | |||
| # ---- union(x, y) ---- | |||
| uxy <- bind_rows( | |||
| initial_set_dfs, | |||
| union(x, y) %>% proc_data_set("xy") %>% mutate(frame = 2, .x = .x + 1.5), | |||
| intersect(x, y) %>% proc_data_set("xy") %>% mutate(frame = 2, .y = -4, .x = .x + 1.5) | |||
| ) %>% | |||
| plot_data_set("union(x, y)", ylims = ylim(-4.5, -0.5)) %>% | |||
| animate_plot() | |||
| uxy <- animate(uxy) | |||
| anim_save(here::here("images", "union.gif"), uxy) | |||
| uxy_g <- union(x, y) %>% | |||
| proc_data_set() %>% | |||
| mutate(.x = .x + 1.5) %>% | |||
| plot_data_set("union(x, y)", ylims = ylim(-0.5, -4.5)) | |||
| save_static_plot(uxy_g, "union") | |||
| # ---- union(y, x) ---- | |||
| uyx <- bind_rows( | |||
| initial_set_dfs, | |||
| union(y, x) %>% proc_data_set("xy") %>% mutate(frame = 2, .x = .x + 1.5), | |||
| intersect(y, x) %>% proc_data_set("xy") %>% mutate(frame = 2, .y = -4, .x = .x + 1.5) | |||
| ) %>% | |||
| plot_data_set("union(y, x)", ylims = ylim(-4.5, -0.5)) %>% | |||
| animate_plot() | |||
| uyx <- animate(uyx) | |||
| anim_save(here::here("images", "union-rev.gif"), uyx) | |||
| uyx_g <- union(y, x) %>% | |||
| proc_data_set() %>% | |||
| mutate(.x = .x + 1.5) %>% | |||
| plot_data_set("union(y, x)", ylims = ylim(-4.5, -0.5)) | |||
| save_static_plot(uyx_g, "union-rev") | |||
+ 0
- 23
R/union_all.R
Voir le fichier
| @@ -1,23 +0,0 @@ | |||
| source(here::here("R/00_base_set.R")) | |||
| ua <- bind_rows( | |||
| initial_set_dfs, | |||
| initial_set_dfs %>% mutate(frame = 2, .y = ifelse(.id == "y", .y - 3, .y)), # fly y down | |||
| proc_data_set(x, "ux") %>% mutate(frame = 3, .x = .x + 1.5), # merge | |||
| proc_data_set(y, "uy") %>% mutate(frame = 3, .x = .x + 1.5, .y = .y - 3), # un-merge | |||
| initial_set_dfs %>% mutate(frame = 4, .y = ifelse(.id == "y", .y - 3, .y)) # fly y up | |||
| ) %>% | |||
| arrange(desc(frame)) %>% | |||
| plot_data_set("union_all(x, y)", ylims = ylim(-5.5, -0.5)) + | |||
| transition_states(frame, 1, c(1, 0, 1, 0)) | |||
| ua <- animate(ua) | |||
| anim_save(here::here("images", "union-all.gif"), ua) | |||
| ua_g <- union_all(x, y) %>% | |||
| proc_data_set() %>% | |||
| mutate(.x = .x + 1.5) %>% | |||
| plot_data_set("union_all(x, y)", ylims = ylim(-5.5, -0.5)) | |||
| save_static_plot(ua_g, "union-all") | |||
+ 11
- 0
R/utils-pipe.R
Voir le fichier
| @@ -0,0 +1,11 @@ | |||
| #' Pipe operator | |||
| #' | |||
| #' See \code{magrittr::\link[magrittr]{\%>\%}} for details. | |||
| #' | |||
| #' @name %>% | |||
| #' @rdname pipe | |||
| #' @keywords internal | |||
| #' @export | |||
| #' @importFrom magrittr %>% | |||
| #' @usage lhs \%>\% rhs | |||
| NULL | |||
+ 26
- 0
R/utils.R
Voir le fichier
| @@ -0,0 +1,26 @@ | |||
| `%||%` <- function(x, y) if (is.null(x)) y else x | |||
| choose_text_color <- function(x, black = "#000000", white = "#FFFFFF") { | |||
| # x = color_hex | |||
| color_rgb <- col2rgb(x) | |||
| # modified from https://stackoverflow.com/a/3943023/2022615 | |||
| # following W3 guidelines: https://www.w3.org/TR/WCAG20/#relativeluminancedef | |||
| color_rgb <- color_rgb / 255 | |||
| color_rgb[color_rgb <= 0.03928] <- color_rgb[color_rgb <= 0.03928]/12.92 | |||
| color_rgb[color_rgb > 0.03928] <- ((color_rgb[color_rgb > 0.03928] + 0.055)/1.055)^2.4 | |||
| lum <- t(color_rgb) %*% c(0.2126, 0.7152, 0.0722) | |||
| lum <- lum[,1] | |||
| # threshold is supposed to be 0.179 but 1/3 seems to work better for our plots | |||
| ifelse(lum > 1/3, black, white) | |||
| } | |||
| get_input_text <- function(x) { | |||
| if (!rlang::is_quosure(x)) x <- rlang::enquo(x) | |||
| rlang::quo_name(x) | |||
| } | |||
| make_named_data <- function(x, y, data_names = c("x", "y")) { | |||
| ll <- rlang::eval_tidy(rlang::quo(list(!!x, !!y))) | |||
| names(ll) <- data_names | |||
| ll | |||
| } | |||
+ 20
- 0
R/zzzz-package.R
Voir le fichier
| @@ -0,0 +1,20 @@ | |||
| #' @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
Voir le fichier
| @@ -1,5 +1,7 @@ | |||
| --- | |||
| output: github_document | |||
| editor_options: | |||
| chunk_output_type: console | |||
| --- | |||
| <!-- README.md is generated from README.Rmd. Please edit that file --> | |||
| @@ -8,11 +10,14 @@ output: github_document | |||
| knitr::opts_chunk$set( | |||
| collapse = TRUE, | |||
| comment = "#>", | |||
| echo = FALSE, | |||
| echo = TRUE, | |||
| warning = FALSE, | |||
| message = FALSE, | |||
| fig.path = "man/figures/tidyexplain-", | |||
| cache = TRUE | |||
| ) | |||
| library(tidyexplain) | |||
| set_font_size(11, 26) | |||
| ``` | |||
| [gganimate]: https://github.com/thomasp85/gganimate#README | |||
| @@ -26,29 +31,28 @@ knitr::opts_chunk$set( | |||
| # 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) | |||
| [_-CC0-green.svg)](https://creativecommons.org/publicdomain/zero/1.0/) | |||
| [_-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 | |||
| - [Using the animations and images](#usage) | |||
| - [Relational Data](#relational-data) | |||
| - [gganimate](#gganimate) | |||
| ## Background | |||
| ### Usage | |||
| Please feel free to use these images for teaching or learning about action verbs from the [tidyverse](https://tidyverse.org). | |||
| You can directly download the [original animations](images/) or static images in [svg](images/static/svg/) or [png](images/static/png/) formats, or you can use the [scripts](R/) to recreate the images locally. | |||
| @@ -56,22 +60,16 @@ You can directly download the [original animations](images/) or static images in | |||
| Currently, the animations cover the [dplyr two-table verbs][dplyr-two-table] and I'd like to expand the animations to include more verbs from the tidyverse. | |||
| [Suggestions are welcome!](https://github.com/gadenbuie/tidy-animated-verbs/issues) | |||
| ### Relational Data | |||
| The [Relational Data][r4ds-relational] chapter of the | |||
| [R for Data Science][r4ds] book by Garrett Grolemund and Hadley Wickham | |||
| is an excellent resource for learning more about relational data. | |||
| ## Installing | |||
| The [dplyr two-table verbs vignette][dplyr-two-table] | |||
| and Jenny Bryan's [Cheatsheet for dplyr join functions](http://stat545.com/bit001_dplyr-cheatsheet.html) | |||
| are also great resources. | |||
| The in-development version of `tidyexplain` can be installed with `devtools`: | |||
| ### gganimate | |||
| ```r | |||
| # install.package("devtools") | |||
| devtools::install_github("gadenbuie/tidy-animated-verbs") | |||
| The animations were made possible by the newly re-written [gganimate] package by | |||
| [Thomas Lin Pedersen](https://github.com/thomasp85) | |||
| (original by [Dave Robinson](https://github.com/dgrtwo)). | |||
| The [package readme][gganimate] provides an excellent (and quick) introduction to gganimte. | |||
| library(tidyexplain) | |||
| ``` | |||
| ## Mutating Joins | |||
| @@ -79,23 +77,21 @@ The [package readme][gganimate] provides an excellent (and quick) introduction t | |||
| > [R for Data Science: Mutating joins](http://r4ds.had.co.nz/relational-data.html#mutating-joins) | |||
| ```{r intial-dfs} | |||
| source("R/00_base_join.R") | |||
| df_names <- data_frame( | |||
| .x = c(1.5, 4.5), .y = 0.25, | |||
| value = c("x", "y"), | |||
| size = 12, | |||
| color = "black" | |||
| x <- dplyr::data_frame( | |||
| id = 1:3, | |||
| x = paste0("x", 1:3) | |||
| ) | |||
| g <- plot_data(initial_join_dfs) + | |||
| geom_text(data = df_names, family = "Fira Mono", size = 24) | |||
| y <- dplyr::data_frame( | |||
| id = (1:4)[-3], | |||
| y = paste0("y", (1:4)[-3]) | |||
| ) | |||
| save_static_plot(g, "original-dfs") | |||
| animate_full_join(x, y, by = c("id"), export = "first") | |||
| ``` | |||
| <img src="images/static/png/original-dfs.png" width="480px" /> | |||
| ```{r echo=TRUE} | |||
| ```{r} | |||
| x | |||
| y | |||
| ``` | |||
| @@ -105,13 +101,12 @@ y | |||
| > All rows from `x` where there are matching values in `y`, and all columns from `x` and `y`. | |||
| ```{r inner-join} | |||
| source("R/inner_join.R") | |||
| animate_inner_join(x, y, by = "id") | |||
| ``` | |||
|  | |||
| ```{r echo=TRUE} | |||
| inner_join(x, y, by = "id") | |||
| ```{r} | |||
| dplyr::inner_join(x, y, by = "id") | |||
| ``` | |||
| ### Left Join | |||
| @@ -119,13 +114,12 @@ inner_join(x, y, by = "id") | |||
| > All rows from `x`, and all columns from `x` and `y`. Rows in `x` with no match in `y` will have `NA` values in the new columns. | |||
| ```{r left-join} | |||
| source("R/left_join.R") | |||
| animate_left_join(x, y, by = "id") | |||
| ``` | |||
|  | |||
| ```{r echo=TRUE} | |||
| left_join(x, y, by = "id") | |||
| ```{r} | |||
| dplyr::left_join(x, y, by = "id") | |||
| ``` | |||
| ### Left Join (Extra Rows in y) | |||
| @@ -133,14 +127,15 @@ left_join(x, y, by = "id") | |||
| > ... If there are multiple matches between `x` and `y`, all combinations of the matches are returned. | |||
| ```{r left-join-extra} | |||
| source("R/left_join_extra.R") | |||
| ``` | |||
| y_extra <- dplyr::bind_rows(y, dplyr::data_frame(id = 2, y = "y5")) | |||
| y_extra # has multiple rows with the key from `x` | |||
|  | |||
| 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 | |||
| @@ -148,13 +143,12 @@ left_join(x, y_extra, by = "id") | |||
| > All rows from y, and all columns from `x` and `y`. Rows in `y` with no match in `x` will have `NA` values in the new columns. | |||
| ```{r right-join} | |||
| source("R/right_join.R") | |||
| animate_right_join(x, y, by = "id") | |||
| ``` | |||
|  | |||
| ```{r echo=TRUE} | |||
| right_join(x, y, by = "id") | |||
| ```{r} | |||
| dplyr::right_join(x, y, by = "id") | |||
| ``` | |||
| ### Full Join | |||
| @@ -162,13 +156,12 @@ right_join(x, y, by = "id") | |||
| > All rows and all columns from both `x` and `y`. Where there are not matching values, returns `NA` for the one missing. | |||
| ```{r full-join} | |||
| source("R/full_join.R") | |||
| animate_full_join(x, y, by = "id") | |||
| ``` | |||
|  | |||
| ```{r echo=TRUE} | |||
| full_join(x, y, by = "id") | |||
| ```{r} | |||
| dplyr::full_join(x, y, by = "id") | |||
| ``` | |||
| ## Filtering Joins | |||
| @@ -183,13 +176,12 @@ full_join(x, y, by = "id") | |||
| > All rows from `x` where there are matching values in `y`, keeping just columns from `x`. | |||
| ```{r semi-join} | |||
| source("R/semi_join.R") | |||
| animate_semi_join(x, y, by = "id") | |||
| ``` | |||
|  | |||
| ```{r echo=TRUE} | |||
| semi_join(x, y, by = "id") | |||
| ```{r} | |||
| dplyr::semi_join(x, y, by = "id") | |||
| ``` | |||
| ### Anti Join | |||
| @@ -197,13 +189,12 @@ semi_join(x, y, by = "id") | |||
| > All rows from `x` where there are not matching values in `y`, keeping just columns from `x`. | |||
| ```{r anti-join} | |||
| source("R/anti_join.R") | |||
| animate_anti_join(x, y, by = "id") | |||
| ``` | |||
|  | |||
| ```{r echo=TRUE} | |||
| anti_join(x, y, by = "id") | |||
| ```{r} | |||
| dplyr::anti_join(x, y, by = "id") | |||
| ``` | |||
| ## Set Operations | |||
| @@ -214,28 +205,20 @@ anti_join(x, y, by = "id") | |||
| > [R for Data Science: Set operations](http://r4ds.had.co.nz/relational-data.html#set-operations) | |||
| ```{r intial-dfs-so} | |||
| source("R/00_base_set.R") | |||
| df_names <- data_frame( | |||
| .x = c(2.5, 5.5), .y = 0.25, | |||
| value = c("x", "y"), | |||
| size = 12, | |||
| color = "black" | |||
| x <- dplyr::data_frame( | |||
| x = c(1, 1, 2), | |||
| y = c("a", "b", "a") | |||
| ) | |||
| y <- dplyr::data_frame( | |||
| x = c(1, 2), | |||
| y = c("a", "b") | |||
| ) | |||
| g <- plot_data_set(initial_set_dfs, "", NULL, NULL) + | |||
| geom_text(data = df_names, family = "Fira Mono", size = 24) | |||
| save_static_plot(g, "original-dfs-set-ops") | |||
| ``` | |||
| ```{r remove-set-ops-ids} | |||
| x <- x %>% select(-id) | |||
| y <- y %>% select(-id) | |||
| animate_union(x, y, export = "first") | |||
| ``` | |||
| <img src="images/static/png/original-dfs-set-ops.png" width="480px" /> | |||
| ```{r echo=TRUE} | |||
| ```{r} | |||
| x | |||
| y | |||
| ``` | |||
| @@ -245,20 +228,20 @@ y | |||
| > All unique rows from `x` and `y`. | |||
| ```{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 | |||
| @@ -266,15 +249,13 @@ union(y, x) | |||
| > All rows from `x` and `y`, keeping duplicates. | |||
| ```{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) | |||
| ``` | |||
| @@ -283,14 +264,12 @@ union_all(x, y) | |||
| > Common rows in both `x` and `y`, keeping just unique rows. | |||
| ```{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 | |||
| @@ -298,23 +277,76 @@ intersect(x, y) | |||
| > All rows from `x` which are not also rows in `y`, keeping just unique rows. | |||
| ```{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: | |||
+ 238
- 102
README.md
Voir le fichier
| @@ -4,8 +4,10 @@ | |||
| # Tidy Animated Verbs | |||
| Garrick Aden-Buie – [@grrrck](https://twitter.com/grrrck) – | |||
| [garrickadenbuie.com](https://www.garrickadenbuie.com). Set operations | |||
| contributed by [Tyler Grant | |||
| [garrickadenbuie.com](https://www.garrickadenbuie.com). David Zimmermann | |||
| – [@dav\_zim](https://twitter.com/dav_zim) – | |||
| [datashenanigan.wordpress.com](https://datashenanigan.wordpress.com/) | |||
| Set operations contributed by [Tyler Grant | |||
| Smith](https://github.com/TylerGrantSmith). | |||
| [](https://mybinder.org/v2/gh/gadenbuie/tidy-animated-verbs/master?urlpath=rstudio) | |||
| @@ -23,8 +25,7 @@ Smith](https://github.com/TylerGrantSmith). | |||
| [`union_all()`](#union-all), [`intersect()`](#intersect), | |||
| [`setdiff()`](#setdiff) | |||
| - [**Tidy Data**](#tidy-data) — [`spread()` and | |||
| `gather()`](#spread-and-gather) | |||
| - Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) | |||
| - Learn more about | |||
| @@ -48,37 +49,35 @@ to expand the animations to include more verbs from the tidyverse. | |||
| [Suggestions are | |||
| welcome\!](https://github.com/gadenbuie/tidy-animated-verbs/issues) | |||
| ### Relational Data | |||
| ## Installing | |||
| The [Relational Data](http://r4ds.had.co.nz/relational-data.html) | |||
| chapter of the [R for Data Science](http://r4ds.had.co.nz/) book by | |||
| Garrett Grolemund and Hadley Wickham is an excellent resource for | |||
| learning more about relational data. | |||
| The in-development version of `tidyexplain` can be installed with | |||
| `devtools`: | |||
| The [dplyr two-table verbs | |||
| vignette](https://dplyr.tidyverse.org/articles/two-table.html) and Jenny | |||
| Bryan’s [Cheatsheet for dplyr join | |||
| functions](http://stat545.com/bit001_dplyr-cheatsheet.html) are also | |||
| great resources. | |||
| ### gganimate | |||
| ``` r | |||
| # install.package("devtools") | |||
| devtools::install_github("gadenbuie/tidy-animated-verbs") | |||
| The animations were made possible by the newly re-written | |||
| [gganimate](https://github.com/thomasp85/gganimate#README) package by | |||
| [Thomas Lin Pedersen](https://github.com/thomasp85) (original by [Dave | |||
| Robinson](https://github.com/dgrtwo)). The [package | |||
| readme](https://github.com/thomasp85/gganimate#README) provides an | |||
| excellent (and quick) introduction to gganimte. | |||
| library(tidyexplain) | |||
| ``` | |||
| ## Mutating Joins | |||
| > A mutating join allows you to combine variables from two tables. It | |||
| > first matches observations by their keys, then copies across variables | |||
| > from one table to the other. | |||
| > [R for Data Science: Mutating | |||
| > joins](http://r4ds.had.co.nz/relational-data.html#mutating-joins) | |||
| ``` r | |||
| x <- dplyr::data_frame( | |||
| id = 1:3, | |||
| x = paste0("x", 1:3) | |||
| ) | |||
| y <- dplyr::data_frame( | |||
| id = (1:4)[-3], | |||
| y = paste0("y", (1:4)[-3]) | |||
| ) | |||
| animate_full_join(x, y, by = c("id"), export = "first") | |||
| ``` | |||
| <img src="images/static/png/original-dfs.png" width="480px" /> | |||
| <!-- --> | |||
| ``` r | |||
| x | |||
| @@ -102,10 +101,14 @@ y | |||
| > All rows from `x` where there are matching values in `y`, and all | |||
| > columns from `x` and `y`. | |||
|  | |||
| ``` r | |||
| animate_inner_join(x, y, by = "id") | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| inner_join(x, y, by = "id") | |||
| dplyr::inner_join(x, y, by = "id") | |||
| #> # A tibble: 2 x 3 | |||
| #> id x y | |||
| #> <int> <chr> <chr> | |||
| @@ -118,10 +121,14 @@ inner_join(x, y, by = "id") | |||
| > All rows from `x`, and all columns from `x` and `y`. Rows in `x` with | |||
| > no match in `y` will have `NA` values in the new columns. | |||
|  | |||
| ``` r | |||
| animate_left_join(x, y, by = "id") | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| left_join(x, y, by = "id") | |||
| dplyr::left_join(x, y, by = "id") | |||
| #> # A tibble: 3 x 3 | |||
| #> id x y | |||
| #> <int> <chr> <chr> | |||
| @@ -135,9 +142,8 @@ left_join(x, y, by = "id") | |||
| > … If there are multiple matches between `x` and `y`, all combinations | |||
| > of the matches are returned. | |||
|  | |||
| ``` r | |||
| y_extra <- dplyr::bind_rows(y, dplyr::data_frame(id = 2, y = "y5")) | |||
| y_extra # has multiple rows with the key from `x` | |||
| #> # A tibble: 4 x 2 | |||
| #> id y | |||
| @@ -146,7 +152,15 @@ y_extra # has multiple rows with the key from `x` | |||
| #> 2 2 y2 | |||
| #> 3 4 y4 | |||
| #> 4 2 y5 | |||
| left_join(x, y_extra, by = "id") | |||
| animate_left_join(x, y_extra, by = "id", | |||
| anim_opts = anim_options(title_size = 22)) | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| dplyr::left_join(x, y_extra, by = "id") | |||
| #> # A tibble: 4 x 3 | |||
| #> id x y | |||
| #> <dbl> <chr> <chr> | |||
| @@ -161,10 +175,14 @@ left_join(x, y_extra, by = "id") | |||
| > All rows from y, and all columns from `x` and `y`. Rows in `y` with no | |||
| > match in `x` will have `NA` values in the new columns. | |||
|  | |||
| ``` r | |||
| animate_right_join(x, y, by = "id") | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| right_join(x, y, by = "id") | |||
| dplyr::right_join(x, y, by = "id") | |||
| #> # A tibble: 3 x 3 | |||
| #> id x y | |||
| #> <int> <chr> <chr> | |||
| @@ -178,10 +196,14 @@ right_join(x, y, by = "id") | |||
| > All rows and all columns from both `x` and `y`. Where there are not | |||
| > matching values, returns `NA` for the one missing. | |||
|  | |||
| ``` r | |||
| animate_full_join(x, y, by = "id") | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| full_join(x, y, by = "id") | |||
| dplyr::full_join(x, y, by = "id") | |||
| #> # A tibble: 4 x 3 | |||
| #> id x y | |||
| #> <int> <chr> <chr> | |||
| @@ -205,10 +227,14 @@ full_join(x, y, by = "id") | |||
| > All rows from `x` where there are matching values in `y`, keeping just | |||
| > columns from `x`. | |||
|  | |||
| ``` r | |||
| animate_semi_join(x, y, by = "id") | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| semi_join(x, y, by = "id") | |||
| dplyr::semi_join(x, y, by = "id") | |||
| #> # A tibble: 2 x 2 | |||
| #> id x | |||
| #> <int> <chr> | |||
| @@ -221,10 +247,14 @@ semi_join(x, y, by = "id") | |||
| > All rows from `x` where there are not matching values in `y`, keeping | |||
| > just columns from `x`. | |||
|  | |||
| ``` r | |||
| animate_anti_join(x, y, by = "id") | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| anti_join(x, y, by = "id") | |||
| dplyr::anti_join(x, y, by = "id") | |||
| #> # A tibble: 1 x 2 | |||
| #> id x | |||
| #> <int> <chr> | |||
| @@ -233,92 +263,114 @@ anti_join(x, y, by = "id") | |||
| ## Set Operations | |||
| > Set operations are occasionally useful when you want to break a single | |||
| > complex filter into simpler pieces. All these operations work with a | |||
| > complete row, comparing the values of every variable. These expect the | |||
| > x and y inputs to have the same variables, and treat the observations | |||
| > like sets. | |||
| > [R for Data Science: Set | |||
| > operations](http://r4ds.had.co.nz/relational-data.html#set-operations) | |||
| ``` r | |||
| x <- dplyr::data_frame( | |||
| x = c(1, 1, 2), | |||
| y = c("a", "b", "a") | |||
| ) | |||
| y <- dplyr::data_frame( | |||
| x = c(1, 2), | |||
| y = c("a", "b") | |||
| ) | |||
| animate_union(x, y, export = "first") | |||
| ``` | |||
| <img src="images/static/png/original-dfs-set-ops.png" width="480px" /> | |||
| <!-- --> | |||
| ``` r | |||
| x | |||
| #> # 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 | |||
| #> # 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 | |||
| > All unique rows from `x` and `y`. | |||
|  | |||
| ``` r | |||
| animate_union(x, y) | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| union(x, y) | |||
| dplyr::union(x, y) | |||
| #> # 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 | |||
| union(y, x) | |||
| dplyr::union(y, x) | |||
| #> # 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 | |||
| > All rows from `x` and `y`, keeping duplicates. | |||
|  | |||
| ``` r | |||
| animate_union_all(x, y) | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| union_all(x, y) | |||
| dplyr::union_all(x, y) | |||
| #> # 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 | |||
| > Common rows in both `x` and `y`, keeping just unique rows. | |||
|  | |||
| ``` r | |||
| animate_intersect(x, y) | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| intersect(x, y) | |||
| dplyr::intersect(x, y) | |||
| #> # A tibble: 1 x 2 | |||
| #> x y | |||
| #> <chr> <chr> | |||
| #> 1 1 a | |||
| #> x y | |||
| #> <dbl> <chr> | |||
| #> 1 1 a | |||
| ``` | |||
| ### Set Difference | |||
| @@ -326,28 +378,112 @@ intersect(x, y) | |||
| > All rows from `x` which are not also rows in `y`, keeping just unique | |||
| > rows. | |||
|  | |||
| ``` r | |||
| animate_setdiff(x, y) | |||
| ``` | |||
| <!-- --> | |||
| ``` r | |||
| setdiff(x, y) | |||
| dplyr::setdiff(x, y) | |||
| #> # 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 | |||
| setdiff(y, x) | |||
| dplyr::setdiff(y, x) | |||
| #> # 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 | |||
| the following three rules: | |||
+ 96
- 0
images/create_images.R
Voir le fichier
| @@ -0,0 +1,96 @@ | |||
| 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
Voir le fichier
| @@ -1,7 +0,0 @@ | |||
| install.packages("tidyverse") | |||
| install.packages("rmarkdown") | |||
| install.packages("here") | |||
| install.packages(c("sysfonts", "jsonlite", "curl", "showtext")) | |||
| install.packages("cowplot") | |||
| install.packages("devtools") | |||
| devtools::install_github("thomasp85/gganimate") | |||
+ 40
- 0
man/add_color_join.Rd
Voir le fichier
| @@ -0,0 +1,40 @@ | |||
| % 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
Voir le fichier
| @@ -0,0 +1,29 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/tidyr_helpers.R | |||
| \name{add_color_tidyr} | |||
| \alias{add_color_tidyr} | |||
| \title{Adds color to processed tidy data} | |||
| \usage{ | |||
| add_color_tidyr(x, key_values, color_fun = scales::brewer_pal(type = | |||
| "qual", "Set1"), color_header = "#737373", color_id = "#d0d0d0") | |||
| } | |||
| \arguments{ | |||
| \item{x}{a processed data-frame as outputted by process_long or process_wide} | |||
| \item{key_values}{the unique key-values} | |||
| \item{color_fun}{the color function} | |||
| \item{color_header}{the color for the header} | |||
| \item{...}{not used} | |||
| } | |||
| \value{ | |||
| a data-frame with the colors | |||
| } | |||
| \description{ | |||
| Adds color to processed tidy data | |||
| } | |||
| \examples{ | |||
| NULL | |||
| } | |||
+ 57
- 0
man/anim_options.Rd
Voir le fichier
| @@ -0,0 +1,57 @@ | |||
| % 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
Voir le fichier
| @@ -0,0 +1,49 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/animate_tidyr.R | |||
| \name{animate_gather} | |||
| \alias{animate_gather} | |||
| \title{Animates the gather function} | |||
| \usage{ | |||
| animate_gather(w, key, value, ..., export = "gif", detailed = TRUE, | |||
| anim_opts = anim_options()) | |||
| } | |||
| \arguments{ | |||
| \item{w}{a data_frame in the wide format} | |||
| \item{key}{the key} | |||
| \item{value}{the value} | |||
| \item{...}{further arguments passed to \code{\link[tidyr:gather]{tidyr::gather()}}, \code{\link[=process_wide]{process_wide()}}, | |||
| or \code{\link[=process_long]{process_long()}}} | |||
| \item{export}{the export type, either gif, first or last. The latter two | |||
| export ggplots of the first/last state of the join} | |||
| \item{detailed}{boolean value if the animation should show one step for each | |||
| key value} | |||
| \item{anim_opts}{An \code{\link[=anim_options]{anim_options()}} options list.} | |||
| } | |||
| \value{ | |||
| a gif or a ggplot | |||
| } | |||
| \description{ | |||
| Animates the gather function | |||
| } | |||
| \examples{ | |||
| wide <- data_frame( | |||
| year = 2010:2011, | |||
| Alice = c(105, 110), | |||
| Bob = c(100, 97), | |||
| Charlie = c(90, 95) | |||
| ) | |||
| animate_gather(wide, "person", "sales", -year, export = "first") | |||
| animate_gather(wide, "person", "sales", -year, export = "last") | |||
| \donttest{ | |||
| animate_gather(wide, "person", "sales", -year, export = "gif") | |||
| # if you want to have a less detailed animation, you can also use | |||
| animate_gather(wide, "person", "sales", -year, export = "gif", detailed = FALSE) | |||
| } | |||
| } | |||
+ 93
- 0
man/animate_join.Rd
Voir le fichier
| @@ -0,0 +1,93 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/animate_joins.R | |||
| \name{animate_join} | |||
| \alias{animate_join} | |||
| \alias{animate_full_join} | |||
| \alias{animate_inner_join} | |||
| \alias{animate_left_join} | |||
| \alias{animate_right_join} | |||
| \alias{animate_semi_join} | |||
| \alias{animate_anti_join} | |||
| \title{Animates a join operation} | |||
| \usage{ | |||
| animate_join(x, y, by, type = c("full_join", "inner_join", "left_join", | |||
| "right_join", "semi_join", "anti_join"), export = c("gif", "first", | |||
| "last"), ...) | |||
| animate_full_join(x, y, by, export = "gif", ...) | |||
| animate_inner_join(x, y, by, export = "gif", ...) | |||
| animate_left_join(x, y, by, export = "gif", ...) | |||
| animate_right_join(x, y, by, export = "gif", ...) | |||
| animate_semi_join(x, y, by, export = "gif", ...) | |||
| animate_anti_join(x, y, by, export = "gif", ...) | |||
| } | |||
| \arguments{ | |||
| \item{x}{the x dataset} | |||
| \item{y}{the y dataset} | |||
| \item{by}{the by arguments for the join} | |||
| \item{export}{the export type, either gif, first or last. The latter two | |||
| export ggplots of the first/last state of the join} | |||
| \item{...}{further arguments passed to 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
Voir le fichier
| @@ -0,0 +1,25 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/plot_helpers.R | |||
| \name{animate_plot} | |||
| \alias{animate_plot} | |||
| \title{Animate a Plot} | |||
| \usage{ | |||
| animate_plot(d, title = "", ..., anim_opts = anim_options(...)) | |||
| } | |||
| \arguments{ | |||
| \item{d}{a processed dataset} | |||
| \item{title}{the title of the plot} | |||
| \item{anim_opts}{Animation options generated with \code{\link[=anim_options]{anim_options()}}. Overrides | |||
| any options set in \code{...}.} | |||
| } | |||
| \value{ | |||
| a \code{gganim} object | |||
| } | |||
| \description{ | |||
| Animate a Plot | |||
| } | |||
| \examples{ | |||
| NULL | |||
| } | |||
+ 85
- 0
man/animate_set.Rd
Voir le fichier
| @@ -0,0 +1,85 @@ | |||
| % 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
Voir le fichier
| @@ -0,0 +1,47 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/animate_tidyr.R | |||
| \name{animate_spread} | |||
| \alias{animate_spread} | |||
| \title{Animates the spread function} | |||
| \usage{ | |||
| animate_spread(l, key, value, export = "gif", detailed = TRUE, ..., | |||
| anim_opts = anim_options()) | |||
| } | |||
| \arguments{ | |||
| \item{l}{a data_frame in the long/tidy format} | |||
| \item{key}{the key} | |||
| \item{value}{the value} | |||
| \item{export}{the export type, either gif, first or last. The latter two | |||
| export ggplots of the first/last state of the join} | |||
| \item{detailed}{boolean value if the animation should show one step for each | |||
| key value} | |||
| \item{...}{further arguments passed to \link{process_long} or \link{process_wide}} | |||
| \item{anim_opts}{An \code{\link[=anim_options]{anim_options()}} options list.} | |||
| } | |||
| \value{ | |||
| a ggplot or a gif | |||
| } | |||
| \description{ | |||
| Animates the spread function | |||
| } | |||
| \examples{ | |||
| long <- data_frame( | |||
| year = c(2010L, 2011L, 2010L, 2011L, 2010L, 2011L), | |||
| person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), | |||
| sales = c(105, 110, 100, 97, 90, 95) | |||
| ) | |||
| animate_spread(long, key = "person", value = "sales", export = "first") | |||
| animate_spread(long, key = "person", value = "sales", export = "last") | |||
| \donttest{ | |||
| animate_spread(long, key = "person", value = "sales", export = "gif") | |||
| # if you want to have a less detailed animation, you can also use | |||
| animate_spread(long, key = "person", value = "sales", export = "gif", detailed = FALSE) | |||
| } | |||
| } | |||
+ 21
- 0
man/dput_parser.Rd
Voir le fichier
| @@ -0,0 +1,21 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/tidyr_helpers.R | |||
| \name{dput_parser} | |||
| \alias{dput_parser} | |||
| \title{Parses a simple vector so that it looks like its input} | |||
| \usage{ | |||
| dput_parser(x) | |||
| } | |||
| \arguments{ | |||
| \item{x}{a vector} | |||
| } | |||
| \value{ | |||
| a string | |||
| } | |||
| \description{ | |||
| Parses a simple vector so that it looks like its input | |||
| } | |||
| \examples{ | |||
| dput_parser("x") | |||
| dput_parser(c("x", "y")) | |||
| } | |||
BIN
man/figures/tidyexplain-anti-join-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 922KB |
BIN
man/figures/tidyexplain-full-join-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 887KB |
BIN
man/figures/tidyexplain-gather-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 599KB |
BIN
man/figures/tidyexplain-inner-join-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 937KB |
BIN
man/figures/tidyexplain-intersect-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 543KB |
BIN
man/figures/tidyexplain-intial-dfs-1.png
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 14KB |
BIN
man/figures/tidyexplain-intial-dfs-so-1.png
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 9.1KB |
BIN
man/figures/tidyexplain-left-join-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 962KB |
BIN
man/figures/tidyexplain-left-join-extra-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 1.0MB |
BIN
man/figures/tidyexplain-right-join-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 952KB |
BIN
man/figures/tidyexplain-semi-join-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 923KB |
BIN
man/figures/tidyexplain-setdiff-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 595KB |
BIN
man/figures/tidyexplain-setdiff-y-x-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 568KB |
BIN
man/figures/tidyexplain-spread-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 672 | Height: 480 | Size: 628KB |
BIN
man/figures/tidyexplain-union-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 575KB |
BIN
man/figures/tidyexplain-union-all-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 565KB |
BIN
man/figures/tidyexplain-union-y-x-1.gif
Voir le fichier
| Before | After |
|---|---|
|
|
| Width: 480 | Height: 480 | Size: 573KB |
+ 36
- 0
man/gather_spread.Rd
Voir le fichier
| @@ -0,0 +1,36 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/tidyr_helpers.R | |||
| \name{gather_spread} | |||
| \alias{gather_spread} | |||
| \title{Animates a gather or spread function} | |||
| \usage{ | |||
| gather_spread(lhs, rhs, sequence, key_values, export, detailed, ..., | |||
| anim_opts = anim_options()) | |||
| } | |||
| \arguments{ | |||
| \item{lhs}{the (processed) dataset on the left-side} | |||
| \item{rhs}{the (processed) dataset on the right-side} | |||
| \item{sequence}{a named vector of the sequence titles | |||
| (current_state, final_state, operation, and reverse_operation)} | |||
| \item{key_values}{the unique key-values} | |||
| \item{export}{the export type, either gif, first or last. The latter two | |||
| export ggplots of the first/last state of the join} | |||
| \item{detailed}{boolean value if the animation should show one step for each | |||
| key value} | |||
| \item{...}{further arguments passed to animate_plot} | |||
| } | |||
| \value{ | |||
| the plot or the gif | |||
| } | |||
| \description{ | |||
| internally used by animate_spread and animate_gather | |||
| } | |||
| \examples{ | |||
| NULL | |||
| } | |||
+ 23
- 0
man/get_quos_names.Rd
Voir le fichier
| @@ -0,0 +1,23 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/tidyr_helpers.R | |||
| \name{get_quos_names} | |||
| \alias{get_quos_names} | |||
| \title{Gets the ... names} | |||
| \usage{ | |||
| get_quos_names(...) | |||
| } | |||
| \arguments{ | |||
| \item{...}{arguments} | |||
| } | |||
| \value{ | |||
| a vector of the names of ... | |||
| } | |||
| \description{ | |||
| Used to get the -year | |||
| } | |||
| \examples{ | |||
| x <- 1:10 | |||
| y <- 1 | |||
| get_quos_names(-x) | |||
| get_quos_names(x:y) | |||
| } | |||
+ 25
- 0
man/move_together.Rd
Voir le fichier
| @@ -0,0 +1,25 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/move_together.R | |||
| \name{move_together} | |||
| \alias{move_together} | |||
| \title{Combines two processed datasets and combines them for a given method} | |||
| \usage{ | |||
| move_together(lhs, rhs, type) | |||
| } | |||
| \arguments{ | |||
| \item{lhs}{the left-hand side dataset} | |||
| \item{rhs}{the righ-hand side dataset} | |||
| \item{type}{a string of the desired combination method, allowed are all dplyr | |||
| joins or sets} | |||
| } | |||
| \value{ | |||
| processed dataset of the combined values | |||
| } | |||
| \description{ | |||
| Combines two processed datasets and combines them for a given method | |||
| } | |||
| \examples{ | |||
| NULL | |||
| } | |||
+ 12
- 0
man/pipe.Rd
Voir le fichier
| @@ -0,0 +1,12 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/utils-pipe.R | |||
| \name{\%>\%} | |||
| \alias{\%>\%} | |||
| \title{Pipe operator} | |||
| \usage{ | |||
| lhs \%>\% rhs | |||
| } | |||
| \description{ | |||
| See \code{magrittr::\link[magrittr]{\%>\%}} for details. | |||
| } | |||
| \keyword{internal} | |||
+ 32
- 0
man/process_data_join.Rd
Voir le fichier
| @@ -0,0 +1,32 @@ | |||
| % 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
Voir le fichier
| @@ -0,0 +1,31 @@ | |||
| % 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
Voir le fichier
| @@ -0,0 +1,32 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/tidyr_helpers.R | |||
| \name{process_long} | |||
| \alias{process_long} | |||
| \title{Processes a long dataframe and converts it into a dataset that can be plotted} | |||
| \usage{ | |||
| process_long(x, ids, key, value, ...) | |||
| } | |||
| \arguments{ | |||
| \item{x}{a long data frame} | |||
| \item{ids}{a vector of id-variables that are already in the tidy-format} | |||
| \item{key}{a vector of key-variables} | |||
| \item{...}{} | |||
| } | |||
| \value{ | |||
| TODO | |||
| } | |||
| \description{ | |||
| Processes a long dataframe and converts it into a dataset that can be plotted | |||
| } | |||
| \examples{ | |||
| long <- data_frame( | |||
| year = c(2010L, 2011L, 2010L, 2011L, 2010L, 2011L), | |||
| person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), | |||
| sales = c(105, 110, 100, 97, 90, 95) | |||
| ) | |||
| process_long(long, ids = "year", key = "person", value = "sales") | |||
| process_long(long, ids = "year", key = "person", value = "sales") \%>\% static_plot | |||
| } | |||
+ 35
- 0
man/process_wide.Rd
Voir le fichier
| @@ -0,0 +1,35 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/tidyr_helpers.R | |||
| \name{process_wide} | |||
| \alias{process_wide} | |||
| \title{Processes a wide dataframe and converts it into a dataset that can be plotted} | |||
| \usage{ | |||
| process_wide(x, ids, key, color_id = "lightgray", ...) | |||
| } | |||
| \arguments{ | |||
| \item{x}{a wide data frame} | |||
| \item{ids}{a vector of id-variables that are already in the tidy-format} | |||
| \item{key}{a vector of key-variables} | |||
| \item{color_id}{the color for the id-body} | |||
| \item{...}{} | |||
| } | |||
| \value{ | |||
| TODO | |||
| } | |||
| \description{ | |||
| Processes a wide dataframe and converts it into a dataset that can be plotted | |||
| } | |||
| \examples{ | |||
| wide <- data_frame( | |||
| year = 2010:2011, | |||
| Alice = c(105, 110), | |||
| Bob = c(100, 97), | |||
| Charlie = c(90, 95) | |||
| ) | |||
| process_wide(wide, ids = "year", key = "person") | |||
| process_wide(wide, ids = "year", key = "person") \%>\% static_plot | |||
| } | |||
+ 25
- 0
man/set_font_size.Rd
Voir le fichier
| @@ -0,0 +1,25 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/animate_options.R | |||
| \name{set_font_size} | |||
| \alias{set_font_size} | |||
| \alias{get_font_size} | |||
| \title{Set Default Text Sizes for Animation Plots} | |||
| \usage{ | |||
| set_font_size(text_size = NULL, title_size = NULL) | |||
| get_font_size() | |||
| } | |||
| \arguments{ | |||
| \item{text_size}{Font size of value labels inside the data frame squares} | |||
| \item{title_size}{Font size of the function call or plot title} | |||
| } | |||
| \description{ | |||
| Sets the default text sizes for the animated and static plots produced by | |||
| this package during the current session. | |||
| } | |||
| \section{Functions}{ | |||
| \itemize{ | |||
| \item \code{get_font_size}: Get current global font sizes | |||
| }} | |||
+ 50
- 0
man/static_plot.Rd
Voir le fichier
| @@ -0,0 +1,50 @@ | |||
| % 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
Voir le fichier
| @@ -0,0 +1,26 @@ | |||
| % Generated by roxygen2: do not edit by hand | |||
| % Please edit documentation in R/zzzz-package.R | |||
| \docType{package} | |||
| \name{tidyexplain-package} | |||
| \alias{tidyexplain} | |||
| \alias{tidyexplain-package} | |||
| \title{tidyexplain: Animated Explanations of Tidyverse Verbs} | |||
| \description{ | |||
| Animated explanations of the verbs in the tidyverse | |||
| using gganimate and ggplot2. | |||
| } | |||
| \author{ | |||
| \strong{Maintainer}: Garrick Aden-Buie \email{g.adenbuie@gmail.com} | |||
| Authors: | |||
| \itemize{ | |||
| \item David Zimmermann \email{david_j_zimmermann@hotmail.com} | |||
| } | |||
| Other contributors: | |||
| \itemize{ | |||
| \item Tyler Grant Smith [contributor] | |||
| } | |||
| } | |||
| \keyword{internal} | |||
+ 0
- 1
runtime.txt
Voir le fichier
| @@ -1 +0,0 @@ | |||
| r-2018-08-15 | |||
+ 4
- 0
tests/testthat.R
Voir le fichier
| @@ -0,0 +1,4 @@ | |||
| library(testthat) | |||
| library(tidyverbs) | |||
| test_check("tidyverbs") | |||
+ 49
- 0
tests/testthat/test-anim_options.R
Voir le fichier
| @@ -0,0 +1,49 @@ | |||
| context("test-anim_options") | |||
| test_that("merging of animation options works", { | |||
| ao_new <- anim_options(5, 3, text_size = 9, title_size = 13) | |||
| ao_old <- anim_options(ease_default = "cubic-in", text_family = "Times New Roman") | |||
| ao_merged <- anim_options(5, 3, "cubic-in", text_size = 9, title_size = 13, text_family = "Times New Roman") | |||
| expect_equal(merge(ao_new, ao_old), ao_merged) | |||
| }) | |||
| test_that("setting and getting animation options works", { | |||
| set_font_size(5, 10) | |||
| expect_equal(get_anim_opt(), anim_options(text_size = 5, title_size = 10)) | |||
| expect_error(get_anim_opt("text_size")) | |||
| expect_equal(get_text_size(), get_anim_opt()$text_size) | |||
| expect_equal(get_title_size(), get_anim_opt()$title_size) | |||
| anim_options_set(anim_options(2, 1)) | |||
| expect_equal(get_anim_opt("transition_length"), 2) | |||
| expect_equal(get_anim_opt("state_length"), 1) | |||
| expect_equal(get_anim_opt(), anim_options(2, 1, text_size = 5, title_size = 10)) | |||
| anim_options_set() | |||
| expect_equal(get_anim_opt("transition_length"), plot_settings$default$transition_length) | |||
| anim_options_set(anim_options(enter = enter_appear(early = TRUE))) | |||
| expect_equal(names(get_anim_opt("enter")), "enter_appear(early = TRUE)") | |||
| expect_s3_class(get_anim_opt("enter")[[1]], "ggproto") | |||
| anim_options_set() | |||
| }) | |||
| test_that("precedence: function > user-set global > default (> global default)", { | |||
| ao_function <- anim_options(ease_default = "linear") | |||
| ao_global <- anim_options(ease_default = "cubic", text_family = "Arial") | |||
| expect_equal(default_anim_opts("gather", ao_function)$ease_default, "linear") | |||
| anim_options_set(ao_global) | |||
| expect_equal(default_anim_opts("gather")$ease_default, "cubic") | |||
| expect_equal(default_anim_opts("gather", ao_function)$ease_default, "linear") | |||
| ao_default <- default_anim_opts("gather", ao_function) # inside animate_ function | |||
| ao_final <- validate_anim_opts(ao_default) # just before animate_plot() or static_plot() | |||
| expect_equal(ao_final$ease_default, "linear") | |||
| expect_equal(ao_final$text_family, "Arial") | |||
| expect_equivalent(names(ao_final$ease_other), c("y", "x")) | |||
| expect_equal(ao_final$title_family, plot_settings$default$title_family) | |||
| anim_options_set() | |||
| }) | |||
+ 6
- 0
tests/testthat/test-choose_text_color.R
Voir le fichier
| @@ -0,0 +1,6 @@ | |||
| context("test-set_text_color") | |||
| test_that("correct color selection", { | |||
| colors <- c("#FFFFFF", scales::brewer_pal("seq", "Set1")(4), "#000000") | |||
| expect_equal(choose_text_color(colors), c("#000000", rep("#FFFFFF", 5))) | |||
| }) | |||
+ 12
- 0
tests/testthat/test-tidyr_helpers.R
Voir le fichier
| @@ -0,0 +1,12 @@ | |||
| context("test-tidyr_helpers") | |||
| test_that("get_quos_names works", { | |||
| expect_equivalent(get_quos_names(-x), "-x") | |||
| expect_equivalent(get_quos_names(x:y), "x:y") | |||
| expect_equivalent(get_quos_names(-x, -y, -z), c("-x", "-y", "-z")) | |||
| }) | |||
| test_that("dput_parsers works", { | |||
| expect_equal(dput_parser("x"), '"x"') | |||
| expect_equal(dput_parser(c("x", "y")), 'c("x", "y")') | |||
| }) | |||
tidy-animated-verbs.Rproj → tidyexplain.Rproj
Voir le fichier
Chargement…