bootstrap_q_vec & augment

[spsanderson]

Vectorized:

library(TidyDensity)
library(tidyverse)

x <- mtcars$mpg

tidy_empirical(x)

bootstrap_q_vec <- function(.x){
  
  x_term <- .x
  n <- length(x_term)
  
  if (!is.numeric(x)){
    rlang::abort(
      message = "'.x' must be a numeric vector",
      use_cli_format = TRUE
      )
  }
  
  ret <- unname(
    stats::quantile(x_term, probs = seq(0, 1, 1 / (n - 1)), type = 1)
  )
  
  return(ret)
}

> bootstrap_q_vec(x)
 [1] 10.4 10.4 13.3 14.3 14.7 15.0 15.2 15.2 15.5 15.8 16.4 17.3 17.8 18.1 18.7
[16] 19.2 19.2 19.7 21.0 21.0 21.4 21.4 21.5 22.8 22.8 24.4 26.0 27.3 30.4 30.4
[31] 32.4 33.9

Augment:

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 <- tibble::as_tibble(dplyr::mutate(.data, !!!calls))
  
  return(ret)
}

> tidy_bootstrap(x) %>%
+   bootstrap_unnest_tbl() %>%
+   group_by(sim_number) %>%
+   bootstrap_q_augment(y)
# A tibble: 50,000 × 3
   sim_number     y     q
   <fct>      <dbl> <dbl>
 1 1           18.1  13.3
 2 1           14.3  14.3
 3 1           18.7  14.3
 4 1           16.4  14.7
 5 1           14.7  15  
 6 1           21.5  16.4
 7 1           18.1  16.4
 8 1           19.7  17.8
 9 1           21    17.8
10 1           32.4  18.1
# … with 49,990 more rows
# ℹ Use `print(n = ...)` to see more rows