| #' Animates a join operations | |||||
| #' Animates a join operation | |||||
| #' | #' | ||||
| #' Functions to visualise the join operations either static as a ggplot, or | #' Functions to visualise the join operations either static as a ggplot, or | ||||
| #' dynamic as a gif. | #' dynamic as a gif. |
| rhs <- tidyr::gather(w, !!key, !!value, ...) | rhs <- tidyr::gather(w, !!key, !!value, ...) | ||||
| # construct the title sequence | # construct the title sequence | ||||
| lname <- deparse(substitute(w)) | |||||
| wname <- deparse(substitute(w)) | |||||
| ids <- get_quos_names(...) | ids <- get_quos_names(...) | ||||
| # ids <- "" | # ids <- "" | ||||
| # what happens if ids := -year or ids := x:y | # what happens if ids := -year or ids := x:y | ||||
| current_state = "Wide", | current_state = "Wide", | ||||
| final_state = "Long", | final_state = "Long", | ||||
| operation = sprintf("gather(%s, %s, %s%s)", | operation = sprintf("gather(%s, %s, %s%s)", | ||||
| lname, | |||||
| wname, | |||||
| dput_parser(key), | dput_parser(key), | ||||
| dput_parser(value), | dput_parser(value), | ||||
| id_string), | id_string), | ||||
| reverse_operation = sprintf("spread(%s, %s, %s)", | reverse_operation = sprintf("spread(%s, %s, %s)", | ||||
| "long_df", | |||||
| "long", | |||||
| dput_parser(key), | dput_parser(key), | ||||
| dput_parser(value)) | dput_parser(value)) | ||||
| ) | ) | ||||
| current_state = "Long", | current_state = "Long", | ||||
| final_state = "Wide", | final_state = "Wide", | ||||
| operation = sprintf("spread(%s, %s, %s)", | operation = sprintf("spread(%s, %s, %s)", | ||||
| "long_df", | |||||
| lname, | |||||
| dput_parser(key), | dput_parser(key), | ||||
| dput_parser(value)), | dput_parser(value)), | ||||
| reverse_operation = sprintf("gather(%s, %s, %s%s)", | reverse_operation = sprintf("gather(%s, %s, %s%s)", | ||||
| lname, | |||||
| "wide", | |||||
| dput_parser(key), | dput_parser(key), | ||||
| dput_parser(value), | dput_parser(value), | ||||
| id_string) | id_string) |
| all <- bind_rows(lhs, rhs) | all <- bind_rows(lhs, rhs) | ||||
| # separate column and row-filter (ids) | # separate column and row-filter (ids) | ||||
| x_cols <- lhs %>% distinct(.col) | |||||
| y_cols <- rhs %>% distinct(.col) | |||||
| x_cols <- distinct(lhs, .col) | |||||
| y_cols <- 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 <- lhs %>% distinct(.id, .id_long) | |||||
| y_ids <- rhs %>% distinct(.id, .id_long) | |||||
| x_ids <- distinct(lhs, .id, .id_long) | |||||
| y_ids <- distinct(rhs, .id, .id_long) | |||||
| x_headers <- x_ids %>% filter(str_detect(.id_long, "^\\.header")) | |||||
| y_headers <- y_ids %>% filter(str_detect(.id_long, "^\\.header")) | |||||
| x_headers <- filter(x_ids, grepl("^\\.header", .id_long)) | |||||
| y_headers <- filter(y_ids, grepl("^\\.header", .id_long)) | |||||
| x_ids <- x_ids %>% filter(!str_detect(.id_long, "^\\.header")) | |||||
| y_ids <- y_ids %>% filter(!str_detect(.id_long, "^\\.header")) | |||||
| x_ids <- x_ids %>% filter(!grepl("^\\.header", .id_long)) | |||||
| y_ids <- y_ids %>% filter(!grepl("^\\.header", .id_long)) | |||||
| # assign two combiner functions depending on the type | # assign two combiner functions depending on the type | ||||
| # one for combining the columns (col_combiner) | # one for combining the columns (col_combiner) | ||||
| } else if (type == "setdiff") { | } else if (type == "setdiff") { | ||||
| col_combiner <- dplyr::full_join | col_combiner <- dplyr::full_join | ||||
| row_combiner <- dplyr::anti_join | row_combiner <- dplyr::anti_join | ||||
| } else if (type == "bind_rows") { | |||||
| col_combiner <- dplyr::full_join | |||||
| row_combiner <- dplyr::bind_rows | |||||
| } else if (type == "bind_cols") { | |||||
| col_combiner <- dplyr::full_join | |||||
| row_combiner <- dplyr::left_join | |||||
| } else { | } else { | ||||
| stop("Unknown func") | stop("Unknown func") | ||||
| } | } | ||||
| mid <- (2 + length(unique(lhs$.col)) + length(unique(rhs$.col))) / 2 | mid <- (2 + length(unique(lhs$.col)) + length(unique(rhs$.col))) / 2 | ||||
| xvals <- 1:nrow(take_cols) | xvals <- 1:nrow(take_cols) | ||||
| xvals <- xvals - mean(xvals) + mid | xvals <- xvals - mean(xvals) + mid | ||||
| names(xvals) <- take_cols %>% pull(.col) | |||||
| names(xvals) <- pull(take_cols, .col) | |||||
| yvals <- cumsum(ifelse(str_detect(take_ids$.id_long, "^\\.header"), 0, -1)) | |||||
| names(yvals) <- take_ids %>% pull(.id_long) | |||||
| yvals <- cumsum(ifelse(grepl("^\\.header", take_ids$.id_long), 0, -1)) | |||||
| names(yvals) <- pull(take_ids, .id_long) | |||||
| take_vals <- semi_join(all, take %>% select(".id", ".col"), | take_vals <- semi_join(all, take %>% select(".id", ".col"), | ||||
| by = c(".id", ".col")) %>% | by = c(".id", ".col")) %>% |
| #' NULL | #' NULL | ||||
| static_plot <- function(d, title = "", | static_plot <- function(d, title = "", | ||||
| text_family = "Fira Sans", title_family = "Fira Mono", | text_family = "Fira Sans", title_family = "Fira Mono", | ||||
| text_size = 7, title_size = 25, ...) { | |||||
| text_size = 5, title_size = 17, ...) { | |||||
| 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)) |
| process_data_join <- function(x, ids, by, width = 1, side = NA, fill = TRUE, ...) { | process_data_join <- 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)[grepl("^[^\\.]", names(x))] | |||||
| x_keys <- 1:length(x_names) | x_keys <- 1:length(x_names) | ||||
| names(x_keys) <- x_names | names(x_keys) <- x_names | ||||
| special_vars <- names(x) %>% str_subset("^\\.") | |||||
| special_vars <- names(x)[grepl("^\\.", names(x))] | |||||
| x <- x %>% | x <- x %>% | ||||
| mutate(.r = row_number()) %>% | mutate(.r = row_number()) %>% | ||||
| gather_(key = ".col", value = ".val", names(x) %>% str_subset("^[^.]")) %>% | |||||
| 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", | ||||
| mis_ids <- id_long[!id_long %in% x$.id_long] | mis_ids <- id_long[!id_long %in% x$.id_long] | ||||
| # if the missing value is a -1, that means the missing value comes not from | # if the missing value is a -1, that means the missing value comes not from | ||||
| # missing dublicate ids | # missing dublicate ids | ||||
| mis_ids <- str_subset(mis_ids, "[^-1]$") | |||||
| mis_ids <- mis_ids[grepl("[^-1]$", mis_ids)] | |||||
| if (length(mis_ids) > 0 && fill) { | if (length(mis_ids) > 0 && fill) { | ||||
| mis_ids_short <- str_replace(mis_ids, "-[0-9]+$", "") | |||||
| mis_ids_short <- gsub("-[0-9]+$", "", mis_ids) | |||||
| # insert the missing ids at the right place | # insert the missing ids at the right place | ||||
| for (i in mis_ids_short) { | for (i in mis_ids_short) { |
| unite(one_of(ids), col = ".id_map", remove = F) | unite(one_of(ids), col = ".id_map", remove = F) | ||||
| x <- x %>% | x <- x %>% | ||||
| gather(key = ".col", value = ".val", names(x) %>% str_subset("^[^\\.]")) %>% | |||||
| gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>% | |||||
| mutate(.key_map = .col, | mutate(.key_map = .col, | ||||
| .type = ifelse(.col %in% ids, "id", "value"), | .type = ifelse(.col %in% ids, "id", "value"), | ||||
| .val = as.character(.val), | .val = as.character(.val), | ||||
| names(x_dict) <- xn | names(x_dict) <- xn | ||||
| x <- x %>% | x <- x %>% | ||||
| gather(key = ".col", value = ".val", names(x) %>% str_subset("^[^\\.]")) %>% | |||||
| 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), | ||||
| 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, transition_length = tl, state_length = sl) #, ...) | |||||
| } else if (export == "first") { | } else if (export == "first") { | ||||
| static_plot(state_start) #.... | static_plot(state_start) #.... | ||||
| } else if (export == "last") { | } else if (export == "last") { |
| \alias{animate_right_join} | \alias{animate_right_join} | ||||
| \alias{animate_semi_join} | \alias{animate_semi_join} | ||||
| \alias{animate_anti_join} | \alias{animate_anti_join} | ||||
| \title{Animates a join operations} | |||||
| \title{Animates a join operation} | |||||
| \usage{ | \usage{ | ||||
| animate_full_join(x, y, by, export = "gif", ...) | animate_full_join(x, y, by, export = "gif", ...) | ||||
| \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", | static_plot(d, title = "", text_family = "Fira Sans", | ||||
| title_family = "Fira Mono", text_size = 7, title_size = 25, ...) | |||||
| title_family = "Fira Mono", text_size = 5, title_size = 17, ...) | |||||
| } | } | ||||
| \arguments{ | \arguments{ | ||||
| \item{d}{a processed dataset} | \item{d}{a processed dataset} |