Przeglądaj źródła

Update animate_sets to match animate_joins

- Use quasiquotation to get variable names
- Unified documentation
- Use match.arg to guard for correct arguments in type and export
- Removed animate_helpers.R
pull/18/merge
Garrick Aden-Buie 7 lat temu
rodzic
commit
d2833f1e30
5 zmienionych plików z 105 dodań i 149 usunięć
  1. +0
    -59
      R/animate_helpers.R
  2. +2
    -2
      R/animate_joins.R
  3. +76
    -31
      R/animate_sets.R
  4. +27
    -28
      man/animate_set.Rd
  5. +0
    -29
      man/animate_set_function.Rd

+ 0
- 59
R/animate_helpers.R Wyświetl plik

@@ -1,59 +0,0 @@

#' 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, ...)
}
}

+ 2
- 2
R/animate_joins.R Wyświetl plik

@@ -66,11 +66,11 @@ animate_join <- function(
export = c("gif", "first", "last"),
...
) {
type <- match.arg(type)
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)
data <- make_named_data(x, y)

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

+ 76
- 31
R/animate_sets.R Wyświetl plik

@@ -7,23 +7,16 @@
#' @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}}
#'
#' @name animate_set
#'
#' @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_union(x, y, export = "first")
@@ -31,59 +24,111 @@
#'
#' # animate the transition as a gif (default)
#' \donttest{
#' animate_union(x, y, export = "gif")
#' 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)
#' 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
#' \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
#' @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, ...)
}

+ 27
- 28
man/animate_set.Rd Wyświetl plik

@@ -8,6 +8,9 @@
\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", ...)
@@ -21,6 +24,8 @@ animate_setdiff(x, y, export = "gif", ...)

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

@@ -34,14 +39,8 @@ 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")
)
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")
@@ -49,36 +48,36 @@ animate_union(x, y, export = "last")

# animate the transition as a gif (default)
\donttest{
animate_union(x, y, export = "gif")
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)
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
\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{

+ 0
- 29
man/animate_set_function.Rd Wyświetl plik

@@ -1,29 +0,0 @@
% 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
}

Ładowanie…
Anuluj
Zapisz