took out stringr calls, reduced single command pipes

R/animate_joins.R

@@ -1,4 +1,4 @@
-#' Animates a join operations
+#' Animates a join operation
 #'
 #' Functions to visualise the join operations either static as a ggplot, or
 #' dynamic as a gif.

R/animate_tidyr.R

@@ -33,7 +33,7 @@ animate_gather <- function(w, key, value, ..., export = "gif", detailed = TRUE)
   rhs <- tidyr::gather(w, !!key, !!value, ...)
 
   # construct the title sequence
-  lname <- deparse(substitute(w))
+  wname <- deparse(substitute(w))
   ids <- get_quos_names(...)
   # ids <- ""
   # what happens if ids := -year or ids := x:y
@@ -49,12 +49,12 @@ animate_gather <- function(w, key, value, ..., export = "gif", detailed = TRUE)
     current_state = "Wide",
     final_state = "Long",
     operation = sprintf("gather(%s, %s, %s%s)",
-                        lname,
+                        wname,
                         dput_parser(key),
                         dput_parser(value),
                         id_string),
     reverse_operation = sprintf("spread(%s, %s, %s)",
-                                "long_df",
+                                "long",
                                 dput_parser(key),
                                 dput_parser(value))
   )
@@ -112,11 +112,11 @@ animate_spread <- function(l, key, value, export = "gif", detailed = TRUE, ...)
     current_state = "Long",
     final_state = "Wide",
     operation = sprintf("spread(%s, %s, %s)",
-                        "long_df",
+                        lname,
                         dput_parser(key),
                         dput_parser(value)),
     reverse_operation = sprintf("gather(%s, %s, %s%s)",
-                                lname,
+                                "wide",
                                 dput_parser(key),
                                 dput_parser(value),
                                 id_string)

R/move_together.R

@@ -15,18 +15,18 @@ move_together <- function(lhs, rhs, type) {
   all <- bind_rows(lhs, rhs)
 
   # 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
-  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
   # one for combining the columns (col_combiner)
@@ -61,6 +61,12 @@ move_together <- function(lhs, rhs, type) {
   } else if (type == "setdiff") {
     col_combiner <- dplyr::full_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 {
     stop("Unknown func")
   }
@@ -76,10 +82,10 @@ move_together <- function(lhs, rhs, type) {
   mid <- (2 + length(unique(lhs$.col)) + length(unique(rhs$.col))) / 2
   xvals <- 1:nrow(take_cols)
   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"),
                          by = c(".id", ".col")) %>%

R/plot_helpers.R

@@ -39,7 +39,7 @@ animate_plot <- function(d, title = "", transition_length = 2, state_length = 1,
 #' NULL
 static_plot <- function(d, title = "",
                         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 (!".textcolor" %in% names(d))

R/process_data_helpers.R

@@ -59,15 +59,15 @@ process_join <- function(x, y, by, fill = TRUE, ...) {
 process_data_join <- function(x, ids, by, width = 1, side = NA, fill = TRUE, ...) {
   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)
   names(x_keys) <- x_names
 
-  special_vars <- names(x) %>% str_subset("^\\.")
+  special_vars <- names(x)[grepl("^\\.", names(x))]
 
   x <- x %>%
     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],
            .y = -.r) %>%
     bind_rows(data_frame(.id = ".header",
@@ -85,9 +85,9 @@ process_data_join <- function(x, ids, by, width = 1, side = NA, fill = TRUE, ...
   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
   # missing dublicate ids
-  mis_ids <- str_subset(mis_ids, "[^-1]$")
+  mis_ids <- mis_ids[grepl("[^-1]$", mis_ids)]
   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
     for (i in mis_ids_short) {

R/tidyr_helpers.R

@@ -92,7 +92,7 @@ process_wide <- function(x, ids, key, color_id = "lightgray", ...) {
     unite(one_of(ids), col = ".id_map", remove = F)
 
   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,
            .type = ifelse(.col %in% ids, "id", "value"),
            .val = as.character(.val),
@@ -184,7 +184,7 @@ process_long <- function(x, ids, key, value, ...) {
   names(x_dict) <- xn
 
   x <- x %>%
-    gather(key = ".col", value = ".val", names(x) %>% str_subset("^[^\\.]")) %>%
+    gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>%
     mutate(
       .x = x_dict[.col],
       .y = -rep(1:nr, nc),
@@ -339,7 +339,7 @@ gather_spread <- function(lhs, rhs, sequence, key_values, export, detailed, ...)
                            labels = frame_labels))
 
   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") {
     static_plot(state_start) #....
   } else if (export == "last") {

man/animate_join.Rd

@@ -8,7 +8,7 @@
 \alias{animate_right_join}
 \alias{animate_semi_join}
 \alias{animate_anti_join}
-\title{Animates a join operations}
+\title{Animates a join operation}
 \usage{
 animate_full_join(x, y, by, export = "gif", ...)
 

man/static_plot.Rd

@@ -5,7 +5,7 @@
 \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, ...)
+  title_family = "Fira Mono", text_size = 5, title_size = 17, ...)
 }
 \arguments{
 \item{d}{a processed dataset}