arguments can be now passed to tweak plot details

R/animate_helpers.R

@@ -5,7 +5,7 @@
 #' @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 base_plot
+#' @param ... further arguments passed to base_plot or to add_color
 #'
 #'
 #' @name animate_set_function
@@ -34,12 +34,12 @@ animate_set <- function(x, y, type, export = "gif", ...) {
   }
 
   if (type == "union_all") {
-    ll <- preprocess_data(x, y, by = names(x), fill = FALSE)
+    ll <- preprocess_data(x, y, by = names(x), fill = FALSE, ...)
     ll <- lapply(ll, function(a)
       a %>% mutate(.id_long = paste(.id_long, .side, sep = "-"))
     )
   } else {
-    ll <- preprocess_data(x, y, by = names(x))
+    ll <- preprocess_data(x, y, by = names(x), ...)
   }
 
   step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)
@@ -52,9 +52,9 @@ animate_set <- function(x, y, type, export = "gif", ...) {
     animate_plot(all, title, ...) %>% animate()
   } else if (export == "first") {
     title <- ""
-    base_plot(step0, title, ...)
+    static_plot(step0, title, ...)
   } else if (export == "last") {
-    base_plot(step1, title, ...)
+    static_plot(step1, title, ...)
   }
 }
 
@@ -65,7 +65,7 @@ animate_set <- function(x, y, type, export = "gif", ...) {
 #' @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 base_plot
+#' @param ... further arguments passed to base_plot or to add_color
 #'
 #' @return either a gif or a ggplot
 #'
@@ -96,7 +96,7 @@ animate_join <- function(x, y, by, type, export = "gif", ...) {
     y <- dplyr::distinct(y)
   }
 
-  ll <- preprocess_data(x, y, by)
+  ll <- preprocess_data(x, y, by, ...)
 
   step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)
 
@@ -108,9 +108,9 @@ animate_join <- function(x, y, by, type, export = "gif", ...) {
     animate_plot(all, title, ...) %>% animate()
   } else if (export == "first") {
     title <- ""
-    base_plot(step0, title, ...)
+    static_plot(step0, title, ...)
   } else if (export == "last") {
-    base_plot(step1, title, ...)
+    static_plot(step1, title, ...)
   }
 }
 

R/animate_joins.R

@@ -41,7 +41,16 @@
 #'   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_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

R/animate_sets.R

@@ -16,18 +16,15 @@
 #' @name animate_set
 #' @examples
 #' x <- data_frame(
-#'   id = 1:3,
-#'   x = paste0("x", 1:3)
+#'   x = c(1, 1, 2),
+#'   y = c("a", "b", "a")
 #' )
 #' y <- data_frame(
-#'   id = (1:4)[-3],
-#'   y = paste0("y", (1:4)[-3])
+#'   x = c(1, 2),
+#'   y = c("a", "b")
 #' )
 #'
-#' animate_union(x, y, by = "id", export = "first")
-#' animate_union(x, y, by = "id", export = "last")
-#'
-#' # Animate the first or last state of the join
+#' # Animate the first or last state of the set
 #' animate_union(x, y, export = "first")
 #' animate_union(x, y, export = "last")
 #'
@@ -38,10 +35,19 @@
 #'
 #' # different options include
 #' \donttest{
-#'   animate_union(x, y, by = "id")
-#'   animate_union_all(x, y, by = "id")
-#'   animate_intersect(x, y, by = "id")
-#'   animate_setdiff(x, y, by = "id")
+#'   animate_union(x, y)
+#'   animate_union_all(x, y)
+#'   animate_intersect(x, y)
+#'   animate_setdiff(x, y)
+#'
+#'   # further arguments can be passed to all animate_* functions
+#'   animate_union(
+#'     x, y,
+#'     text_size = 5, title_size = 25,
+#'     color_header = "black",
+#'     color_other = "lightblue",
+#'     color_fun = viridis::viridis
+#'   )
 #' }
 #'
 #' # Save the results

R/plot_helpers.R

