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
|
#' Combine levels from two or more factors to create a new factor
#'
#' Computes a factor whose levels are all the combinations of the levels of the input factors.
#'
#' @param ... <[`dynamic-dots`][rlang::dyn-dots]> Additional factors
#' or character vectors.
#' @param sep A character string to separate the levels
#' @param keep_empty If TRUE, keep combinations with no observations as levels
#' @return The new factor
#'
#' @export
#' @examples
#' fruit <- factor(c("apple", "kiwi", "apple", "apple"))
#' colour <- factor(c("green", "green", "red", "green"))
#' eaten <- c("yes", "no", "yes", "no")
#' fct_cross(fruit, colour)
#' fct_cross(fruit, colour, eaten)
#' fct_cross(fruit, colour, keep_empty = TRUE)
fct_cross <- function(..., sep = ":", keep_empty = FALSE) {
check_dots_unnamed()
check_string(sep, allow_empty = TRUE)
check_bool(keep_empty)
flist <- list2(...)
if (length(flist) == 0) {
return(factor())
}
.data <- tibble::as_tibble(flist, .name_repair = "minimal")
.data <- lapply(.data, check_factor)
newf <- exec(paste, !!!.data, sep = sep)
old_levels <- lapply(.data, levels)
grid <- exec(expand.grid, old_levels)
new_levels <- exec(paste, !!!grid, sep = sep)
if (!keep_empty) {
new_levels <- intersect(new_levels, newf)
}
factor(newf, levels = new_levels)
}
|
