-
Notifications
You must be signed in to change notification settings - Fork 1
/
augment-bootstrap-q.R
72 lines (62 loc) · 1.54 KB
/
augment-bootstrap-q.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
#' Augment Bootstrap Q
#'
#' @family Augment Function
#' @family Bootstrap
#'
#' @author Steven P. Sanderson II, MPH
#'
#' @description
#' Takes a numeric vector and will return the quantile.
#'
#' @details
#' Takes a numeric vector and will return the quantile of that vector.
#' This function is intended to be used on its own in order to add columns to a
#' tibble.
#'
#' @param .data The data being passed that will be augmented by the function.
#' @param .value This is passed [rlang::enquo()] to capture the vectors you want
#' to augment.
#' @param .names The default is "auto"
#'
#' @examples
#' x <- mtcars$mpg
#'
#' tidy_bootstrap(x) |>
#' bootstrap_unnest_tbl() |>
#' bootstrap_q_augment(y)
#'
#' @return
#' A augmented tibble
#'
#' @export
#'
bootstrap_q_augment <- function(.data, .value, .names = "auto") {
column_expr <- rlang::enquo(.value)
if (rlang::quo_is_missing(column_expr)) {
rlang::abort(
message = "bootstrap_q_vec(.value) is missing",
use_cli_format = TRUE
)
}
col_nms <- names(tidyselect::eval_select(rlang::enquo(.value), .data))
make_call <- function(col) {
rlang::call2(
"bootstrap_q_vec",
.x = rlang::sym(col),
.ns = "TidyDensity"
)
}
grid <- expand.grid(
col = col_nms,
stringsAsFactors = FALSE
)
calls <- purrr::pmap(.l = list(grid$col), make_call)
if (any(.names == "auto")) {
newname <- "q"
} else {
newname <- as.list(.names)
}
calls <- purrr::set_names(calls, newname)
ret <- dplyr::as_tibble(dplyr::mutate(.data, !!!calls))
return(ret)
}