bootstrap_p_vec & augment

[spsanderson]

Augment Function:

bootstrap_p_augment <- function(.data, .value, .names = "auto"){
  
  column_expr <- rlang::enquo(.value)
  
  if(rlang::quo_is_missing(column_expr)){
    rlang::abort(
      message = "bootstrap_p_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_p_vec",
      .x = rlang::sym(col),
      .ns = "healthyR.ts"
    )
  }
  
  grid <- expand.grid(
    col                = col_nms
    , stringsAsFactors = FALSE
  )
  
  calls <- purrr::pmap(.l = list(grid$col), make_call)
  
  if(any(.names == "auto")){
    newname <- "p"
  } else {
    newname <- as.list(.names)
  }
  
  calls <- purrr::set_names(calls, newname)
  
  ret <- tibble::as_tibble(dplyr::mutate(.data, !!!calls))
  
  return(ret)
}

Example's:

> bootstrap_p_augment(tidy_bootstrap(x))
# A tibble: 50,000 × 3
   sim_number     y     p
   <fct>      <dbl> <dbl>
 1 1            180  0.76
 2 1            230  0.8 
 3 1            113  0.48
 4 1            335  1   
 5 1             62  0.12
 6 1            175  0.6 
 7 1            110  0.44
 8 1             66  0.2 
 9 1            180  0.76
10 1             95  0.28
# … with 49,990 more rows
# ℹ Use `print(n = ...)` to see more rows

Vectorized Function:

bootstrap_p_vec <- function(.x){
  
  x_term <- .x
  
  if (!is.numeric(x)){
    rlang::abort(
      message = "'.x' must be a numeric vector",
      use_cli_format = TRUE
      )
  }
  
  e <- stats::ecdf(x_term)
  
  ret <- e(x_term)
  
  return(ret)
  
}

Example:

> bootstrap_p_vec(x)
 [1] 0.43750 0.43750 0.21875 0.43750 0.68750 0.31250 0.93750 0.06250 0.25000
[10] 0.53125 0.53125 0.78125 0.78125 0.78125 0.81250 0.84375 0.87500 0.15625
[19] 0.03125 0.09375 0.28125 0.59375 0.59375 0.93750 0.68750 0.15625 0.18750
[28] 0.46875 0.96875 0.68750 1.00000 0.34375