Преглед изворни кода

Merge pull request #16 from gadenbuie/pkg-updates

Pkg updates
master-davzim
DavZim пре 7 година
родитељ
комит
519a82767e
No account linked to committer's email address
65 измењених фајлова са 912 додато и 549 уклоњено
  1. +8
    -4
      DESCRIPTION
  2. +11
    -0
      NAMESPACE
  3. +0
    -117
      R/animate_helpers.R
  4. +78
    -30
      R/animate_joins.R
  5. +213
    -0
      R/animate_options.R
  6. +76
    -31
      R/animate_sets.R
  7. +22
    -29
      R/animate_tidyr.R
  8. +5
    -6
      R/move_together.R
  9. +38
    -33
      R/plot_helpers.R
  10. +7
    -7
      R/process_data_helpers.R
  11. +30
    -27
      R/tidyr_helpers.R
  12. +26
    -0
      R/utils.R
  13. +17
    -1
      R/zzzz-package.R
  14. +67
    -65
      README.Rmd
  15. +49
    -46
      README.md
  16. BIN
      README_files/figure-gfm/anti-join-1.gif
  17. BIN
      README_files/figure-gfm/full-join-1.gif
  18. BIN
      README_files/figure-gfm/inner-join-1.gif
  19. BIN
      README_files/figure-gfm/intersect-1.gif
  20. BIN
      README_files/figure-gfm/intial-dfs-1.png
  21. BIN
      README_files/figure-gfm/intial-dfs-so-1.png
  22. BIN
      README_files/figure-gfm/left-join-1.gif
  23. BIN
      README_files/figure-gfm/left-join-extra-1.gif
  24. BIN
      README_files/figure-gfm/right-join-1.gif
  25. BIN
      README_files/figure-gfm/semi-join-1.gif
  26. BIN
      README_files/figure-gfm/setdiff-1.gif
  27. BIN
      README_files/figure-gfm/union-1.gif
  28. BIN
      README_files/figure-gfm/union-all-1.gif
  29. BIN
      README_files/figure-gfm/unnamed-chunk-12-1.gif
  30. BIN
      README_files/figure-gfm/unnamed-chunk-16-1.gif
  31. BIN
      README_files/figure-gfm/unnamed-chunk-18-1.gif
  32. BIN
      README_files/figure-gfm/unnamed-chunk-20-1.gif
  33. +57
    -0
      man/anim_options.Rd
  34. +7
    -3
      man/animate_gather.Rd
  35. +28
    -30
      man/animate_join.Rd
  36. +0
    -31
      man/animate_join_function.Rd
  37. +8
    -12
      man/animate_plot.Rd
  38. +27
    -28
      man/animate_set.Rd
  39. +0
    -29
      man/animate_set_function.Rd
  40. +7
    -4
      man/animate_spread.Rd
  41. BIN
      man/figures/tidyexplain-anti-join-1.gif
  42. BIN
      man/figures/tidyexplain-full-join-1.gif
  43. BIN
      man/figures/tidyexplain-gather-1.gif
  44. BIN
      man/figures/tidyexplain-inner-join-1.gif
  45. BIN
      man/figures/tidyexplain-intersect-1.gif
  46. BIN
      man/figures/tidyexplain-intial-dfs-1.png
  47. BIN
      man/figures/tidyexplain-intial-dfs-so-1.png
  48. BIN
      man/figures/tidyexplain-left-join-1.gif
  49. BIN
      man/figures/tidyexplain-left-join-extra-1.gif
  50. BIN
      man/figures/tidyexplain-right-join-1.gif
  51. BIN
      man/figures/tidyexplain-semi-join-1.gif
  52. BIN
      man/figures/tidyexplain-setdiff-1.gif
  53. BIN
      man/figures/tidyexplain-setdiff-y-x-1.gif
  54. BIN
      man/figures/tidyexplain-spread-1.gif
  55. BIN
      man/figures/tidyexplain-union-1.gif
  56. BIN
      man/figures/tidyexplain-union-all-1.gif
  57. BIN
      man/figures/tidyexplain-union-y-x-1.gif
  58. +2
    -1
      man/gather_spread.Rd
  59. +25
    -0
      man/set_font_size.Rd
  60. +27
    -10
      man/static_plot.Rd
  61. +6
    -5
      man/tidyexplain-package.Rd
  62. +4
    -0
      tests/testthat.R
  63. +49
    -0
      tests/testthat/test-anim_options.R
  64. +6
    -0
      tests/testthat/test-choose_text_color.R
  65. +12
    -0
      tests/testthat/test-tidyr_helpers.R

+ 8
- 4
DESCRIPTION Прегледај датотеку

Type: Package Type: Package
Package: tidyverbs
Title: Animate the Verbs of the Tidyverse
Package: tidyexplain
Title: Animated Explanations of Tidyverse Verbs
Version: 0.0.1.9000 Version: 0.0.1.9000
Date: 2018-08-27 Date: 2018-08-27
Authors@R: Authors@R:
person(given = "Tyler Grant", person(given = "Tyler Grant",
family = "Smith", family = "Smith",
role = "ctb")) role = "ctb"))
Description: Animate the verbs of the tidyverse.
Description: Animated explanations of the verbs in the tidyverse
using gganimate and ggplot2.
License: MIT + file LICENSE License: MIT + file LICENSE
Depends: Depends:
gganimate (>= 0.9.9.9999), gganimate (>= 0.9.9.9999),
Imports: Imports:
dplyr, dplyr,
magrittr, magrittr,
purrr,
rlang (>= 0.1.2), rlang (>= 0.1.2),
scales, scales,
tidyr
tidyr,
tidyselect
Suggests: Suggests:
knitr, knitr,
roxygen2, roxygen2,
testthat,
viridis viridis
VignetteBuilder: VignetteBuilder:
knitr knitr

+ 11
- 0
NAMESPACE Прегледај датотеку

# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand


S3method(print,anim_opts)
export("%>%") export("%>%")
export(anim_options)
export(anim_options_set)
export(animate_anti_join) export(animate_anti_join)
export(animate_full_join) export(animate_full_join)
export(animate_gather) export(animate_gather)
export(animate_spread) export(animate_spread)
export(animate_union) export(animate_union)
export(animate_union_all) export(animate_union_all)
export(get_font_size)
export(is.anim_opts)
export(set_font_size)
importFrom(dplyr,anti_join) importFrom(dplyr,anti_join)
importFrom(dplyr,arrange) importFrom(dplyr,arrange)
importFrom(dplyr,bind_cols) importFrom(dplyr,bind_cols)
importFrom(dplyr,bind_rows) importFrom(dplyr,bind_rows)
importFrom(dplyr,data_frame)
importFrom(dplyr,filter) importFrom(dplyr,filter)
importFrom(dplyr,full_join) importFrom(dplyr,full_join)
importFrom(dplyr,group_by) importFrom(dplyr,group_by)
importFrom(dplyr,mutate) importFrom(dplyr,mutate)
importFrom(dplyr,pull) importFrom(dplyr,pull)
importFrom(dplyr,right_join) importFrom(dplyr,right_join)
importFrom(dplyr,row_number)
importFrom(dplyr,select) importFrom(dplyr,select)
importFrom(dplyr,semi_join) importFrom(dplyr,semi_join)
importFrom(dplyr,slice)
importFrom(magrittr,"%>%") importFrom(magrittr,"%>%")
importFrom(tidyr,gather)
importFrom(tidyr,spread)

+ 0
- 117
R/animate_helpers.R Прегледај датотеку


#' Animates a set - wrapper function
#'
#' @param x left dataset
#' @param y right dataset
#' @param type type of the set, i.e., intersect, setdiff, etc.
#' @param export if the function exports a gif, the first, or last picture
#' @param ... further arguments passed to static_plot or to add_color
#'
#'
#' @name animate_set_function
#' @return either a gif or a ggplot
#'
#' @examples
#' NULL
animate_set <- function(x, y, type, export = "gif", ...) {

if (!all(names(x) %in% names(y)) && ncol(x) == ncol(y))
stop("x and y must have the same variables/column-names")

if (!type %in% c("union", "union_all", "intersect", "setdiff"))
stop("type has to be a dplyr-set operation")

if (!export %in% c("gif", "first", "last"))
stop("export must be either gif, first, or last")

title <- sprintf(paste0(type, "(%s, %s)"),
deparse(substitute(x)),
deparse(substitute(y)))

if (type %in% c("union", "intersect", "setdiff")) {
x <- dplyr::distinct(x)
y <- dplyr::distinct(y)
}

if (type == "union_all") {
ll <- process_join(x, y, by = names(x), fill = FALSE, ...)
ll <- lapply(ll, function(a)
a %>% mutate(.id_long = paste(.id_long, .side, sep = "-"))
)
} else {
ll <- process_join(x, y, by = names(x), ...)
}

step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)

step1 <- move_together(ll$x, ll$y, type) %>% mutate(.frame = 1)

all <- bind_rows(step0, step1)

if (export == "gif") {
animate_plot(all, title, ...) %>% animate()
} else if (export == "first") {
title <- ""
static_plot(step0, title, ...)
} else if (export == "last") {
static_plot(step1, title, ...)
}
}

#' Animates a join - wrapper function
#'
#' @param x left dataset
#' @param y right dataset
#' @param by by arguments for the join
#' @param type type of the join, i.e., left_join, right_join, etc.
#' @param export if the function exports a gif, the first, or last picture
#' @param ... further arguments passed to static_plot or to add_color
#'
#' @return either a gif or a ggplot
#'
#' @name animate_join_function
#'
#' @examples
#' NULL
animate_join <- function(x, y, by, type, export = "gif", ...) {

if (!type %in% c("full_join", "inner_join", "left_join", "right_join",
"semi_join", "anti_join"))
stop("type has to be a dplyr-join")

if (!export %in% c("gif", "first", "last"))
stop("export must be either gif, first, or last")

by_args <- ifelse(length(by) == 1,
sprintf("\"%s\"", by),
sprintf("c(\"%s\")", paste(by, collapse = "\", \""))
)

title <- sprintf(paste0(type, "(%s, %s, by = %s)"),
deparse(substitute(x)),
deparse(substitute(y)),
by_args)

if (type %in% c("semi_join", "anti_join")) {
# for semi and anti_joins, there is no adding of multiple rows
y <- dplyr::distinct(y)
}

ll <- process_join(x, y, by, ...)

step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)

step1 <- move_together(ll$x, ll$y, type) %>% mutate(.frame = 1)

