如何处理Vectorise包装的phi2poly函数因NA产生的无关警告？

我在对psych::phi2poly使用Vectorize函数后，通过ifelse选择输出中的特定值。但phi2poly遇到NA时会触发警告，而这些警告并无意义——因为ifelse本就不需要调用phi2poly就能处理NA。我不想抑制phi2poly的所有警告（怕掩盖其他真实问题），有没有简洁的处理方式？

原示例代码（MWE） #

library(psych)

r_biserial <- function(p, r_pb) {
  # Jacobs' formula, r_b = sqrt(pq)/f(z_p) . r_pb:
  sqrt(p * (1-p)) / dnorm(qnorm(p)) * r_pb
}

r_tetrachoric <- function(a, b, phi) {
  # 这会触发大量警告
  Vectorize(phi2poly)(a, b, phi)

  # 这个方法能消除警告，但完全是投机取巧的 hack
  # Vectorize(phi2poly)(
  #   a |> replace_na(0.5),
  #   b |> replace_na(0.5),
  #   phi |> replace_na(0.5))
}

adjust_correlation <- function(p, q, cor) {
  ifelse(is.na(p), 
         ifelse(is.na(q), 
                cor, 
                r_biserial(q, cor)), 
         ifelse(is.na(q),
                r_biserial(p, cor), 
                r_tetrachoric(p, q, cor)))
}

adjust_correlation(
  c(NA, NA, 0.5, 0.5),
  c(NA, 0.6, NA, 0.6),
  c(0.3, 0.3, 0.3, 0.3)
)

解决方案 #

核心思路是只在无NA的有效数据上调用phi2poly，避免NA传入函数触发不必要的警告；同时用case_when替代嵌套ifelse，让条件逻辑更清晰可读。

修改后的最终代码 #

library(psych)
library(dplyr) # 需要dplyr包提供case_when函数

r_biserial <- function(p, r_pb) {
  sqrt(p * (1-p)) / dnorm(qnorm(p)) * r_pb
}

r_tetrachoric <- function(a, b, phi) {
  # 筛选出a、b均不为NA的有效索引
  call_idx <- !is.na(a) & !is.na(b)
  
  # 初始化结果向量为NA
  result <- rep(NA_real_, length(a)) 
  # 仅对有效数据调用phi2poly
  result[call_idx] <- Vectorize(phi2poly)(phi[call_idx], a[call_idx], b[call_idx])
  result
}

adjust_correlation <- function(p, q, cor) {
  case_when(
    is.na(p) & is.na(q)   ~ cor,
    is.na(p) & !is.na(q)  ~ r_biserial(q, cor),
    !is.na(p) & is.na(q)  ~ r_biserial(p, cor),
    !is.na(p) & !is.na(q) ~ r_tetrachoric(p, q, cor)
  )
}

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