Просмотр исходного кода

took out stringr calls, reduced single command pipes

pull/18/merge
David 7 лет назад
Родитель
Сommit
bfa7255a92
8 измененных файлов: 34 добавлений и 28 удалений
  1. +1
    -1
      R/animate_joins.R
  2. +5
    -5
      R/animate_tidyr.R
  3. +17
    -11
      R/move_together.R
  4. +1
    -1
      R/plot_helpers.R
  5. +5
    -5
      R/process_data_helpers.R
  6. +3
    -3
      R/tidyr_helpers.R
  7. +1
    -1
      man/animate_join.Rd
  8. +1
    -1
      man/static_plot.Rd

+ 1
- 1
R/animate_joins.R Просмотреть файл

#' 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.

+ 5
- 5
R/animate_tidyr.R Просмотреть файл

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)

+ 17
- 11
R/move_together.R Просмотреть файл

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")) %>%

+ 1
- 1
R/plot_helpers.R Просмотреть файл

#' 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))

+ 5
- 5
R/process_data_helpers.R Просмотреть файл

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) {

+ 3
- 3
R/tidyr_helpers.R Просмотреть файл

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") {

+ 1
- 1
man/animate_join.Rd Просмотреть файл

\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", ...)



+ 1
- 1
man/static_plot.Rd Просмотреть файл

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

Загрузка…
Отмена
Сохранить