all <- bind_rows(step0, step1)

if (export == "gif") {
animate_plot(all, title, ...)
} else if (export == "first") {
title <- ""
static_plot(step0, title, ...)
} else if (export == "last") {
static_plot(step1, title, ...)
}
}


+ 78
- 30
R/animate_joins.R Прегледај датотеку

#' #'
#' @name animate_join #' @name animate_join
#' @examples #' @examples
#' x <- data_frame(
#' id = 1:3,
#' x = paste0("x", 1:3)
#' )
#' y <- data_frame(
#' id = (1:4)[-3],
#' y = paste0("y", (1:4)[-3])
#' )
#' x <- data_frame(id = 1:3, x = paste0("x", 1:3))
#' y <- data_frame(id = (1:4)[-3], y = paste0("y", (1:4)[-3]))
#' #'
#' # Animate the first or last state of the join #' # Animate the first or last state of the join
#' animate_full_join(x, y, by = "id", export = "first") #' animate_full_join(x, y, by = "id", export = "first")
#' #'
#' # animate the transition as a gif (default) #' # animate the transition as a gif (default)
#' \donttest{ #' \donttest{
#' animate_full_join(x, y, by = "id", export = "gif")
#' animate_full_join(x, y, by = "id", export = "gif")
#' } #' }
#' #'
#' # different options include #' # different options include
#' \donttest{ #' \donttest{
#' animate_full_join(x, y, by = "id")
#' animate_inner_join(x, y, by = "id")
#' animate_left_join(x, y, by = "id")
#' animate_right_join(x, y, by = "id")
#' animate_semi_join(x, y, by = "id")
#' animate_anti_join(x, y, by = "id")
#' animate_full_join(x, y, by = "id")
#' animate_inner_join(x, y, by = "id")
#' animate_left_join(x, y, by = "id")
#' animate_right_join(x, y, by = "id")
#' animate_semi_join(x, y, by = "id")
#' animate_anti_join(x, y, by = "id")
#' #'
#' # further arguments can be passed to all animate_* functions
#' animate_full_join(
#' x, y, by = "id", export = "last",
#' text_size = 5, title_size = 25,
#' color_header = "black",
#' color_other = "lightblue",
#' color_fun = viridis::viridis
#' )
#' # further arguments can be passed to all animate_* functions
#' animate_full_join(
#' x, y, by = "id", export = "last",
#' text_size = 5, title_size = 25,
#' color_header = "black",
#' color_other = "lightblue",
#' color_fun = viridis::viridis
#' )
#' } #' }
#' #'
#' # Save the results #' # Save the results
#' \donttest{ #' \donttest{
#' # to save the ggplot, use
#' fj <- animate_full_join(x, y, by = "id", export = "last")
#' ggsave("full-join.pdf", fj)
#' # to save the ggplot, use
#' fj <- animate_full_join(x, y, by = "id", export = "last")
#' ggsave("full-join.pdf", fj)
#' #'
#' # to save the gif, use
#' fj <- animate_full_join(x, y, by = "id", export = "gif")
#' anim_save(fj, "full-join.gif")
#' # to save the gif, use
#' fj <- animate_full_join(x, y, by = "id", export = "gif")
#' anim_save(fj, "full-join.gif")
#' } #' }
NULL
animate_join <- function(
x,
y,
by,
type = c("full_join", "inner_join", "left_join", "right_join",
"semi_join", "anti_join"),
export = c("gif", "first", "last"),
...
) {
type <- match.arg(type)
export <- match.arg(export)
x_name <- get_input_text(x)
y_name <- get_input_text(y)
data <- make_named_data(x, y)

by_args <- if (length(by) == 1) sprintf("\"%s\"", by) else
sprintf("c(\"%s\")", paste(by, collapse = "\", \""))

title <- sprintf(paste0(type, "(%s, %s, by = %s)"), x_name, y_name, by_args)

if (type %in% c("semi_join", "anti_join")) {
# for semi and anti_joins, there is no adding of multiple rows
data$y <- dplyr::distinct(data$y)
}

ll <- process_join(data$x, data$y, by, ...)

step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)

step1 <- move_together(ll$x, ll$y, type) %>% mutate(.frame = 1)

all <- bind_rows(step0, step1)

if (export == "gif") {
animate_plot(all, title, ...)
} else if (export == "first") {
title <- ""
static_plot(step0, title, ...)
} else if (export == "last") {
static_plot(step1, title, ...)
}
}



#' @rdname animate_join #' @rdname animate_join
#' @export #' @export
animate_full_join <- function(x, y, by, export = "gif", ...) { animate_full_join <- function(x, y, by, export = "gif", ...) {
x <- rlang::enquo(x)
y <- rlang::enquo(y)
animate_join(x, y, by, type = "full_join", export = export, ...) animate_join(x, y, by, type = "full_join", export = export, ...)
} }


#' @rdname animate_join #' @rdname animate_join
#' @export #' @export
animate_inner_join <- function(x, y, by, export = "gif", ...) { animate_inner_join <- function(x, y, by, export = "gif", ...) {
x <- rlang::enquo(x)
y <- rlang::enquo(y)
animate_join(x, y, by, type = "inner_join", export = export, ...) animate_join(x, y, by, type = "inner_join", export = export, ...)
} }


#' @rdname animate_join #' @rdname animate_join
#' @export #' @export
animate_left_join <- function(x, y, by, export = "gif", ...) { animate_left_join <- function(x, y, by, export = "gif", ...) {
x <- rlang::enquo(x)
y <- rlang::enquo(y)
animate_join(x, y, by, type = "left_join", export = export, ...) animate_join(x, y, by, type = "left_join", export = export, ...)
} }


#' @rdname animate_join #' @rdname animate_join
#' @export #' @export
animate_right_join <- function(x, y, by, export = "gif", ...) { animate_right_join <- function(x, y, by, export = "gif", ...) {
x <- rlang::enquo(x)
y <- rlang::enquo(y)
animate_join(x, y, by, type = "right_join", export = export, ...) animate_join(x, y, by, type = "right_join", export = export, ...)
} }


#' @rdname animate_join #' @rdname animate_join
#' @export #' @export
animate_semi_join <- function(x, y, by, export = "gif", ...) { animate_semi_join <- function(x, y, by, export = "gif", ...) {
x <- rlang::enquo(x)
y <- rlang::enquo(y)
animate_join(x, y, by, type = "semi_join", export = export, ...) animate_join(x, y, by, type = "semi_join", export = export, ...)
} }


#' @rdname animate_join #' @rdname animate_join
#' @export #' @export
animate_anti_join <- function(x, y, by, export = "gif", ...) { animate_anti_join <- function(x, y, by, export = "gif", ...) {
x <- rlang::enquo(x)
y <- rlang::enquo(y)
animate_join(x, y, by, type = "anti_join", export = export, ...) animate_join(x, y, by, type = "anti_join", export = export, ...)
} }

+ 213
- 0
R/animate_options.R Прегледај датотеку

#' 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
}

+ 76
- 31
R/animate_sets.R Прегледај датотеку

#' @param y the y dataset #' @param y the y dataset
#' @param export the export type, either gif, first or last. The latter two #' @param export the export type, either gif, first or last. The latter two
#' export ggplots of the first/last state of the join #' export ggplots of the first/last state of the join
#' @param type type of the set, i.e., intersect, setdiff, etc.
#' @param ... further argument passed to static_plot #' @param ... further argument passed to static_plot
#' #'
#' @return either a gif or a ggplot #' @return either a gif or a ggplot
#' #'
#' @seealso \code{\link[dplyr]{setops}} #' @seealso \code{\link[dplyr]{setops}}
#' #'
#' @name animate_set
#'
#' @examples #' @examples
#' x <- data_frame(
#' x = c(1, 1, 2),
#' y = c("a", "b", "a")
#' )
#' y <- data_frame(
#' x = c(1, 2),
#' y = c("a", "b")
#' )
#' x <- data_frame(x = c(1, 1, 2), y = c("a", "b", "a"))
#' y <- data_frame(x = c(1, 2), y = c("a", "b"))
#' #'
#' # Animate the first or last state of the set #' # Animate the first or last state of the set
#' animate_union(x, y, export = "first") #' animate_union(x, y, export = "first")
#' #'
#' # animate the transition as a gif (default) #' # animate the transition as a gif (default)
#' \donttest{ #' \donttest{
#' animate_union(x, y, export = "gif")
#' animate_union(x, y, export = "gif")
#' } #' }
#' #'
#' # different options include #' # different options include
#' \donttest{ #' \donttest{
#' animate_union(x, y)
#' animate_union_all(x, y)
#' animate_intersect(x, y)
#' animate_setdiff(x, y)
#' animate_union(x, y)
#' animate_union_all(x, y)
#' animate_intersect(x, y)
#' animate_setdiff(x, y)
#' #'
#' # further arguments can be passed to all animate_* functions
#' animate_union(
#' x, y,
#' text_size = 5, title_size = 25,
#' color_header = "black",
#' color_other = "lightblue",
#' color_fun = viridis::viridis
#' )
#' # further arguments can be passed to all animate_* functions
#' animate_union(
#' x, y,
#' text_size = 5, title_size = 25,
#' color_header = "black",
#' color_other = "lightblue",
#' color_fun = viridis::viridis
#' )
#' } #' }
#' #'
#' # Save the results #' # Save the results
#' \dontrun{ #' \dontrun{
#' # to save the ggplot, use
#' un <- animate_union(x, y, by = "id", export = "last")
#' ggsave("union.pdf", un)
#' # to save the ggplot, use
#' un <- animate_union(x, y, by = "id", export = "last")
#' ggsave("union.pdf", un)
#' #'
#' animate_union(x, y, by = "id", export = "gif")
#' # to save the gif, use
#' un <- animate_union(x, y, by = "id", export = "gif")
#' anim_save(un, "union.gif")
#' animate_union(x, y, by = "id", export = "gif")
#' # to save the gif, use
#' un <- animate_union(x, y, by = "id", export = "gif")
#' anim_save(un, "union.gif")
#' } #' }
NULL
animate_set <- function(
x, y,
type = c("union", "union_all", "intersect", "setdiff"),
export = c("gif", "first", "last"),
...
) {
type <- match.arg(type)
export <- match.arg(export)
x_name <- get_input_text(x)
y_name <- get_input_text(y)
data <- make_named_data(x, y)

col_names <- purrr::map(data, names)

if (!all(names(data$x) %in% names(data$y)) && ncol(data$x) == ncol(data$y))
stop("x and y must have the same variables/column-names")

title <- sprintf(paste0(type, "(%s, %s)"), x_name, y_name)

if (type %in% c("union", "intersect", "setdiff")) {
data <- purrr::map(data, dplyr::distinct)
}

if (type == "union_all") {
ll <- process_join(data$x, data$y, by = names(data$x), fill = FALSE, ...)
ll <- purrr::map(ll, ~ mutate(., .id_long = paste(.id_long, .side, sep = "-")))
} else {
ll <- process_join(data$x, data$y, by = names(data$x), ...)
}

step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)

