Browse Source

Add tidyr:: and dplyr:: where needed

Adds a few additional dplyr functions to the package imports, in particular: slice, data_frame, and row_number.
pull/18/merge
Garrick Aden-Buie 7 years ago
parent
commit
e600e4f31d
5 changed files with 26 additions and 22 deletions
  1. +3
    -0
      NAMESPACE
  2. +4
    -4
      R/move_together.R
  3. +4
    -3
      R/process_data_helpers.R
  4. +14
    -14
      R/tidyr_helpers.R
  5. +1
    -1
      R/zzzz-package.R

+ 3
- 0
NAMESPACE View File

importFrom(dplyr,arrange) importFrom(dplyr,arrange)
importFrom(dplyr,bind_cols) importFrom(dplyr,bind_cols)
importFrom(dplyr,bind_rows) importFrom(dplyr,bind_rows)
importFrom(dplyr,data_frame)
importFrom(dplyr,filter) importFrom(dplyr,filter)
importFrom(dplyr,full_join) importFrom(dplyr,full_join)
importFrom(dplyr,group_by) importFrom(dplyr,group_by)
importFrom(dplyr,mutate) importFrom(dplyr,mutate)
importFrom(dplyr,pull) importFrom(dplyr,pull)
importFrom(dplyr,right_join) importFrom(dplyr,right_join)
importFrom(dplyr,row_number)
importFrom(dplyr,select) importFrom(dplyr,select)
importFrom(dplyr,semi_join) importFrom(dplyr,semi_join)
importFrom(dplyr,slice)
importFrom(magrittr,"%>%") importFrom(magrittr,"%>%")

+ 4
- 4
R/move_together.R View File

all <- bind_rows(lhs, rhs) all <- bind_rows(lhs, rhs)


# separate column and row-filter (ids) # separate column and row-filter (ids)
x_cols <- distinct(lhs, .col)
y_cols <- distinct(rhs, .col)
x_cols <- dplyr::distinct(lhs, .col)
y_cols <- dplyr::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 <- distinct(lhs, .id, .id_long)
y_ids <- distinct(rhs, .id, .id_long)
x_ids <- dplyr::distinct(lhs, .id, .id_long)
y_ids <- dplyr::distinct(rhs, .id, .id_long)


x_headers <- filter(x_ids, grepl("^\\.header", .id_long)) x_headers <- filter(x_ids, grepl("^\\.header", .id_long))
y_headers <- filter(y_ids, grepl("^\\.header", .id_long)) y_headers <- filter(y_ids, grepl("^\\.header", .id_long))

+ 4
- 3
R/process_data_helpers.R View File

} }


x <- x %>% x <- x %>%
unite(one_of(by), col = ".id", remove = FALSE) %>%
tidyr::unite(dplyr::one_of(by), col = ".id", remove = FALSE) %>%
mutate(.id_long = add_duplicate_number(.id)) mutate(.id_long = add_duplicate_number(.id))


y <- y %>% y <- y %>%
unite(one_of(by), col = ".id", remove = FALSE) %>%
tidyr::unite(dplyr::one_of(by), col = ".id", remove = FALSE) %>%
mutate(.id_long = add_duplicate_number(.id)) mutate(.id_long = add_duplicate_number(.id))