@@ -10,7 +10,7 @@
 #' @examples
 #' NULL
 animate_plot <- function(d, title = "", ...) {
-  base_plot(d, title, ...) +
+  static_plot(d, title, ...) +
     transition_states(.frame, 2, 1) +
     enter_fade() +
     exit_fade() +
@@ -18,41 +18,23 @@ animate_plot <- function(d, title = "", ...) {
 }
 
 
-#' Prints the tiles for a processed dataset
+#' 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
 #'
 #' @return a ggplot
 #'
 #' @examples
 #' NULL
-base_plot <- function(d, title = "", ...) {
-  dots <- list(...)
-
-  if ("text_family" %in% names(dots)) {
-    text_family <- dots$text_family
-  } else {
-    text_family <- "Fira Sans"
-  }
-
-  if ("title_family" %in% names(dots)) {
-    title_family <- dots$title_family
-  } else {
-    title_family <- "Fira Mono"
-  }
-
-  if ("title_size" %in% names(dots)) {
-    title_size <- dots$title_size
-  } else {
-    title_size <- 20
-  }
-  if ("text_size" %in% names(dots)) {
-    text_size <- dots$text_size
-  } else {
-    text_size <- 10
-  }
+static_plot <- function(d, title = "",
+                      text_family = "Fira Sans", title_family = "Fira Mono",
+                      text_size = 7, title_size = 25, ...) {
 
   if (!".alpha" %in% names(d)) d <- d %>% mutate(.alpha = 1)
   d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-"))

R/process_data_helpers.R

@@ -5,12 +5,13 @@
 #' @param y a right dataset
 #' @param by a by argument for joins / set operations
 #' @param fill if missing ids should be filled
+#' @param ... further arguments passed to add_color
 #'
 #' @return a preprocessed dataset
 #'
 #' @examples
 #' NULL
-preprocess_data <- function(x, y, by, fill = TRUE) {
+preprocess_data <- function(x, y, by, fill = TRUE, ...) {
 
   #' test for
   #' a <- c("unique", "mult", "mult", "also unique")
@@ -33,8 +34,8 @@ preprocess_data <- function(x, y, by, fill = TRUE) {
   ids <- dplyr::union(x %>% dplyr::select(.id, .id_long),
                       y %>% dplyr::select(.id, .id_long))
 
-  x_ <- process_data(x, ids, by, fill = fill)
-  y_ <- process_data(y, ids, by, fill = fill) %>%
+  x_ <- process_data(x, ids, by, fill = fill, ...)
+  y_ <- process_data(y, ids, by, fill = fill, ...) %>%
     mutate(.x = .x + ncol(x) - 1)
 
   return(list(x = x_, y = y_))
@@ -49,12 +50,13 @@ preprocess_data <- function(x, y, by, fill = TRUE) {
 #' @param width the width of the tiles
 #' @param side the side (x or y, lhs or rhs, etc)
 #' @param fill if missing ids should be filled
+#' @param ... further arguments passed to add_color
 #'
 #' @return a data_frame including all necessary information
 #'
 #' @examples
 #' NULL
-process_data <- function(x, ids, by, width = 1, side = NA, fill = TRUE) {
+process_data <- function(x, ids, by, width = 1, side = NA, fill = TRUE, ...) {
   if (is.na(side)) side <- deparse(substitute(x))
 
   x_names <- names(x) %>% str_subset("^[^\\.]")
@@ -99,7 +101,7 @@ process_data <- function(x, ids, by, width = 1, side = NA, fill = TRUE) {
     }
   }
 
-  res <- add_color(x, ids$.id, by)
+  res <- add_color(x, rev(ids$.id), by, ...)
   return(res)
 }
 
@@ -111,17 +113,27 @@ process_data <- function(x, ids, by, width = 1, side = NA, fill = TRUE) {
 #' @param color_header color for the header
 #' @param color_other color for "inactive" values
 #' @param color_missing color for missing values
+#' @param color_fun the function to generate the colors
+#' @param ...
 #'
 #' @return the processed data_frame with a new column .color
 #'
 #' @examples
 #' NULL
-add_color <- function(x, ids, by, color_header = "#bdbdbd", color_other = "#d0d0d0", color_missing = "#ffffff") {
-  colors <- c(color_header, scales::brewer_pal(type = "qual", "Set1")(length(ids)))
+add_color <- function(x, ids, by,
+                      color_header = "#737373", color_other = "#d0d0d0",
+                      color_missing = "#ffffff",
+                      color_fun = scales::brewer_pal(type = "qual", "Set1"), ...) {
+  colors <- c(color_header, color_fun(length(ids)))
   names(colors) <- c(".header", ids)
 
   res <- x %>%
-    mutate(.color = ifelse(is.na(.val), color_missing, colors[.id]),
-           .color = ifelse(.col %in% by, .color, color_other))
+    mutate(
+      .color = ifelse(is.na(.val),
+                      color_missing,
+                      ifelse(.col %in% by,
+                             colors[.id],
+                             color_other)),
+      .color = ifelse(.id == ".header", color_header, .color))
   return(res)
 }

man/add_color.Rd

@@ -4,8 +4,9 @@
 \alias{add_color}
 \title{Adds Color to a processed data_frame}
 \usage{
-add_color(x, ids, by, color_header = "#bdbdbd",
-  color_other = "#d0d0d0", color_missing = "#ffffff")
+add_color(x, ids, by, color_header = "#737373",
+  color_other = "#d0d0d0", color_missing = "#ffffff",
+  color_fun = scales::brewer_pal(type = "qual", "Set1"), ...)
 }
 \arguments{
 \item{x}{a processed data_frame}
@@ -19,6 +20,10 @@ add_color(x, ids, by, color_header = "#bdbdbd",
 \item{color_other}{color for "inactive" values}
 
 \item{color_missing}{color for missing values}
+
+\item{color_fun}{the function to generate the colors}
+
+\item{...}{}
 }
 \value{
 the processed data_frame with a new column .color

man/animate_join.Rd

@@ -67,7 +67,16 @@ animate_full_join(x, y, by = "id", export = "last")
   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_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

man/animate_join_function.Rd

@@ -18,7 +18,7 @@ animate_join(x, y, by, type, export = "gif", ...)
 
 \item{export}{if the function exports a gif, the first, or last picture}
 
-\item{...}{further arguments passed to base_plot}
+\item{...}{further arguments passed to base_plot or to add_color}
 }
 \value{
 either a gif or a ggplot

man/animate_set.Rd

@@ -35,18 +35,15 @@ dynamic as a gif.
 }
 \examples{
 x <- data_frame(
-  id = 1:3,
-  x = paste0("x", 1:3)
+  x = c(1, 1, 2),
+  y = c("a", "b", "a")
 )
 y <- data_frame(
-  id = (1:4)[-3],
-  y = paste0("y", (1:4)[-3])
+  x = c(1, 2),
+  y = c("a", "b")
 )
 
-animate_union(x, y, by = "id", export = "first")
-animate_union(x, y, by = "id", export = "last")
-
-# Animate the first or last state of the join
+# Animate the first or last state of the set
 animate_union(x, y, export = "first")
 animate_union(x, y, export = "last")
 
@@ -57,10 +54,19 @@ animate_union(x, y, export = "last")
 
 # different options include
 \donttest{
-  animate_union(x, y, by = "id")
-  animate_union_all(x, y, by = "id")
-  animate_intersect(x, y, by = "id")
-  animate_setdiff(x, y, by = "id")
+  animate_union(x, y)
+  animate_union_all(x, y)
+  animate_intersect(x, y)
+  animate_setdiff(x, y)
+
+  # further arguments can be passed to all animate_* functions
+  animate_union(
+    x, y,
+    text_size = 5, title_size = 25,
+    color_header = "black",
+    color_other = "lightblue",
+    color_fun = viridis::viridis
+  )
 }
 
 # Save the results

man/animate_set_function.Rd

@@ -16,7 +16,7 @@ animate_set(x, y, type, export = "gif", ...)
 
 \item{export}{if the function exports a gif, the first, or last picture}
 
-\item{...}{further arguments passed to base_plot}
+\item{...}{further arguments passed to base_plot or to add_color}
 }
 \value{
 either a gif or a ggplot

man/base_plot.Rd

@@ -1,24 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/plot_helpers.R
-\name{base_plot}
-\alias{base_plot}
-\title{Prints the tiles for a processed dataset}
-\usage{
-base_plot(d, title = "", ...)
-}
-\arguments{
-\item{d}{a processed dataset}
-
-\item{title}{the title of the plot}
-
-\item{...}{further arguments}
-}
-\value{
-a ggplot
-}
-\description{
-Prints the tiles for a processed dataset
-}
-\examples{
-NULL
-}

man/preprocess_data.Rd

@@ -4,7 +4,7 @@
 \alias{preprocess_data}
 \title{Preprocess data}
 \usage{
-preprocess_data(x, y, by, fill = FALSE)
+preprocess_data(x, y, by, fill = TRUE, ...)
 }
 \arguments{
 \item{x}{a left dataset}
@@ -14,6 +14,8 @@ preprocess_data(x, y, by, fill = FALSE)
 \item{by}{a by argument for joins / set operations}
 
 \item{fill}{if missing ids should be filled}
+
+\item{...}{further arguments passed to add_color}
 }
 \value{
 a preprocessed dataset

man/process_data.Rd

@@ -4,7 +4,7 @@
 \alias{process_data}
 \title{Processes the data}
 \usage{
-process_data(x, ids, by, width = 1, side = NA, fill = TRUE)
+process_data(x, ids, by, width = 1, side = NA, fill = TRUE, ...)
 }
 \arguments{
 \item{x}{a preprocessed dataset}
@@ -18,6 +18,8 @@ process_data(x, ids, by, width = 1, side = NA, fill = TRUE)
 \item{side}{the side (x or y, lhs or rhs, etc)}
 
 \item{fill}{if missing ids should be filled}
+
+\item{...}{further arguments passed to add_color}
 }
 \value{
 a data_frame including all necessary information

man/static_plot.Rd

@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot_helpers.R
+\name{static_plot}
+\alias{static_plot}
+\title{Prints the tiles for a processed dataset statically}
+\usage{
+static_plot(d, title = "", text_family = "Fira Sans",
+  title_family = "Fira Mono", text_size = 7, title_size = 25, ...)
+}
+\arguments{
+\item{d}{a processed dataset}
+
+\item{title}{the title of the plot}
+
+\item{text_family}{the font for the text}
+
+\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}
+}
+\value{
+a ggplot
+}
+\description{
+Prints the tiles for a processed dataset statically
+}
+\examples{
+NULL
+}