step1 <- move_together(ll$x, ll$y, type) %>% mutate(.frame = 1)

all <- bind_rows(step0, step1)

if (export == "gif") {
animate_plot(all, title, ...) %>% animate()
} else if (export == "first") {
title <- ""
static_plot(step0, title, ...)
} else if (export == "last") {
static_plot(step1, title, ...)
}
}


#' @rdname animate_set #' @rdname animate_set
#' @export #' @export
animate_union <- function(x, y, export = "gif", ...) { animate_union <- function(x, y, export = "gif", ...) {
x <- rlang::enquo(x)
y <- rlang::enquo(y)
animate_set(x, y, type = "union", export = export, ...) animate_set(x, y, type = "union", export = export, ...)
} }


#' @rdname animate_set #' @rdname animate_set
#' @export #' @export
animate_union_all <- function(x, y, export = "gif", ...) { animate_union_all <- function(x, y, export = "gif", ...) {
x <- rlang::enquo(x)
y <- rlang::enquo(y)
animate_set(x, y, type = "union_all", export = export, ...) animate_set(x, y, type = "union_all", export = export, ...)
} }


#' @rdname animate_set #' @rdname animate_set
#' @export #' @export
animate_intersect <- function(x, y, export = "gif", ...) { animate_intersect <- function(x, y, export = "gif", ...) {
x <- rlang::enquo(x)
y <- rlang::enquo(y)
animate_set(x, y, type = "intersect", export = export, ...) animate_set(x, y, type = "intersect", export = export, ...)
} }


#' @rdname animate_set #' @rdname animate_set
#' @export #' @export
animate_setdiff <- function(x, y, export = "gif", ...) { animate_setdiff <- function(x, y, export = "gif", ...) {
x <- rlang::enquo(x)
y <- rlang::enquo(y)
animate_set(x, y, type = "setdiff", export = export, ...) animate_set(x, y, type = "setdiff", export = export, ...)
} }

+ 22
- 29
R/animate_tidyr.R Прегледај датотеку


#' Animates the gather function #' Animates the gather function
#' #'
#' @param w a data_frame in the wide format #' @param w a data_frame in the wide format
#' @param key the key #' @param key the key
#' @param value the value #' @param value the value
#' @param ... further arguments passed to gather, static_plot, or animate_plot
#' @param export the export type, either gif, first or last. The latter two
#' export ggplots of the first/last state of the gather function
#' @param ... further arguments passed to [tidyr::gather()], [process_wide()],
#' or [process_long()]
#' @param detailed boolean value if the animation should show one step for each #' @param detailed boolean value if the animation should show one step for each
#' key value
#' key value
#' @inheritParams animate_join
#' @inheritParams anim_options
#' #'
#' @return a gif or a ggplot #' @return a gif or a ggplot
#' @export #' @export
#' # if you want to have a less detailed animation, you can also use #' # if you want to have a less detailed animation, you can also use
#' animate_gather(wide, "person", "sales", -year, export = "gif", detailed = FALSE) #' animate_gather(wide, "person", "sales", -year, export = "gif", detailed = FALSE)
#' } #' }
animate_gather <- function(w, key, value, ..., export = "gif", detailed = TRUE) {
animate_gather <- function(w, key, value, ..., export = "gif", detailed = TRUE, anim_opts = anim_options()) {
anim_opts <- default_anim_opts("gather", anim_opts)
lhs <- w lhs <- w
rhs <- tidyr::gather(w, !!key, !!value, ...) rhs <- tidyr::gather(w, !!key, !!value, ...)


# construct the title sequence # construct the title sequence
wname <- deparse(substitute(w)) wname <- deparse(substitute(w))
ids <- get_quos_names(...)
# ids <- ""
# what happens if ids := -year or ids := x:y

# the case that ... contains two -arguments. i.e., -year, -region
ids <- ids[2, ]
ids <- ids[!ids %in% c(key, value)]
ids <- ids[ids != "-"]
tidyr_selection <- get_quos_names(...)
ids <- setdiff(colnames(w), tidyselect::vars_select(colnames(w), ...))


id_string <- paste0(", ", paste(sprintf("-%s", ids), collapse = ", "))
id_string <- paste0(", ", paste(sprintf("%s", tidyr_selection), collapse = ", "))


sequence <- c( sequence <- c(
current_state = "Wide",
final_state = "Long",
current_state = "wide",
final_state = "long",
operation = sprintf("gather(%s, %s, %s%s)", operation = sprintf("gather(%s, %s, %s%s)",
wname, wname,
dput_parser(key), dput_parser(key),
rhs_proc <- process_long(rhs, ids, key, value, ...) rhs_proc <- process_long(rhs, ids, key, value, ...)


gather_spread(lhs_proc, rhs_proc, sequence = sequence, key_values = key_values, gather_spread(lhs_proc, rhs_proc, sequence = sequence, key_values = key_values,
export = export, detailed = detailed, ...)
export = export, detailed = detailed, ..., anim_opts = anim_opts)
} }




#' Animates the spread function #' Animates the spread function
#' #'
#' @param l a data_frame in the long/tidy format #' @param l a data_frame in the long/tidy format
#' @param key the key
#' @param value the values
#' @param export the export type, either gif, first or last. The latter two
#' export ggplots of the first/last state of the spread function
#' @param detailed boolean value if the animation should show one step for each
#' key value
#' @param ... further arguments passed to static_plot
#' @param ... further arguments passed to [process_long] or [process_wide]
#' @inheritParams animate_gather
#' @inheritParams animate_join
#' @inheritParams anim_options
#' #'
#' @return a ggplot or a gif #' @return a ggplot or a gif
#' @export #' @export
#' # if you want to have a less detailed animation, you can also use #' # if you want to have a less detailed animation, you can also use
#' animate_spread(long, key = "person", value = "sales", export = "gif", detailed = FALSE) #' animate_spread(long, key = "person", value = "sales", export = "gif", detailed = FALSE)
#' } #' }
animate_spread <- function(l, key, value, export = "gif", detailed = TRUE, ...) {
animate_spread <- function(l, key, value, export = "gif", detailed = TRUE, ..., anim_opts = anim_options()) {
anim_opts <- default_anim_opts("spread", anim_opts)


lhs <- l lhs <- l
rhs <- tidyr::spread(l, key = key, value = value) rhs <- tidyr::spread(l, key = key, value = value)
id_string <- paste0(", ", paste(sprintf("-%s", ids), collapse = ", ")) id_string <- paste0(", ", paste(sprintf("-%s", ids), collapse = ", "))


sequence <- c( sequence <- c(
current_state = "Long",
final_state = "Wide",
current_state = "long",
final_state = "wide",
operation = sprintf("spread(%s, %s, %s)", operation = sprintf("spread(%s, %s, %s)",
lname, lname,
dput_parser(key), dput_parser(key),
rhs_proc <- process_wide(rhs, ids, key, value, ...) rhs_proc <- process_wide(rhs, ids, key, value, ...)


key_values <- lhs %>% pull(key) %>% unique() key_values <- lhs %>% pull(key) %>% unique()
gather_spread(lhs_proc, rhs_proc, sequence, key_values, export, detailed, ...)
gather_spread(lhs_proc, rhs_proc, sequence, key_values, export, detailed, ..., anim_opts = anim_opts)
} }

+ 5
- 6
R/move_together.R Прегледај датотеку

all <- bind_rows(lhs, rhs) all <- bind_rows(lhs, rhs)


# separate column and row-filter (ids) # separate column and row-filter (ids)
x_cols <- distinct(lhs, .col)
y_cols <- distinct(rhs, .col)
x_cols <- dplyr::distinct(lhs, .col)
y_cols <- dplyr::distinct(rhs, .col)


# separate header columns from ids and treat them as columns # separate header columns from ids and treat them as columns
x_ids <- distinct(lhs, .id, .id_long)
y_ids <- distinct(rhs, .id, .id_long)
x_ids <- dplyr::distinct(lhs, .id, .id_long)
y_ids <- dplyr::distinct(rhs, .id, .id_long)


x_headers <- filter(x_ids, grepl("^\\.header", .id_long)) x_headers <- filter(x_ids, grepl("^\\.header", .id_long))
y_headers <- filter(y_ids, grepl("^\\.header", .id_long)) y_headers <- filter(y_ids, grepl("^\\.header", .id_long))
.x = xvals[.col], .x = xvals[.col],
.y = yvals[.id_long]) .y = yvals[.id_long])


res <- bind_rows(
bind_rows(
# take, # take,
take_vals, take_vals,
# fade in place: # fade in place:
all %>% filter(.id_long %in% take_ids$.id_long & !.col %in% take_cols$.col) %>% all %>% filter(.id_long %in% take_ids$.id_long & !.col %in% take_cols$.col) %>%
mutate(.alpha = 0) mutate(.alpha = 0)
) )
return(res)
} }

+ 38
- 33
R/plot_helpers.R Прегледај датотеку



set_text_color <- function(a) ifelse(apply(col2rgb(a), 2, mean) > 127, "black", "white")

#' Animates a plot
#'
#' @param d a preprocessed dataset
#' @param title the plot title
#' @param transition_length see transition_states
#' @param state_length see transition_states
#' @param ... further arguments passed to static_plot
#'
#' @return a gif
#' Animate a Plot
#' #'
#' @param d a processed dataset
#' @param title the title of the plot
#' @param anim_opts Animation options generated with [anim_options()]. Overrides
#' any options set in `...`.
#' @return a `gganim` object
#' @examples #' @examples
#' NULL #' NULL
animate_plot <- function(d, title = "", transition_length = 2, state_length = 1, ...) {
static_plot(d, title, ...) +
transition_states(.frame, transition_length, state_length) +
enter_fade() +
exit_fade() +
ease_aes("sine-in-out")
animate_plot <- function(
d,
title = "",
...,
anim_opts = anim_options(...)
) {
ao <- validate_anim_opts(anim_opts)
ease_opts <- if (!is.null(ao$ease_other)) {
ao$ease_other$default <- ao$ease_default
ao$ease_other
} else list(default = ao$ease_default)
ao_ease_aes <- do.call(ease_aes, ease_opts)

static_plot(d, title, anim_opts = ao) +
transition_states(.frame, ao$transition_length, ao$state_length) +
ao$enter[[1]] +
ao$exit[[1]] +
ao_ease_aes
} }




#' Prints the tiles for a processed dataset statically #' Prints the tiles for a processed dataset statically
#' #'
#' @param d a processed dataset
#' @param title the title of the plot
#' @param text_family the font for the text
#' @param title_family the font for the title
#' @param text_size the size of the text
#' @param title_size the size of the title
#' @param ... further arguments
#' @inheritParams animate_plot
#' @inheritDotParams anim_options
#' #'
#' @return a ggplot #' @return a ggplot
#' #'
#' @examples #' @examples
#' NULL #' NULL
static_plot <- function(d, title = "",
text_family = "Fira Sans", title_family = "Fira Mono",
text_size = 5, title_size = 17, ...) {
static_plot <- function(
d,
title = "",
...,
anim_opts = anim_options(...)
) {
ao <- validate_anim_opts(anim_opts)
text_size <- get_text_size(ao$text_size)
title_size <- get_title_size(ao$title_size)


if (!".alpha" %in% names(d)) d <- d %>% mutate(.alpha = 1) if (!".alpha" %in% names(d)) d <- d %>% mutate(.alpha = 1)
if (!".textcolor" %in% names(d)) if (!".textcolor" %in% names(d))
d <- d %>% mutate(.textcolor = set_text_color(.color))
d <- d %>% mutate(.textcolor = choose_text_color(.color))


if (".id_long" %in% names(d)) { if (".id_long" %in% names(d)) {
d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-")) d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-"))
geom_tile(width = 0.9, height = 0.9) + geom_tile(width = 0.9, height = 0.9) +
coord_equal() + coord_equal() +
geom_text(data = d %>% filter(!is.na(.val)), aes(label = .val, color = .textcolor), geom_text(data = d %>% filter(!is.na(.val)), aes(label = .val, color = .textcolor),
family = text_family, size = text_size) +
family = ao$text_family, size = text_size) +
scale_fill_identity() + scale_fill_identity() +
scale_color_identity() + scale_color_identity() +
scale_alpha_identity() + scale_alpha_identity() +
labs(title = title) + labs(title = title) +
theme_void() + theme_void() +
theme(plot.title = element_text(family = title_family, hjust = 0.5, size = title_size))
theme(plot.title = element_text(family = ao$title_family, hjust = 0.5, size = title_size))
} }


+ 7
- 7
R/process_data_helpers.R Прегледај датотеку

} }


x <- x %>% x <- x %>%
unite(one_of(by), col = ".id", remove = FALSE) %>%
tidyr::unite(dplyr::one_of(by), col = ".id", remove = FALSE) %>%
mutate(.id_long = add_duplicate_number(.id)) mutate(.id_long = add_duplicate_number(.id))


y <- y %>% y <- y %>%
unite(one_of(by), col = ".id", remove = FALSE) %>%
tidyr::unite(dplyr::one_of(by), col = ".id", remove = FALSE) %>%
mutate(.id_long = add_duplicate_number(.id)) mutate(.id_long = add_duplicate_number(.id))


ids <- dplyr::union(x %>% dplyr::select(.id, .id_long), ids <- dplyr::union(x %>% dplyr::select(.id, .id_long),
y_ <- process_data_join(y, ids, by, fill = fill, ...) %>% y_ <- process_data_join(y, ids, by, fill = fill, ...) %>%
mutate(.x = .x + ncol(x) - 1) mutate(.x = .x + ncol(x) - 1)


return(list(x = x_, y = y_))
list(x = x_, y = y_)
} }






x <- x %>% x <- x %>%
mutate(.r = row_number()) %>% mutate(.r = row_number()) %>%
gather_(key = ".col", value = ".val", names(x)[grepl("^[^.]", names(x))]) %>%
# TODO re-evaluate gather_ here
tidyr::gather_(key = ".col", value = ".val", names(x)[grepl("^[^.]", names(x))]) %>%
mutate(.x = x_keys[.col], mutate(.x = x_keys[.col],
.y = -.r) %>% .y = -.r) %>%
bind_rows(data_frame(.id = ".header", bind_rows(data_frame(.id = ".header",
} }
} }


res <- add_color_join(x, rev(ids$.id), by, ...)
return(res)
add_color_join(x, rev(ids$.id), by, ...)
} }


