-
Notifications
You must be signed in to change notification settings - Fork 2
/
id.R
85 lines (75 loc) · 2.35 KB
/
id.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
#' Add id column and key
#'
#' Functions for creating id column and key.
#'
#' @param .tbl Reference data frame.
#' @param x Character vector of names.
#' @param .add,.exclude Parameters for [key_by()].
#'
#' @details `use_id()` [assigns][keys-set] as keys a tibble with column '.id'
#' and row numbers of `.tbl` as values.
#'
#' `compute_id_name()` computes the name which is different from every
#' element in `x` by the following algorithm: if '.id' is not present in `x` it
#' is returned; if taken - '.id1' is checked; if taken - '.id11' is checked and
#' so on.
#'
#' `add_id()` creates a column with unique name (computed with
#' `compute_id_name()`) and row numbers as values (grouping is ignored). After
#' that puts it as first column.
#'
#' `key_by_id()` is similar to `add_id()`: it creates a column with unique name
#' and row numbers as values (grouping is ignored) and calls [key_by()] function
#' to use this column as key. If `.add` is `FALSE` unique name is computed based
#' on `.tbl` column names; if `TRUE` then based on `.tbl` and its keys column
#' names.
#'
#' @examples
#' mtcars %>% use_id()
#'
#' mtcars %>% add_id()
#'
#' mtcars %>% key_by_id(.exclude = TRUE)
#'
#' @name keyholder-id
NULL
#' @rdname keyholder-id
#' @export
use_id <- function(.tbl) {
assign_keys(.tbl, tibble(.id = seq_len(nrow(.tbl))))
}
#' @rdname keyholder-id
#' @export
compute_id_name <- function(x) {
is_id <- grepl(pattern = "^\\.id[1]*$", x = as.character(x))
if (sum(is_id) == 0) {
return(".id")
} else {
n_ones <- nchar(x[is_id]) - 3
marker <- c(rep(TRUE, (max(n_ones) + 1)), TRUE)
marker[n_ones + 1] <- FALSE
id_extra <- paste0(rep("1", which(marker)[1] - 1), collapse = "")
return(paste0(".id", id_extra))
}
}
#' @rdname keyholder-id
#' @export
add_id <- function(.tbl) {
id_name <- compute_id_name(names(.tbl))
.tbl[[id_name]] <- seq_len(nrow(.tbl))
.tbl <- select(.tbl, !! rlang::sym(id_name), everything())
.tbl
}
#' @rdname keyholder-id
#' @export
key_by_id <- function(.tbl, .add = FALSE, .exclude = FALSE) {
if (.add) {
id_name <- compute_id_name(c(colnames(.tbl), colnames(keys(.tbl))))
} else {
id_name <- compute_id_name(colnames(.tbl))
}
.tbl[[id_name]] <- seq_len(nrow(.tbl))
.tbl <- select(.tbl, !! rlang::sym(id_name), everything())
.tbl %>%
key_by(!! rlang::sym(id_name), .add = .add, .exclude = .exclude)
}