R语言augment函数报错：变量长度需为25/1而非32问题求助

错误信息 #

运行分组后的tibble调用bpa函数时出现如下错误：

Error in `dplyr::mutate()`:
! Problem while computing `p = bootstrap_p_vec(.x = y)`.
✖ `p` must be size 25 or 1, not 32.
ℹ The error occurred in group 1: sim_number = 1.
Run `rlang::last_error()` to see where the error occurred.

错误回溯：

> rlang::last_error()
<error/dplyr:::mutate_error>
Error in `dplyr::mutate()`:
! Problem while computing `p = bootstrap_p_vec(.x = y)`.
✖ `p` must be size 25 or 1, not 32.
ℹ The error occurred in group 1: sim_number = 1.
---
Backtrace:
 1. ... %>% bpa(.value = y)
 2. global bpa(., .value = y)
 5. dplyr:::mutate.data.frame(.data, !!!calls)
Run `rlang::last_trace()` to see the full context.
> rlang::last_trace()
<error/dplyr:::mutate_error>
Error in `dplyr::mutate()`:
! Problem while computing `p = bootstrap_p_vec(.x = y)`.
✖ `p` must be size 25 or 1, not 32.
ℹ The error occurred in group 1: sim_number = 1.
---
Backtrace:
     ▆
  1. ├─... %>% bpa(.value = y)
 2. ├─global bpa(., .value = y)
 3. │ ├─tibble::as_tibble(dplyr::mutate(.data, !!!calls))
 4. │ ├─dplyr::mutate(.data, !!!calls)
 5. │ └─dplyr:::mutate.data.frame(.data, !!!calls)
 6. │   └─dplyr:::mutate_cols(.data, dplyr_quosures(...), caller_env = caller_env())
 7. │     ├─base::withCallingHandlers(...)
 8. │     └─mask$eval_all_mutate(quo)
 9. ├─dplyr:::dplyr_internal_error(...)
 10. │ └─rlang::abort(class = c(class, "dplyr:::internal_error"), dplyr_error_data = data)
 11. │   └─rlang:::signal_abort(cnd, .file)
 12. │     └─base::signalCondition(cnd)
 13. └─dplyr (local) `<fn>`(`<dpl:::__>`)
 14.   └─rlang::abort(...)

涉及函数代码 #

向量函数bootstrap_p_vec #

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)
  
}

Augment函数bpa #

bpa <- 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)
}

测试情况 #

• 单独测试bootstrap_p_vec时结果正常：

library(tidyverse)

x <- mtcars$mpg

> bootstrap_p_vec(x)
 [1] 0.62500 0.62500 0.78125 0.68750 0.46875 0.43750 0.12500 0.81250 0.78125
[10] 0.53125 0.40625 0.34375 0.37500 0.25000 0.06250 0.06250 0.15625 0.96875
[19] 0.93750 1.00000 0.71875 0.28125 0.25000 0.09375 0.53125 0.87500 0.84375
[28] 0.93750 0.31250 0.56250 0.18750 0.68750

• 报错调用代码：

tidy_bootstrap(x, .num_sims = 1) %>%
  bootstrap_unnest_tbl() %>%
  group_by(sim_number) %>%
  bpa(.value = y)

当tidy_bootstrap()的.proportion设为1时，bpa可正常运行；设为80%得到长度25的y列时，报错返回长度32。

问题根源 #

bootstrap_p_vec函数存在致命错误：函数内用x_term <- x引用了全局变量x，而非传入的参数.x。单独测试时全局变量x是mtcars$mpg（长度32），所以返回32个值正常；但在分组后的tibble中调用时，传入的是分组后的y列（长度25），但函数仍使用全局x计算，返回32个值，和当前分组的25行不匹配，触发dplyr的长度检查错误。

修复方案 #

修改bootstrap_p_vec函数，将x_term <- x改为x_term <- .x，同时把后续的is.numeric(x)也改成is.numeric(x_term)，确保所有引用都是传入的参数：

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

修改后重新运行报错的调用代码，即可正常为分组后的tibble添加p列。

内容的提问来源于stack exchange，提问作者MCP_infiltrator