#' Adds Color to a processed data_frame #' Adds Color to a processed data_frame
.textcolor = text_color) .textcolor = text_color)


if (is.na(text_color)) if (is.na(text_color))
res <- res %>% mutate(.textcolor = set_text_color(.color))
res <- res %>% mutate(.textcolor = choose_text_color(.color))


return(res) return(res)
} }

+ 30
- 27
R/tidyr_helpers.R Прегледај датотеку

#' get_quos_names(-x) #' get_quos_names(-x)
#' get_quos_names(x:y) #' get_quos_names(x:y)
get_quos_names <- function(...) { get_quos_names <- function(...) {
q <- quos(...)
sapply(q, function(i) as.character(i[[2]]))
q <- rlang::quos(...)
purrr::map_chr(q, rlang::quo_name)
} }


#' Parses a simple vector so that it looks like its input #' Parses a simple vector so that it looks like its input
#' @examples #' @examples
#' dput_parser("x") #' dput_parser("x")
#' dput_parser(c("x", "y")) #' dput_parser(c("x", "y"))
dput_parser <- function(x) {
ifelse(length(x) == 1,
sprintf("'%s'", x),
paste0("c(",
paste(sprintf("'%s'", x), collapse = ", "),
")"))
dput_parser <- function(x) UseMethod("dput_parser")

dput_parser.character <- function(x) {
if (length(x) == 1) {
sprintf('"%s"', x)
} else {
x <- capture.output(dput(x))
paste(x, collapse = "")
}
} }


#' Adds color to processed tidy data #' Adds color to processed tidy data
key_values <- names(x) key_values <- names(x)
key_values <- key_values[!key_values %in% ids] key_values <- key_values[!key_values %in% ids]


id_values <- x %>% select(one_of(ids))
id_values <- id_values %>% gather(key = ".key_map", value = ".id_map")
id_values <- x %>% select(dplyr::one_of(ids))
id_values <- id_values %>% tidyr::gather(key = ".key_map", value = ".id_map")


x <- x %>% mutate(.r = row_number()) %>% x <- x %>% mutate(.r = row_number()) %>%
unite(one_of(ids), col = ".id_map", remove = F)
tidyr::unite(dplyr::one_of(ids), col = ".id_map", remove = F)


x <- x %>% x <- x %>%
gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>% gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>%
tmp <- x %>% filter(.key_map %in% ids) tmp <- x %>% filter(.key_map %in% ids)
x <- bind_rows( x <- bind_rows(
left_join(tmp %>% select(-.key_map), left_join(tmp %>% select(-.key_map),
tmp %>% select(.id_map) %>% crossing(.key_map = key_values),
tmp %>% select(.id_map) %>% tidyr::crossing(.key_map = key_values),
by = ".id_map"), by = ".id_map"),
x %>% filter(!.key_map %in% ids) x %>% filter(!.key_map %in% ids)
) )


# add header: # add header:
crosser <- crossing(.id_map = as.character(id_values$.id_map),
crosser <- tidyr::crossing(.id_map = as.character(id_values$.id_map),
.key_map = key_values) .key_map = key_values)
key_header <- data_frame( key_header <- data_frame(
.key_map = key_values, .key_map = key_values,
.x = 1:length(ids), .x = 1:length(ids),
.y = 0, .y = 0,
.header = TRUE), .header = TRUE),
crossing(.id_map = ids, .key_map = key_values),
tidyr::crossing(.id_map = ids, .key_map = key_values),
by = ".id_map" by = ".id_map"
) )


x <- bind_rows(id_header, key_header, x) x <- bind_rows(id_header, key_header, x)


x <- x %>% unite(.key_map, .id_map, .val, col = ".id", remove = F)
x <- x %>% tidyr::unite(.key_map, .id_map, .val, col = ".id", remove = F)


x %>% x %>%
add_color_tidyr(key_values = key_values) %>% add_color_tidyr(key_values = key_values) %>%
xn <- names(x) xn <- names(x)


x <- x %>% mutate(.r = row_number()) %>% x <- x %>% mutate(.r = row_number()) %>%
unite(ids, col = ".id_map", remove = F) %>%
unite(key, col = ".key_map", remove = F)
tidyr::unite(ids, col = ".id_map", remove = F) %>%
tidyr::unite(key, col = ".key_map", remove = F)


key_values <- x %>% pull(key) %>% unique() key_values <- x %>% pull(key) %>% unique()


names(x_dict) <- xn names(x_dict) <- xn


