Избегайте предупреждений от ЛОЖНОЙ части ifelse()

Question

Я создал пользовательскую функцию, которая вычисляет поправку смещения Хеджеса для c () для g (Hedges, 1981). Это напрямую основано на metafor::.cmicalc() функция от library(metafor), Это делает это:

hedges_c <- function(df) {
  return(exp(lgamma(df / 2) - log(sqrt(df / 2)) - lgamma((df - 1)/2)))
}

При применении к вектору, содержащему значения <= 1, lgamma() генерирует предупреждение, потому что lgamma(0) (а также любое отрицательное значение) генерирует NaN, Итак, мое решение (а также то, что metafor::.cmicalc() делает) в том числе ifelse() заявление:

hedges_c <- function(df) {
  cdf <- ifelse(df <= 1, 
                NA,
                exp(lgamma(df / 2) - log(sqrt(df / 2)) - lgamma((df - 1)/2)))
  return(cdf)
}

Но, и вот проблема, которую я, кажется, не могу найти, она все еще порождает warnings(), даже если все значения правильно отображаются как NA,

Пример:

hedges_c(c(0, 0, 20, 14, 0, 0, 0, 0))
#[1]      NA      NA 0.9619445 0.9452877      NA      NA      NA      NA
#Warning messages:
#1: In ifelse(df <= 1, NA, exp(lgamma(df/2) - log(sqrt(df/2)) - lgamma((df -  :
#  value out of range in 'lgamma'
#(...)

Я понимаю (например, из этого ответа), что третий (FALSE) аргумент ifelse() оценивается, даже когда условие TRUE (и наоборот, если я изменю порядок условия и аргументов)... Но я просто не знаю, как это решить (за исключением, может быть, сокрытия предупреждений до и после...).

(Примечание: я тоже пробовал dplyr::case_when(), но это точно такая же проблема.)

Answer 1

Я уверен, что значения рассчитываются независимо, и просто ifelse, Вы всегда можете просто применить свою функцию к действительным значениям и сделать остальные NA:

hedges_c <- function(df) {
  ss <- df >= 1

  hc <- function(x) exp(lgamma(x / 2) - log(sqrt(x / 2)) - lgamma((x - 1)/2))

  df[ss]  <- hc(df[ss])
  df[!ss] <- NA
  df
}

hedges_c(c(0, 0, 20, 14, 0, 0, 0, 0))
#[1]        NA        NA 0.9619445 0.9452877        NA        NA        NA        NA

Answer 2

Попробуйте использовать другой подход. Что-то вроде следующего.

hedges_c <- function(df) {
  cdf <- rep(NA, length(df))
  inx <- df > 1
  cdf[inx] <- exp(lgamma(df[inx] / 2) - log(sqrt(df[inx] / 2)) - lgamma((df[inx] - 1)/2))
  return(cdf)
}

hedges_c(c(0, 0, 20, 14, 0, 0, 0, 0))
#[1]        NA        NA 0.9619445 0.9452877        NA        NA        NA
#[8]        NA

И предупреждения ушли.