| #' @param y right dataset | #' @param y right dataset | ||||
| #' @param type type of the set, i.e., intersect, setdiff, etc. | #' @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 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 | #' @name animate_set_function | ||||
| } | } | ||||
| if (type == "union_all") { | 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) | ll <- lapply(ll, function(a) | ||||
| a %>% mutate(.id_long = paste(.id_long, .side, sep = "-")) | a %>% mutate(.id_long = paste(.id_long, .side, sep = "-")) | ||||
| ) | ) | ||||
| } else { | } 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) | step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1) | ||||
| animate_plot(all, title, ...) %>% animate() | animate_plot(all, title, ...) %>% animate() | ||||
| } else if (export == "first") { | } else if (export == "first") { | ||||
| title <- "" | title <- "" | ||||
| base_plot(step0, title, ...) | |||||
| static_plot(step0, title, ...) | |||||
| } else if (export == "last") { | } else if (export == "last") { | ||||
| base_plot(step1, title, ...) | |||||
| static_plot(step1, title, ...) | |||||
| } | } | ||||
| } | } | ||||
| #' @param by by arguments for the join | #' @param by by arguments for the join | ||||
| #' @param type type of the join, i.e., left_join, right_join, etc. | #' @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 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 | #' @return either a gif or a ggplot | ||||
| #' | #' | ||||
| y <- dplyr::distinct(y) | 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) | step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1) | ||||
| animate_plot(all, title, ...) %>% animate() | animate_plot(all, title, ...) %>% animate() | ||||
| } else if (export == "first") { | } else if (export == "first") { | ||||
| title <- "" | title <- "" | ||||
| base_plot(step0, title, ...) | |||||
| static_plot(step0, title, ...) | |||||
| } else if (export == "last") { | } else if (export == "last") { | ||||
| base_plot(step1, title, ...) | |||||
| static_plot(step1, title, ...) | |||||
| } | } | ||||
| } | } | ||||
| #' animate_left_join(x, y, by = "id") | #' animate_left_join(x, y, by = "id") | ||||
| #' animate_right_join(x, y, by = "id") | #' animate_right_join(x, y, by = "id") | ||||
| #' animate_semi_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 | #' # Save the results |
| #' @name animate_set | #' @name animate_set | ||||
| #' @examples | #' @examples | ||||
| #' x <- data_frame( | #' x <- data_frame( | ||||
| #' id = 1:3, | |||||
| #' x = paste0("x", 1:3) | |||||
| #' x = c(1, 1, 2), | |||||
| #' y = c("a", "b", "a") | |||||
| #' ) | #' ) | ||||
| #' y <- data_frame( | #' 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 = "first") | ||||
| #' animate_union(x, y, export = "last") | #' animate_union(x, y, export = "last") | ||||
| #' | #' | ||||
| #' | #' | ||||
| #' # different options include | #' # different options include | ||||
| #' \donttest{ | #' \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 | #' # Save the results |
| #' @examples | #' @examples | ||||
| #' NULL | #' NULL | ||||
| animate_plot <- function(d, title = "", ...) { | animate_plot <- function(d, title = "", ...) { | ||||
| base_plot(d, title, ...) + | |||||
| static_plot(d, title, ...) + | |||||
| transition_states(.frame, 2, 1) + | transition_states(.frame, 2, 1) + | ||||
| enter_fade() + | enter_fade() + | ||||
| exit_fade() + | exit_fade() + | ||||
| } | } | ||||
| #' Prints the tiles for a processed dataset | |||||
| #' Prints the tiles for a processed dataset statically | |||||
| #' | #' | ||||
| #' @param d a processed dataset | #' @param d a processed dataset | ||||
| #' @param title the title of the plot | #' @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 | #' @param ... further arguments | ||||
| #' | #' | ||||
| #' @return a ggplot | #' @return a ggplot | ||||
| #' | #' | ||||
| #' @examples | #' @examples | ||||
| #' NULL | #' 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) | if (!".alpha" %in% names(d)) d <- d %>% mutate(.alpha = 1) | ||||
| d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-")) | d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-")) |
| #' @param y a right dataset | #' @param y a right dataset | ||||
| #' @param by a by argument for joins / set operations | #' @param by a by argument for joins / set operations | ||||
| #' @param fill if missing ids should be filled | #' @param fill if missing ids should be filled | ||||
| #' @param ... further arguments passed to add_color | |||||
| #' | #' | ||||
| #' @return a preprocessed dataset | #' @return a preprocessed dataset | ||||
| #' | #' | ||||
| #' @examples | #' @examples | ||||
| #' NULL | #' NULL | ||||
| preprocess_data <- function(x, y, by, fill = TRUE) { | |||||
| preprocess_data <- function(x, y, by, fill = TRUE, ...) { | |||||
| #' test for | #' test for | ||||
| #' a <- c("unique", "mult", "mult", "also unique") | #' a <- c("unique", "mult", "mult", "also unique") | ||||
| ids <- dplyr::union(x %>% dplyr::select(.id, .id_long), | ids <- dplyr::union(x %>% dplyr::select(.id, .id_long), | ||||
| y %>% 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) | mutate(.x = .x + ncol(x) - 1) | ||||
| return(list(x = x_, y = y_)) | return(list(x = x_, y = y_)) | ||||
| #' @param width the width of the tiles | #' @param width the width of the tiles | ||||
| #' @param side the side (x or y, lhs or rhs, etc) | #' @param side the side (x or y, lhs or rhs, etc) | ||||
| #' @param fill if missing ids should be filled | #' @param fill if missing ids should be filled | ||||
| #' @param ... further arguments passed to add_color | |||||
| #' | #' | ||||
| #' @return a data_frame including all necessary information | #' @return a data_frame including all necessary information | ||||
| #' | #' | ||||
| #' @examples | #' @examples | ||||
| #' NULL | #' 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)) | if (is.na(side)) side <- deparse(substitute(x)) | ||||
| x_names <- names(x) %>% str_subset("^[^\\.]") | x_names <- names(x) %>% str_subset("^[^\\.]") | ||||
| } | } | ||||
| } | } | ||||
| res <- add_color(x, ids$.id, by) | |||||
| res <- add_color(x, rev(ids$.id), by, ...) | |||||
| return(res) | return(res) | ||||
| } | } | ||||
| #' @param color_header color for the header | #' @param color_header color for the header | ||||
| #' @param color_other color for "inactive" values | #' @param color_other color for "inactive" values | ||||
| #' @param color_missing color for missing 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 | #' @return the processed data_frame with a new column .color | ||||
| #' | #' | ||||
| #' @examples | #' @examples | ||||
| #' NULL | #' 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) | names(colors) <- c(".header", ids) | ||||
| res <- x %>% | 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) | return(res) | ||||
| } | } |
| \alias{add_color} | \alias{add_color} | ||||
| \title{Adds Color to a processed data_frame} | \title{Adds Color to a processed data_frame} | ||||
| \usage{ | \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{ | \arguments{ | ||||
| \item{x}{a processed data_frame} | \item{x}{a processed data_frame} | ||||
| \item{color_other}{color for "inactive" values} | \item{color_other}{color for "inactive" values} | ||||
| \item{color_missing}{color for missing values} | \item{color_missing}{color for missing values} | ||||
| \item{color_fun}{the function to generate the colors} | |||||
| \item{...}{} | |||||
| } | } | ||||
| \value{ | \value{ | ||||
| the processed data_frame with a new column .color | the processed data_frame with a new column .color |
| animate_left_join(x, y, by = "id") | animate_left_join(x, y, by = "id") | ||||
| animate_right_join(x, y, by = "id") | animate_right_join(x, y, by = "id") | ||||
| animate_semi_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 | # Save the results |
| \item{export}{if the function exports a gif, the first, or last picture} | \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{ | \value{ | ||||
| either a gif or a ggplot | either a gif or a ggplot |
| } | } | ||||
| \examples{ | \examples{ | ||||
| x <- data_frame( | x <- data_frame( | ||||
| id = 1:3, | |||||
| x = paste0("x", 1:3) | |||||
| x = c(1, 1, 2), | |||||
| y = c("a", "b", "a") | |||||
| ) | ) | ||||
| y <- data_frame( | 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 = "first") | ||||
| animate_union(x, y, export = "last") | animate_union(x, y, export = "last") | ||||
| # different options include | # different options include | ||||
| \donttest{ | \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 | # Save the results |
| \item{export}{if the function exports a gif, the first, or last picture} | \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{ | \value{ | ||||
| either a gif or a ggplot | either a gif or a ggplot |
| % 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 | |||||
| } |
| \alias{preprocess_data} | \alias{preprocess_data} | ||||
| \title{Preprocess data} | \title{Preprocess data} | ||||
| \usage{ | \usage{ | ||||
| preprocess_data(x, y, by, fill = FALSE) | |||||
| preprocess_data(x, y, by, fill = TRUE, ...) | |||||
| } | } | ||||
| \arguments{ | \arguments{ | ||||
| \item{x}{a left dataset} | \item{x}{a left dataset} | ||||
| \item{by}{a by argument for joins / set operations} | \item{by}{a by argument for joins / set operations} | ||||
| \item{fill}{if missing ids should be filled} | \item{fill}{if missing ids should be filled} | ||||
| \item{...}{further arguments passed to add_color} | |||||
| } | } | ||||
| \value{ | \value{ | ||||
| a preprocessed dataset | a preprocessed dataset |
| \alias{process_data} | \alias{process_data} | ||||
| \title{Processes the data} | \title{Processes the data} | ||||
| \usage{ | \usage{ | ||||
| process_data(x, ids, by, width = 1, side = NA, fill = TRUE) | |||||
| process_data(x, ids, by, width = 1, side = NA, fill = TRUE, ...) | |||||
| } | } | ||||
| \arguments{ | \arguments{ | ||||
| \item{x}{a preprocessed dataset} | \item{x}{a preprocessed dataset} | ||||
| \item{side}{the side (x or y, lhs or rhs, etc)} | \item{side}{the side (x or y, lhs or rhs, etc)} | ||||
| \item{fill}{if missing ids should be filled} | \item{fill}{if missing ids should be filled} | ||||
| \item{...}{further arguments passed to add_color} | |||||
| } | } | ||||
| \value{ | \value{ | ||||
| a data_frame including all necessary information | a data_frame including all necessary information |
| % 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 | |||||
| } |