x <- x %>% x <- x %>%
gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>%
tidyr::gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>%
mutate( mutate(
.x = x_dict[.col], .x = x_dict[.col],
.y = -rep(1:nr, nc), .y = -rep(1:nr, nc),


# add headers: # add headers:


id_headers <- crossing(.id_map = ids, # x$.id_map %>% unique()
.key_map = key_values,
) %>%
id_headers <- tidyr::crossing(.id_map = ids, # x$.id_map %>% unique()
.key_map = key_values,
) %>%
mutate( mutate(
.r = 0, .r = 0,
.col = "id", .col = "id",
) )


x <- x %>% x <- x %>%
add_row(
dplyr::add_row(
.before = T, .before = T,
.id_map = c(rep("key", length(key)), rep("value", length(value))), .id_map = c(rep("key", length(key)), rep("value", length(value))),
.key_map = c(rep("key", length(key)), rep("value", length(value))), .key_map = c(rep("key", length(key)), rep("value", length(value))),
x <- bind_rows(id_headers, x) x <- bind_rows(id_headers, x)


x <- x %>% x <- x %>%
unite(.key_map, .id_map, .val, col = ".id", remove = F)
tidyr::unite(.key_map, .id_map, .val, col = ".id", remove = F)


x %>% add_color_tidyr(key_values = key_values) %>% x %>% add_color_tidyr(key_values = key_values) %>%
mutate(.alpha = ifelse(.header == TRUE, 1, 0.6)) mutate(.alpha = ifelse(.header == TRUE, 1, 0.6))
#' #'
#' @examples #' @examples
#' NULL #' NULL
gather_spread <- function(lhs, rhs, sequence, key_values, export, detailed, ...) {
gather_spread <- function(lhs, rhs, sequence, key_values, export, detailed, ..., anim_opts = anim_options()) {
# lhs is the one state of the df # lhs is the one state of the df
# rhs is the target state # rhs is the target state


labels = frame_labels)) labels = frame_labels))


if (export == "gif") { if (export == "gif") {
animate_plot(anim_df, title = title_string, transition_length = tl, state_length = sl) #, ...)
animate_plot(anim_df, title = title_string, anim_opts = anim_opts)
} else if (export == "first") { } else if (export == "first") {
static_plot(state_start) #....
static_plot(state_start, anim_opts = anim_opts) #....
} else if (export == "last") { } else if (export == "last") {
static_plot(state_end) #....
static_plot(state_end, anim_opts = anim_opts) #....
} }


# open issues: ... doesnt work properly. # open issues: ... doesnt work properly.

+ 26
- 0
R/utils.R Прегледај датотеку

`%||%` <- 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
}

+ 17
- 1
R/zzzz-package.R Прегледај датотеку

#' @importFrom dplyr left_join right_join full_join inner_join semi_join anti_join #' @importFrom dplyr left_join right_join full_join inner_join semi_join anti_join
#' @importFrom dplyr mutate select filter arrange bind_rows bind_cols group_by pull
#' @importFrom dplyr mutate select filter arrange bind_rows bind_cols group_by pull slice data_frame row_number
#' @importFrom tidyr gather spread
#' @keywords internal #' @keywords internal
"_PACKAGE" "_PACKAGE"

plot_settings <- new.env(parent = emptyenv())
plot_settings$default <- list(
transition_length = 2,
state_length = 1,
ease_default = "sine-in-out",
ease_other = NULL,
enter = setNames(list(enter_fade()), "enter_fade()"),
exit = setNames(list(exit_fade()), "exit_fade()"),
text_family = "Fira Mono",
title_family = "Fira Mono",
text_size = 5,
title_size = 17
)


+ 67
- 65
README.Rmd Прегледај датотеку

--- ---
output: github_document output: github_document
editor_options:
chunk_output_type: console
--- ---


<!-- README.md is generated from README.Rmd. Please edit that file --> <!-- README.md is generated from README.Rmd. Please edit that file -->
echo = TRUE, echo = TRUE,
warning = FALSE, warning = FALSE,
message = FALSE, message = FALSE,
fig.path = "man/figures/tidyexplain-",
cache = TRUE cache = TRUE
) )
library(tidyAnimatedVerbs)
library(tidyexplain)
set_font_size(11, 26)
``` ```


[gganimate]: https://github.com/thomasp85/gganimate#README [gganimate]: https://github.com/thomasp85/gganimate#README
- Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) - Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread)