ids <- dplyr::union(x %>% dplyr::select(.id, .id_long), ids <- dplyr::union(x %>% dplyr::select(.id, .id_long),


x <- x %>% x <- x %>%
mutate(.r = row_number()) %>% mutate(.r = row_number()) %>%
gather_(key = ".col", value = ".val", names(x)[grepl("^[^.]", names(x))]) %>%
# TODO re-evaluate gather_ here
tidyr::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",

+ 14
- 14
R/tidyr_helpers.R View File

key_values <- key_values[!key_values %in% ids] key_values <- key_values[!key_values %in% ids]


id_values <- x %>% select(one_of(ids)) id_values <- x %>% select(one_of(ids))
id_values <- id_values %>% gather(key = ".key_map", value = ".id_map")
id_values <- id_values %>% tidyr::gather(key = ".key_map", value = ".id_map")


x <- x %>% mutate(.r = row_number()) %>% x <- x %>% mutate(.r = row_number()) %>%
unite(one_of(ids), col = ".id_map", remove = F)
tidyr::unite(dplyr::one_of(ids), col = ".id_map", remove = F)


x <- x %>% x <- x %>%
gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>% gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>%
tmp <- x %>% filter(.key_map %in% ids) tmp <- x %>% filter(.key_map %in% ids)
x <- bind_rows( x <- bind_rows(
left_join(tmp %>% select(-.key_map), left_join(tmp %>% select(-.key_map),
tmp %>% select(.id_map) %>% crossing(.key_map = key_values),
tmp %>% select(.id_map) %>% tidyr::crossing(.key_map = key_values),
by = ".id_map"), by = ".id_map"),
x %>% filter(!.key_map %in% ids) x %>% filter(!.key_map %in% ids)
) )


# add header: # add header:
crosser <- crossing(.id_map = as.character(id_values$.id_map),
crosser <- tidyr::crossing(.id_map = as.character(id_values$.id_map),
.key_map = key_values) .key_map = key_values)
key_header <- data_frame( key_header <- data_frame(
.key_map = key_values, .key_map = key_values,
.x = 1:length(ids), .x = 1:length(ids),
.y = 0, .y = 0,
.header = TRUE), .header = TRUE),
crossing(.id_map = ids, .key_map = key_values),
tidyr::crossing(.id_map = ids, .key_map = key_values),
by = ".id_map" by = ".id_map"
) )


x <- bind_rows(id_header, key_header, x) x <- bind_rows(id_header, key_header, x)


x <- x %>% unite(.key_map, .id_map, .val, col = ".id", remove = F)
x <- x %>% tidyr::unite(.key_map, .id_map, .val, col = ".id", remove = F)


x %>% x %>%
add_color_tidyr(key_values = key_values) %>% add_color_tidyr(key_values = key_values) %>%
xn <- names(x) xn <- names(x)


x <- x %>% mutate(.r = row_number()) %>% x <- x %>% mutate(.r = row_number()) %>%
unite(ids, col = ".id_map", remove = F) %>%
unite(key, col = ".key_map", remove = F)
tidyr::unite(ids, col = ".id_map", remove = F) %>%
tidyr::unite(key, col = ".key_map", remove = F)


key_values <- x %>% pull(key) %>% unique() key_values <- x %>% pull(key) %>% unique()


names(x_dict) <- xn names(x_dict) <- xn


x <- x %>% x <- x %>%
gather(key = ".col", value = ".val", names(x)[grepl("^[^\\.]", names(x))]) %>%
tidyr::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),


# add headers: # add headers:


id_headers <- crossing(.id_map = ids, # x$.id_map %>% unique()
.key_map = key_values,
) %>%
id_headers <- tidyr::crossing(.id_map = ids, # x$.id_map %>% unique()
.key_map = key_values,
) %>%
mutate( mutate(
.r = 0, .r = 0,
.col = "id", .col = "id",
) )


x <- x %>% x <- x %>%
add_row(
dplyr::add_row(
.before = T, .before = T,
.id_map = c(rep("key", length(key)), rep("value", length(value))), .id_map = c(rep("key", length(key)), rep("value", length(value))),
.key_map = c(rep("key", length(key)), rep("value", length(value))), .key_map = c(rep("key", length(key)), rep("value", length(value))),
x <- bind_rows(id_headers, x) x <- bind_rows(id_headers, x)


x <- x %>% x <- x %>%
unite(.key_map, .id_map, .val, col = ".id", remove = F)
tidyr::unite(.key_map, .id_map, .val, col = ".id", remove = F)


x %>% add_color_tidyr(key_values = key_values) %>% x %>% add_color_tidyr(key_values = key_values) %>%
mutate(.alpha = ifelse(.header == TRUE, 1, 0.6)) mutate(.alpha = ifelse(.header == TRUE, 1, 0.6))

+ 1
- 1
R/zzzz-package.R View File

#' @importFrom dplyr left_join right_join full_join inner_join semi_join anti_join #' @importFrom dplyr left_join right_join full_join inner_join semi_join anti_join
#' @importFrom dplyr mutate select filter arrange bind_rows bind_cols group_by pull
#' @importFrom dplyr mutate select filter arrange bind_rows bind_cols group_by pull slice data_frame row_number
#' @keywords internal #' @keywords internal
"_PACKAGE" "_PACKAGE"

Loading…
Cancel
Save