r - 几何平均值：有内置的吗？

Question

我试图找到几何平均值的内置函数，但找不到。

（显然，在 shell 中工作时，内置不会为我节省任何时间，我也不怀疑准确性有任何差异；对于脚本，我尝试尽可能多地使用内置，其中（累积）性能提升通常很明显。

如果没有一个（我怀疑是这种情况），这是我的。

gm_mean = function(a){prod(a)^(1/length(a))}

Answer 1

没有，但是有几个人写过一篇，比如这里。

另一种可能性是使用这个：

exp(mean(log(x)))

Answer 2

这是一个矢量化、零和 NA 容错函数，用于计算 R 中的几何平均值。对于包含非正值的情况，mean涉及的详细计算是必要的。length(x)x

gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}

感谢@ben-bolker 注意到na.rm传递和@Gregor 确保它正常工作。

我认为一些评论与NA数据和零值的错误等价有关。在我想到的应用程序中，它们是相同的，但当然这通常不是真的。因此，如果您想包括零的可选传播，并length(x)在删除的情况下区别对待NA，以下是上述函数的稍长替代方案。

gm_mean = function(x, na.rm=TRUE, zero.propagate = FALSE){
  if(any(x < 0, na.rm = TRUE)){
    return(NaN)
  }
  if(zero.propagate){
    if(any(x == 0, na.rm = TRUE)){
      return(0)
    }
    exp(mean(log(x), na.rm = na.rm))
  } else {
    exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
  }
}

请注意，它还检查是否有任何负值，并返回更多信息和适当的NaN尊重几何平均值未定义为负值（但为零）。感谢评论者留在我的案子上。

Answer 3

我们可以使用psych 包并调用geometry.mean函数。

Answer 4

这

exp(mean(log(x)))

除非 x 中有 0，否则将起作用。如果是这样，日志将产生 -Inf (-Infinite)，它总是导致几何平均值为 0。

一种解决方案是在计算平均值之前删除 -Inf 值：

geo_mean <- function(data) {
    log_data <- log(data)
    gm <- exp(mean(log_data[is.finite(log_data)]))
    return(gm)
}

您可以使用单线来执行此操作，但这意味着计算日志两次，效率低下。

exp(mean(log(i[is.finite(log(i))])))

Answer 5

我完全使用马克所说的。这样，即使有了tapply，您也可以使用内置mean功能，无需定义您的！例如，要计算 data$value 的每组几何平均值：

exp(tapply(log(data$value), data$group, mean))

Answer 6

EnvStats包具有geoMean和geoSd的功能。

Answer 7

如果您的数据中存在缺失值，这种情况并不少见。您需要再添加一个参数。

您可以尝试以下代码：

exp(mean(log(i[ is.finite(log(i)) ]), na.rm = TRUE))

Answer 8

这个版本提供了比其他答案更多的选项。

• 它允许用户区分不是（实）数字的结果和不可用的结果。如果存在负数，则答案将不是实数，因此NaN返回。如果它是所有NA值，则该函数将返回NA_real_以反映实际值实际上是不可用的。这是一个微妙的差异，但可能会产生（稍微）更稳健的结果。

• 第一个可选参数zero.rm旨在允许用户让零影响输出而不使其为零。如果zero.rm设置为FALSE并eta设置为NA_real_（其默认值），则零具有将结果缩小为 1 的效果。我对此没有任何理论上的理由 - 不忽略零似乎更有意义，而是“做一些不涉及自动使结果为零的事情”。

• eta是一种受以下讨论启发的处理零的方法：https: //support.bioconductor.org/p/64014/

geomean <- function(x,
                    zero.rm = TRUE,
                    na.rm = TRUE,
                    nan.rm = TRUE,
                    eta = NA_real_) {
    nan.count <- sum(is.nan(x))
     na.count <- sum(is.na(x))
  value.count <- if(zero.rm) sum(x[!is.na(x)] > 0) else sum(!is.na(x))

  #Handle cases when there are negative values, all values are missing, or
  #missing values are not tolerated.
  if ((nan.count > 0 & !nan.rm) | any(x < 0, na.rm = TRUE)) {
    return(NaN)
  }
  if ((na.count > 0 & !na.rm) | value.count == 0) {
    return(NA_real_)
  }

  #Handle cases when non-missing values are either all positive or all zero.
  #In these cases the eta parameter is irrelevant and therefore ignored.
  if (all(x > 0, na.rm = TRUE)) {
    return(exp(mean(log(x), na.rm = TRUE)))
  }
  if (all(x == 0, na.rm = TRUE)) {
    return(0)
  }

  #All remaining cases are cases when there are a mix of positive and zero
  #values.
  #By default, we do not use an artificial constant or propagate zeros.
  if (is.na(eta)) {
    return(exp(sum(log(x[x > 0]), na.rm = TRUE) / value.count))
  }
  if (eta > 0) {
    return(exp(mean(log(x + eta), na.rm = TRUE)) - eta)
  }
  return(0) #only propagate zeroes when eta is set to 0 (or less than 0)
}

Answer 9

exp(mean(log(x1))) == prod(x1)^(1/length(x1))