- Learn more about - Learn more about
- [Relational Data](#relational-data)
- [gganimate](#gganimate)
- [Relational Data](#relational-data)
- [gganimate](#gganimate)




Please feel free to use these images for teaching or learning about action verbs from the [tidyverse](https://tidyverse.org). Please feel free to use these images for teaching or learning about action verbs from the [tidyverse](https://tidyverse.org).


## Installing ## Installing


The library can be installed with
```{r, echo=T,eval=F}
The in-development version of `tidyexplain` can be installed with `devtools`:

```r
# install.package("devtools") # install.package("devtools")
devtools::install_github("gadenbuie/tidy-animated-verbs") devtools::install_github("gadenbuie/tidy-animated-verbs")

library(tidyexplain)
``` ```


## Mutating Joins ## Mutating Joins


```{r intial-dfs, echo=T}
library(tidyAnimatedVerbs)
x <- data_frame(
```{r intial-dfs}
x <- dplyr::data_frame(
id = 1:3, id = 1:3,
x = paste0("x", 1:3) x = paste0("x", 1:3)
) )


y <- data_frame(
y <- dplyr::data_frame(
id = (1:4)[-3], id = (1:4)[-3],
y = paste0("y", (1:4)[-3]) y = paste0("y", (1:4)[-3])
) )
``` ```




```{r echo=TRUE}
```{r}
x x
y y
``` ```


> All rows from `x` where there are matching values in `y`, and all columns from `x` and `y`. > All rows from `x` where there are matching values in `y`, and all columns from `x` and `y`.


```{r inner-join, echo=T}
```{r inner-join}
animate_inner_join(x, y, by = "id") animate_inner_join(x, y, by = "id")
``` ```




```{r echo=TRUE}
inner_join(x, y, by = "id")
```{r}
dplyr::inner_join(x, y, by = "id")
``` ```


### Left Join ### Left Join


> All rows from `x`, and all columns from `x` and `y`. Rows in `x` with no match in `y` will have `NA` values in the new columns. > All rows from `x`, and all columns from `x` and `y`. Rows in `x` with no match in `y` will have `NA` values in the new columns.


```{r left-join, echo=T}
```{r left-join}
animate_left_join(x, y, by = "id") animate_left_join(x, y, by = "id")
``` ```




```{r echo=TRUE}
left_join(x, y, by = "id")
```{r}
dplyr::left_join(x, y, by = "id")
``` ```


### Left Join (Extra Rows in y) ### Left Join (Extra Rows in y)


> ... If there are multiple matches between `x` and `y`, all combinations of the matches are returned. > ... If there are multiple matches between `x` and `y`, all combinations of the matches are returned.


```{r left-join-extra, echo=T}
y_extra <- bind_rows(y, data_frame(id = 2, y = "y5"))
```{r left-join-extra}
y_extra <- dplyr::bind_rows(y, dplyr::data_frame(id = 2, y = "y5"))
y_extra # has multiple rows with the key from `x` y_extra # has multiple rows with the key from `x`


animate_left_join(x, y_extra, by = "id")
animate_left_join(x, y_extra, by = "id",
anim_opts = anim_options(title_size = 22))
``` ```


```{r echo=TRUE}
left_join(x, y_extra, by = "id")
```{r}
dplyr::left_join(x, y_extra, by = "id")
``` ```


### Right Join ### Right Join


> All rows from y, and all columns from `x` and `y`. Rows in `y` with no match in `x` will have `NA` values in the new columns. > All rows from y, and all columns from `x` and `y`. Rows in `y` with no match in `x` will have `NA` values in the new columns.


```{r right-join, echo = T}
```{r right-join}
animate_right_join(x, y, by = "id") animate_right_join(x, y, by = "id")
``` ```




```{r echo=TRUE}
right_join(x, y, by = "id")
```{r}
dplyr::right_join(x, y, by = "id")
``` ```


### Full Join ### Full Join


> All rows and all columns from both `x` and `y`. Where there are not matching values, returns `NA` for the one missing. > All rows and all columns from both `x` and `y`. Where there are not matching values, returns `NA` for the one missing.


```{r full-join, echo=T}
```{r full-join}
animate_full_join(x, y, by = "id") animate_full_join(x, y, by = "id")
``` ```




```{r echo=TRUE}
full_join(x, y, by = "id")
```{r}
dplyr::full_join(x, y, by = "id")
``` ```


## Filtering Joins ## Filtering Joins


> All rows from `x` where there are matching values in `y`, keeping just columns from `x`. > All rows from `x` where there are matching values in `y`, keeping just columns from `x`.


```{r semi-join, echo=T}
```{r semi-join}
animate_semi_join(x, y, by = "id") animate_semi_join(x, y, by = "id")
``` ```




```{r echo=TRUE}
semi_join(x, y, by = "id")
```{r}
dplyr::semi_join(x, y, by = "id")
``` ```


### Anti Join ### Anti Join


> All rows from `x` where there are not matching values in `y`, keeping just columns from `x`. > All rows from `x` where there are not matching values in `y`, keeping just columns from `x`.


```{r anti-join, echo=T}
```{r anti-join}
animate_anti_join(x, y, by = "id") animate_anti_join(x, y, by = "id")
``` ```




```{r echo=TRUE}
anti_join(x, y, by = "id")
```{r}
dplyr::anti_join(x, y, by = "id")
``` ```


## Set Operations ## Set Operations


```{r intial-dfs-so, echo=T}
x <- data_frame(
```{r intial-dfs-so}
x <- dplyr::data_frame(
x = c(1, 1, 2), x = c(1, 1, 2),
y = c("a", "b", "a") y = c("a", "b", "a")
) )
y <- data_frame(
y <- dplyr::data_frame(
x = c(1, 2), x = c(1, 2),
y = c("a", "b") y = c("a", "b")
) )
``` ```




```{r echo=TRUE}
```{r}
x x
y y
``` ```


> All unique rows from `x` and `y`. > All unique rows from `x` and `y`.


```{r union, echo=T}
```{r union}
animate_union(x, y) animate_union(x, y)
``` ```




```{r echo=TRUE}
union(x, y)
```{r}
dplyr::union(x, y)
``` ```






```{r echo=TRUE}
```{r union-y-x}
animate_union(y, x) animate_union(y, x)


union(y, x)
dplyr::union(y, x)
``` ```


### Union All ### Union All


> All rows from `x` and `y`, keeping duplicates. > All rows from `x` and `y`, keeping duplicates.


```{r union-all, echo=T}
```{r union-all}
animate_union_all(x, y) animate_union_all(x, y)
``` ```






```{r echo=TRUE}
union_all(x, y)
```{r}
dplyr::union_all(x, y)
``` ```






> Common rows in both `x` and `y`, keeping just unique rows. > Common rows in both `x` and `y`, keeping just unique rows.


```{r intersect, echo=T}
```{r intersect}
animate_intersect(x, y) animate_intersect(x, y)
``` ```




```{r echo=TRUE}
intersect(x, y)
```{r}
dplyr::intersect(x, y)
``` ```


### Set Difference ### Set Difference


> All rows from `x` which are not also rows in `y`, keeping just unique rows. > All rows from `x` which are not also rows in `y`, keeping just unique rows.


```{r setdiff, echo=T}
```{r setdiff}
animate_setdiff(x, y) animate_setdiff(x, y)
``` ```




```{r echo=TRUE}
setdiff(x, y)
```{r}
dplyr::setdiff(x, y)
``` ```




```{r echo=TRUE}
```{r setdiff-y-x}
animate_setdiff(y, x) animate_setdiff(y, x)


setdiff(y, x)
dplyr::setdiff(y, x)
``` ```


## Tidy Data and `gather()`, `spread()` functionality ## Tidy Data and `gather()`, `spread()` functionality
you organize your data into tidy data. you organize your data into tidy data.


```{r} ```{r}
long <- data_frame(
long <- dplyr::data_frame(
year = c(2010, 2011, 2010, 2011, 2010, 2011), year = c(2010, 2011, 2010, 2011, 2010, 2011),
person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"),
sales = c(105, 110, 100, 97, 90, 95) sales = c(105, 110, 100, 97, 90, 95)
) )
wide <- data_frame(
wide <- dplyr::data_frame(
year = 2010:2011, year = 2010:2011,
Alice = c(105, 110), Alice = c(105, 110),
Bob = c(100, 97), Bob = c(100, 97),
) )
``` ```



### Gather ### Gather


> Gather takes multiple columns and collapses into key-value pairs, duplicating all other columns as needed. You use gather() when you notice that your column names are not names of variables, but values of a variable. > Gather takes multiple columns and collapses into key-value pairs, duplicating all other columns as needed. You use gather() when you notice that your column names are not names of variables, but values of a variable.


```{r}
```{r gather}
set_font_size(4.5, 15)
animate_gather(wide, key = "person", value = "sales", -year) animate_gather(wide, key = "person", value = "sales", -year)
``` ```


```{r} ```{r}
gather(wide, key = "person", value = "sales", -year)
tidyr::gather(wide, key = "person", value = "sales", -year)
``` ```




### Spread ### Spread


> Spread a key-value pair across multiple columns. Use it when an a column contains observations from multiple variables. > Spread a key-value pair across multiple columns. Use it when an a column contains observations from multiple variables.


```{r}
```{r spread}
animate_spread(long, key = "person", value = "sales") animate_spread(long, key = "person", value = "sales")
``` ```


```{r} ```{r}
spread(long, key = "person", value = "sales")
tidyr::spread(long, key = "person", value = "sales")
``` ```







## Learn More ## Learn More


### Relational Data ### Relational Data

+ 49
- 46
README.md Прегледај датотеку

- Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread) - Tidyr Operations: [`gather()`](#gather), [`spread()`](#spread)


- Learn more about - Learn more about

- [Relational Data](#relational-data)

- [gganimate](#gganimate)
- [Relational Data](#relational-data)
- [gganimate](#gganimate)


Please feel free to use these images for teaching or learning about Please feel free to use these images for teaching or learning about
action verbs from the [tidyverse](https://tidyverse.org). You can action verbs from the [tidyverse](https://tidyverse.org). You can


## Installing ## Installing


The library can be installed with
The in-development version of `tidyexplain` can be installed with
`devtools`:


``` r ``` r
# install.package("devtools") # install.package("devtools")
devtools::install_github("gadenbuie/tidy-animated-verbs") devtools::install_github("gadenbuie/tidy-animated-verbs")

library(tidyexplain)
``` ```


## Mutating Joins ## Mutating Joins


``` r ``` r
library(tidyAnimatedVerbs)
x <- data_frame(
x <- dplyr::data_frame(
id = 1:3, id = 1:3,
x = paste0("x", 1:3) x = paste0("x", 1:3)
) )


y <- data_frame(
y <- dplyr::data_frame(
id = (1:4)[-3], id = (1:4)[-3],
y = paste0("y", (1:4)[-3]) y = paste0("y", (1:4)[-3])
) )
animate_full_join(x, y, by = c("id"), export = "first") animate_full_join(x, y, by = c("id"), export = "first")
``` ```


![](README_files/figure-gfm/intial-dfs-1.png)<!-- -->
![](man/figures/tidyexplain-intial-dfs-1.png)<!-- -->


``` r ``` r
x x
animate_inner_join(x, y, by = "id") animate_inner_join(x, y, by = "id")
``` ```


![](README_files/figure-gfm/inner-join-1.gif)<!-- -->
![](man/figures/tidyexplain-inner-join-1.gif)<!-- -->


``` r ``` r
inner_join(x, y, by = "id")
dplyr::inner_join(x, y, by = "id")
#> # A tibble: 2 x 3 #> # A tibble: 2 x 3
#> id x y #> id x y
#> <int> <chr> <chr> #> <int> <chr> <chr>
animate_left_join(x, y, by = "id") animate_left_join(x, y, by = "id")
``` ```


![](README_files/figure-gfm/left-join-1.gif)<!-- -->
![](man/figures/tidyexplain-left-join-1.gif)<!-- -->


``` r ``` r
left_join(x, y, by = "id")
dplyr::left_join(x, y, by = "id")
#> # A tibble: 3 x 3 #> # A tibble: 3 x 3
#> id x y #> id x y
#> <int> <chr> <chr> #> <int> <chr> <chr>
> of the matches are returned. > of the matches are returned.


``` r ``` r
y_extra <- bind_rows(y, data_frame(id = 2, y = "y5"))
y_extra <- dplyr::bind_rows(y, dplyr::data_frame(id = 2, y = "y5"))
y_extra # has multiple rows with the key from `x` y_extra # has multiple rows with the key from `x`
#> # A tibble: 4 x 2 #> # A tibble: 4 x 2
#> id y #> id y
#> 3 4 y4 #> 3 4 y4
#> 4 2 y5 #> 4 2 y5


animate_left_join(x, y_extra, by = "id")
animate_left_join(x, y_extra, by = "id",
anim_opts = anim_options(title_size = 22))
``` ```


![](README_files/figure-gfm/left-join-extra-1.gif)<!-- -->
![](man/figures/tidyexplain-left-join-extra-1.gif)<!-- -->


``` r ``` r
left_join(x, y_extra, by = "id")
dplyr::left_join(x, y_extra, by = "id")
#> # A tibble: 4 x 3 #> # A tibble: 4 x 3
#> id x y #> id x y
#> <dbl> <chr> <chr> #> <dbl> <chr> <chr>
animate_right_join(x, y, by = "id") animate_right_join(x, y, by = "id")
``` ```


![](README_files/figure-gfm/right-join-1.gif)<!-- -->
![](man/figures/tidyexplain-right-join-1.gif)<!-- -->


``` r ``` r
right_join(x, y, by = "id")
dplyr::right_join(x, y, by = "id")
#> # A tibble: 3 x 3 #> # A tibble: 3 x 3
#> id x y #> id x y
#> <int> <chr> <chr> #> <int> <chr> <chr>
animate_full_join(x, y, by = "id") animate_full_join(x, y, by = "id")
``` ```


![](README_files/figure-gfm/full-join-1.gif)<!-- -->
![](man/figures/tidyexplain-full-join-1.gif)<!-- -->


``` r ``` r
full_join(x, y, by = "id")
dplyr::full_join(x, y, by = "id")
#> # A tibble: 4 x 3 #> # A tibble: 4 x 3
#> id x y #> id x y
#> <int> <chr> <chr> #> <int> <chr> <chr>
animate_semi_join(x, y, by = "id") animate_semi_join(x, y, by = "id")
``` ```


![](README_files/figure-gfm/semi-join-1.gif)<!-- -->
![](man/figures/tidyexplain-semi-join-1.gif)<!-- -->


``` r ``` r
semi_join(x, y, by = "id")
dplyr::semi_join(x, y, by = "id")
#> # A tibble: 2 x 2 #> # A tibble: 2 x 2
#> id x #> id x
#> <int> <chr> #> <int> <chr>
animate_anti_join(x, y, by = "id") animate_anti_join(x, y, by = "id")
``` ```


![](README_files/figure-gfm/anti-join-1.gif)<!-- -->
![](man/figures/tidyexplain-anti-join-1.gif)<!-- -->


``` r ``` r
anti_join(x, y, by = "id")
dplyr::anti_join(x, y, by = "id")
#> # A tibble: 1 x 2 #> # A tibble: 1 x 2
#> id x #> id x
#> <int> <chr> #> <int> <chr>
## Set Operations ## Set Operations


``` r ``` r
x <- data_frame(
x <- dplyr::data_frame(
x = c(1, 1, 2), x = c(1, 1, 2),
y = c("a", "b", "a") y = c("a", "b", "a")
) )
y <- data_frame(
y <- dplyr::data_frame(
x = c(1, 2), x = c(1, 2),
y = c("a", "b") y = c("a", "b")
) )
animate_union(x, y, export = "first") animate_union(x, y, export = "first")
``` ```


![](README_files/figure-gfm/intial-dfs-so-1.png)<!-- -->
![](man/figures/tidyexplain-intial-dfs-so-1.png)<!-- -->


``` r ``` r
x x
animate_union(x, y) animate_union(x, y)
``` ```


![](README_files/figure-gfm/union-1.gif)<!-- -->
![](man/figures/tidyexplain-union-1.gif)<!-- -->


``` r ``` r
union(x, y)
dplyr::union(x, y)
#> # A tibble: 4 x 2 #> # A tibble: 4 x 2
#> x y #> x y
#> <dbl> <chr> #> <dbl> <chr>
animate_union(y, x) animate_union(y, x)
``` ```


![](README_files/figure-gfm/unnamed-chunk-12-1.gif)<!-- -->
![](man/figures/tidyexplain-union-y-x-1.gif)<!-- -->


``` r ``` r


union(y, x)
dplyr::union(y, x)
#> # A tibble: 4 x 2 #> # A tibble: 4 x 2
#> x y #> x y
#> <dbl> <chr> #> <dbl> <chr>
animate_union_all(x, y) animate_union_all(x, y)
``` ```


![](README_files/figure-gfm/union-all-1.gif)<!-- -->
![](man/figures/tidyexplain-union-all-1.gif)<!-- -->


``` r ``` r
union_all(x, y)
dplyr::union_all(x, y)
#> # A tibble: 5 x 2 #> # A tibble: 5 x 2
#> x y #> x y
#> <dbl> <chr> #> <dbl> <chr>
animate_intersect(x, y) animate_intersect(x, y)
``` ```


![](README_files/figure-gfm/intersect-1.gif)<!-- -->
![](man/figures/tidyexplain-intersect-1.gif)<!-- -->


``` r ``` r
intersect(x, y)
dplyr::intersect(x, y)
#> # A tibble: 1 x 2 #> # A tibble: 1 x 2
#> x y #> x y
#> <dbl> <chr> #> <dbl> <chr>
animate_setdiff(x, y) animate_setdiff(x, y)
``` ```


![](README_files/figure-gfm/setdiff-1.gif)<!-- -->
![](man/figures/tidyexplain-setdiff-1.gif)<!-- -->


``` r ``` r
setdiff(x, y)
dplyr::setdiff(x, y)
#> # A tibble: 2 x 2 #> # A tibble: 2 x 2
#> x y #> x y
#> <dbl> <chr> #> <dbl> <chr>
animate_setdiff(y, x) animate_setdiff(y, x)
``` ```


![](README_files/figure-gfm/unnamed-chunk-16-1.gif)<!-- -->
![](man/figures/tidyexplain-setdiff-y-x-1.gif)<!-- -->


``` r ``` r


setdiff(y, x)
dplyr::setdiff(y, x)
#> # A tibble: 1 x 2 #> # A tibble: 1 x 2
#> x y #> x y
#> <dbl> <chr> #> <dbl> <chr>
you organize your data into tidy data. you organize your data into tidy data.


``` r ``` r
long <- data_frame(
long <- dplyr::data_frame(
year = c(2010, 2011, 2010, 2011, 2010, 2011), year = c(2010, 2011, 2010, 2011, 2010, 2011),
person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"), person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"),
sales = c(105, 110, 100, 97, 90, 95) sales = c(105, 110, 100, 97, 90, 95)
) )
wide <- data_frame(
wide <- dplyr::data_frame(
year = 2010:2011, year = 2010:2011,
Alice = c(105, 110), Alice = c(105, 110),
Bob = c(100, 97), Bob = c(100, 97),
> of a variable. > of a variable.


``` r ``` r
set_font_size(4.5, 15)
animate_gather(wide, key = "person", value = "sales", -year) animate_gather(wide, key = "person", value = "sales", -year)
``` ```


![](README_files/figure-gfm/unnamed-chunk-18-1.gif)<!-- -->
![](man/figures/tidyexplain-gather-1.gif)<!-- -->


``` r ``` r
gather(wide, key = "person", value = "sales", -year)
tidyr::gather(wide, key = "person", value = "sales", -year)
#> # A tibble: 6 x 3 #> # A tibble: 6 x 3
#> year person sales #> year person sales
#> <int> <chr> <dbl> #> <int> <chr> <dbl>
animate_spread(long, key = "person", value = "sales") animate_spread(long, key = "person", value = "sales")
``` ```


![](README_files/figure-gfm/unnamed-chunk-20-1.gif)<!-- -->
![](man/figures/tidyexplain-spread-1.gif)<!-- -->


``` r ``` r
spread(long, key = "person", value = "sales")
tidyr::spread(long, key = "person", value = "sales")
#> # A tibble: 2 x 4 #> # A tibble: 2 x 4
#> year Alice Bob Charlie #> year Alice Bob Charlie
#> <dbl> <dbl> <dbl> <dbl> #> <dbl> <dbl> <dbl> <dbl>

BIN
README_files/figure-gfm/anti-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 610KB

BIN
README_files/figure-gfm/full-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 618KB

BIN
README_files/figure-gfm/inner-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 619KB

BIN
README_files/figure-gfm/intersect-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 477KB

BIN
README_files/figure-gfm/intial-dfs-1.png Прегледај датотеку

Before After
Width: 672  |  Height: 480  |  Size: 9.5KB

BIN
README_files/figure-gfm/intial-dfs-so-1.png Прегледај датотеку

Before After
Width: 672  |  Height: 480  |  Size: 6.4KB

BIN
README_files/figure-gfm/left-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 632KB

BIN
README_files/figure-gfm/left-join-extra-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 713KB

BIN
README_files/figure-gfm/right-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 641KB

BIN
README_files/figure-gfm/semi-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 607KB

BIN
README_files/figure-gfm/setdiff-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 523KB

BIN
README_files/figure-gfm/union-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 486KB

BIN
README_files/figure-gfm/union-all-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 467KB

BIN
README_files/figure-gfm/unnamed-chunk-12-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 483KB

BIN
README_files/figure-gfm/unnamed-chunk-16-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 492KB

BIN
README_files/figure-gfm/unnamed-chunk-18-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 702KB

BIN
README_files/figure-gfm/unnamed-chunk-20-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 713KB

+ 57
- 0
man/anim_options.Rd Прегледај датотеку

% 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.
}}


+ 7
- 3
man/animate_gather.Rd Прегледај датотеку

\alias{animate_gather} \alias{animate_gather}
\title{Animates the gather function} \title{Animates the gather function}
\usage{ \usage{
animate_gather(w, key, value, ..., export = "gif", detailed = TRUE)
animate_gather(w, key, value, ..., export = "gif", detailed = TRUE,
anim_opts = anim_options())
} }
\arguments{ \arguments{
\item{w}{a data_frame in the wide format} \item{w}{a data_frame in the wide format}


\item{value}{the value} \item{value}{the value}


\item{...}{further arguments passed to gather, static_plot, or animate_plot}
\item{...}{further arguments passed to \code{\link[tidyr:gather]{tidyr::gather()}}, \code{\link[=process_wide]{process_wide()}},
or \code{\link[=process_long]{process_long()}}}


\item{export}{the export type, either gif, first or last. The latter two \item{export}{the export type, either gif, first or last. The latter two
export ggplots of the first/last state of the gather function}
export ggplots of the first/last state of the join}


\item{detailed}{boolean value if the animation should show one step for each \item{detailed}{boolean value if the animation should show one step for each
key value} key value}

\item{anim_opts}{An \code{\link[=anim_options]{anim_options()}} options list.}
} }
\value{ \value{
a gif or a ggplot a gif or a ggplot

+ 28
- 30
man/animate_join.Rd Прегледај датотеку

\alias{animate_anti_join} \alias{animate_anti_join}
\title{Animates a join operation} \title{Animates a join operation}
\usage{ \usage{
animate_join(x, y, by, type = c("full_join", "inner_join", "left_join",
"right_join", "semi_join", "anti_join"), export = c("gif", "first",
"last"), ...)

animate_full_join(x, y, by, export = "gif", ...) animate_full_join(x, y, by, export = "gif", ...)


animate_inner_join(x, y, by, export = "gif", ...) animate_inner_join(x, y, by, export = "gif", ...)
dynamic as a gif. dynamic as a gif.
} }
\examples{ \examples{
x <- data_frame(
id = 1:3,
x = paste0("x", 1:3)
)
y <- data_frame(
id = (1:4)[-3],
y = paste0("y", (1:4)[-3])
)
x <- data_frame(id = 1:3, x = paste0("x", 1:3))
y <- data_frame(id = (1:4)[-3], y = paste0("y", (1:4)[-3]))


# Animate the first or last state of the join # Animate the first or last state of the join
animate_full_join(x, y, by = "id", export = "first") animate_full_join(x, y, by = "id", export = "first")


# animate the transition as a gif (default) # animate the transition as a gif (default)
\donttest{ \donttest{
animate_full_join(x, y, by = "id", export = "gif")
animate_full_join(x, y, by = "id", export = "gif")
} }


# different options include # different options include
\donttest{ \donttest{
animate_full_join(x, y, by = "id")
animate_inner_join(x, y, by = "id")
animate_left_join(x, y, by = "id")
animate_right_join(x, y, by = "id")
animate_semi_join(x, y, by = "id")
animate_anti_join(x, y, by = "id")
# further arguments can be passed to all animate_* functions
animate_full_join(
x, y, by = "id", export = "last",
text_size = 5, title_size = 25,
color_header = "black",
color_other = "lightblue",
color_fun = viridis::viridis
)
animate_full_join(x, y, by = "id")
animate_inner_join(x, y, by = "id")
animate_left_join(x, y, by = "id")
animate_right_join(x, y, by = "id")
animate_semi_join(x, y, by = "id")
animate_anti_join(x, y, by = "id")
# further arguments can be passed to all animate_* functions
animate_full_join(
x, y, by = "id", export = "last",
text_size = 5, title_size = 25,
color_header = "black",
color_other = "lightblue",
color_fun = viridis::viridis
)
} }


# Save the results # Save the results
\donttest{ \donttest{
# to save the ggplot, use
fj <- animate_full_join(x, y, by = "id", export = "last")
ggsave("full-join.pdf", fj)
# to save the ggplot, use
fj <- animate_full_join(x, y, by = "id", export = "last")
ggsave("full-join.pdf", fj)


# to save the gif, use
fj <- animate_full_join(x, y, by = "id", export = "gif")
anim_save(fj, "full-join.gif")
# to save the gif, use
fj <- animate_full_join(x, y, by = "id", export = "gif")
anim_save(fj, "full-join.gif")
} }
} }
\seealso{ \seealso{

+ 0
- 31
man/animate_join_function.Rd Прегледај датотеку

% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/animate_helpers.R
\name{animate_join_function}
\alias{animate_join_function}
\alias{animate_join}
\title{Animates a join - wrapper function}
\usage{
animate_join(x, y, by, type, export = "gif", ...)
}
\arguments{
\item{x}{left dataset}

\item{y}{right dataset}

\item{by}{by arguments for the join}

\item{type}{type of the join, i.e., left_join, right_join, etc.}

\item{export}{if the function exports a gif, the first, or last picture}

\item{...}{further arguments passed to static_plot or to add_color}
}
\value{
either a gif or a ggplot
}
\description{
Animates a join - wrapper function
}
\examples{
NULL
}

+ 8
- 12
man/animate_plot.Rd Прегледај датотеку

% Please edit documentation in R/plot_helpers.R % Please edit documentation in R/plot_helpers.R
\name{animate_plot} \name{animate_plot}
\alias{animate_plot} \alias{animate_plot}
\title{Animates a plot}
\title{Animate a Plot}
\usage{ \usage{
animate_plot(d, title = "", transition_length = 2, state_length = 1,
...)
animate_plot(d, title = "", ..., anim_opts = anim_options(...))
} }
\arguments{ \arguments{
\item{d}{a preprocessed dataset}
\item{d}{a processed dataset}


\item{title}{the plot title}
\item{title}{the title of the plot}


\item{transition_length}{see transition_states}

\item{state_length}{see transition_states}

\item{...}{further arguments passed to static_plot}
\item{anim_opts}{Animation options generated with \code{\link[=anim_options]{anim_options()}}. Overrides
any options set in \code{...}.}
} }
\value{ \value{
a gif
a \code{gganim} object
} }
\description{ \description{
Animates a plot
Animate a Plot
} }
\examples{ \examples{
NULL NULL

+ 27
- 28
man/animate_set.Rd Прегледај датотеку

\alias{animate_setdiff} \alias{animate_setdiff}
\title{Animates a set operation} \title{Animates a set operation}
\usage{ \usage{
animate_set(x, y, type = c("union", "union_all", "intersect", "setdiff"),
export = c("gif", "first", "last"), ...)

animate_union(x, y, export = "gif", ...) animate_union(x, y, export = "gif", ...)


animate_union_all(x, y, export = "gif", ...) animate_union_all(x, y, export = "gif", ...)


\item{y}{the y dataset} \item{y}{the y dataset}


\item{type}{type of the set, i.e., intersect, setdiff, etc.}

\item{export}{the export type, either gif, first or last. The latter two \item{export}{the export type, either gif, first or last. The latter two
export ggplots of the first/last state of the join} export ggplots of the first/last state of the join}


dynamic as a gif. dynamic as a gif.
} }
\examples{ \examples{
x <- data_frame(
x = c(1, 1, 2),
y = c("a", "b", "a")
)
y <- data_frame(
x = c(1, 2),
y = c("a", "b")
)
x <- data_frame(x = c(1, 1, 2), y = c("a", "b", "a"))
y <- data_frame(x = c(1, 2), y = c("a", "b"))


# Animate the first or last state of the set # Animate the first or last state of the set
animate_union(x, y, export = "first") animate_union(x, y, export = "first")


# animate the transition as a gif (default) # animate the transition as a gif (default)
\donttest{ \donttest{
animate_union(x, y, export = "gif")
animate_union(x, y, export = "gif")
} }


# different options include # different options include
\donttest{ \donttest{
animate_union(x, y)
animate_union_all(x, y)
animate_intersect(x, y)
animate_setdiff(x, y)
animate_union(x, y)
animate_union_all(x, y)
animate_intersect(x, y)
animate_setdiff(x, y)


# further arguments can be passed to all animate_* functions
animate_union(
x, y,
text_size = 5, title_size = 25,
color_header = "black",
color_other = "lightblue",
color_fun = viridis::viridis
)
# further arguments can be passed to all animate_* functions
animate_union(
x, y,
text_size = 5, title_size = 25,
color_header = "black",
color_other = "lightblue",
color_fun = viridis::viridis
)
} }


# Save the results # Save the results
\dontrun{ \dontrun{
# to save the ggplot, use
un <- animate_union(x, y, by = "id", export = "last")
ggsave("union.pdf", un)
# to save the ggplot, use
un <- animate_union(x, y, by = "id", export = "last")
ggsave("union.pdf", un)


animate_union(x, y, by = "id", export = "gif")
# to save the gif, use
un <- animate_union(x, y, by = "id", export = "gif")
anim_save(un, "union.gif")
animate_union(x, y, by = "id", export = "gif")
# to save the gif, use
un <- animate_union(x, y, by = "id", export = "gif")
anim_save(un, "union.gif")
} }
} }
\seealso{ \seealso{

+ 0
- 29
man/animate_set_function.Rd Прегледај датотеку

% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/animate_helpers.R
\name{animate_set_function}
\alias{animate_set_function}
\alias{animate_set}
\title{Animates a set - wrapper function}
\usage{
animate_set(x, y, type, export = "gif", ...)
}
\arguments{
\item{x}{left dataset}

\item{y}{right dataset}

\item{type}{type of the set, i.e., intersect, setdiff, etc.}

\item{export}{if the function exports a gif, the first, or last picture}

\item{...}{further arguments passed to static_plot or to add_color}
}
\value{
either a gif or a ggplot
}
\description{
Animates a set - wrapper function
}
\examples{
NULL
}

+ 7
- 4
man/animate_spread.Rd Прегледај датотеку

\alias{animate_spread} \alias{animate_spread}
\title{Animates the spread function} \title{Animates the spread function}
\usage{ \usage{
animate_spread(l, key, value, export = "gif", detailed = TRUE, ...)
animate_spread(l, key, value, export = "gif", detailed = TRUE, ...,
anim_opts = anim_options())
} }
\arguments{ \arguments{
\item{l}{a data_frame in the long/tidy format} \item{l}{a data_frame in the long/tidy format}


\item{key}{the key} \item{key}{the key}


\item{value}{the values}
\item{value}{the value}


\item{export}{the export type, either gif, first or last. The latter two \item{export}{the export type, either gif, first or last. The latter two
export ggplots of the first/last state of the spread function}
export ggplots of the first/last state of the join}


\item{detailed}{boolean value if the animation should show one step for each \item{detailed}{boolean value if the animation should show one step for each
key value} key value}


\item{...}{further arguments passed to static_plot}
\item{...}{further arguments passed to \link{process_long} or \link{process_wide}}

\item{anim_opts}{An \code{\link[=anim_options]{anim_options()}} options list.}
} }
\value{ \value{
a ggplot or a gif a ggplot or a gif

BIN
man/figures/tidyexplain-anti-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 724KB

BIN
man/figures/tidyexplain-full-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 743KB

BIN
man/figures/tidyexplain-gather-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 481KB

BIN
man/figures/tidyexplain-inner-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 746KB

BIN
man/figures/tidyexplain-intersect-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 555KB

BIN
man/figures/tidyexplain-intial-dfs-1.png Прегледај датотеку

Before After
Width: 672  |  Height: 480  |  Size: 21KB

BIN
man/figures/tidyexplain-intial-dfs-so-1.png Прегледај датотеку

Before After
Width: 672  |  Height: 480  |  Size: 16KB

BIN
man/figures/tidyexplain-left-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 747KB

BIN
man/figures/tidyexplain-left-join-extra-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 873KB

BIN
man/figures/tidyexplain-right-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 758KB

BIN
man/figures/tidyexplain-semi-join-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 718KB

BIN
man/figures/tidyexplain-setdiff-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 596KB

BIN
man/figures/tidyexplain-setdiff-y-x-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 567KB

BIN
man/figures/tidyexplain-spread-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 504KB

BIN
man/figures/tidyexplain-union-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 571KB

BIN
man/figures/tidyexplain-union-all-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 560KB

BIN
man/figures/tidyexplain-union-y-x-1.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 565KB

+ 2
- 1
man/gather_spread.Rd Прегледај датотеку

\alias{gather_spread} \alias{gather_spread}
\title{Animates a gather or spread function} \title{Animates a gather or spread function}
\usage{ \usage{
gather_spread(lhs, rhs, sequence, key_values, export, detailed, ...)
gather_spread(lhs, rhs, sequence, key_values, export, detailed, ...,
anim_opts = anim_options())
} }
\arguments{ \arguments{
\item{lhs}{the (processed) dataset on the left-side} \item{lhs}{the (processed) dataset on the left-side}

+ 25
- 0
man/set_font_size.Rd Прегледај датотеку

% 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
}}


+ 27
- 10
man/static_plot.Rd Прегледај датотеку

\alias{static_plot} \alias{static_plot}
\title{Prints the tiles for a processed dataset statically} \title{Prints the tiles for a processed dataset statically}
\usage{ \usage{
static_plot(d, title = "", text_family = "Fira Sans",
title_family = "Fira Mono", text_size = 5, title_size = 17, ...)
static_plot(d, title = "", ..., anim_opts = anim_options(...))
} }
\arguments{ \arguments{
\item{d}{a processed dataset} \item{d}{a processed dataset}


\item{title}{the title of the plot} \item{title}{the title of the plot}


\item{text_family}{the font for the text}
\item{...}{Arguments passed on to \code{anim_options}
\describe{
\item{text_family}{Font family for the plot text, default is "Fira Mono". Use
\code{\link[=set_font_size]{set_font_size()}} to set global default font sizes.}
\item{title_family}{Font family for the plot title, default is "Fira Mono".
Use \code{\link[=set_font_size]{set_font_size()}} to set global default font sizes.}
\item{text_size}{Font size of the plot text, default is 5.}
\item{title_size}{Font size of the plot title, default is 17.}
\item{ease_default}{Default aes easing function. See \code{\link[tweenr:display_ease]{tweenr::display_ease()}}
for more options. The tidyexplain default value is \code{sine-in-out}.}
\item{ease_other}{Additional aes easing options, specified as a named list.
List entries are named with the aesthetic to which the easeing should be
applied, consistent with \code{\link[gganimate:ease_aes]{gganimate::ease_aes()}}. E.g. \code{list(color = "sine")}.}
\item{enter}{Enter fading function applied to objects in the animation. See
\link[gganimate:enter_exit]{gganimate::enter_exit} for a complete list of options. The tidyexplain
default is \code{\link[gganimate:enter_fade]{gganimate::enter_fade()}}.}
\item{exit}{Exit fading function applied to objects in the animation. See
\link[gganimate:enter_exit]{gganimate::enter_exit} for a complete list of options. The tidyexplain
default is \code{\link[gganimate:exit_fade]{gganimate::exit_fade()}}.}
\item{transition_length}{The relative length of the transition. Will be
recycled to match the number of states in the data}
\item{state_length}{The relative length of the pause at the states. Will be
recycled to match the number of states in the data}
}}


\item{title_family}{the font for the title}

\item{text_size}{the size of the text}

\item{title_size}{the size of the title}

\item{...}{further arguments}
\item{anim_opts}{Animation options generated with \code{\link[=anim_options]{anim_options()}}. Overrides
any options set in \code{...}.}
} }
\value{ \value{
a ggplot a ggplot

man/tidyverbs-package.Rd → man/tidyexplain-package.Rd Прегледај датотеку

% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/zzzz-package.R % Please edit documentation in R/zzzz-package.R
\docType{package} \docType{package}
\name{tidyverbs-package}
\alias{tidyverbs}
\alias{tidyverbs-package}
\title{tidyverbs: Animate the Verbs of the Tidyverse}
\name{tidyexplain-package}
\alias{tidyexplain}
\alias{tidyexplain-package}
\title{tidyexplain: Animated Explanations of Tidyverse Verbs}
\description{ \description{
Animate the verbs of the tidyverse.
Animated explanations of the verbs in the tidyverse
using gganimate and ggplot2.
} }
\author{ \author{
\strong{Maintainer}: Garrick Aden-Buie \email{g.adenbuie@gmail.com} \strong{Maintainer}: Garrick Aden-Buie \email{g.adenbuie@gmail.com}

+ 4
- 0
tests/testthat.R Прегледај датотеку

library(testthat)
library(tidyverbs)

test_check("tidyverbs")

+ 49
- 0
tests/testthat/test-anim_options.R Прегледај датотеку

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 Прегледај датотеку

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 Прегледај датотеку

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")')
})

Loading…
Откажи
Сачувај