Media geométrica: ¿hay una función incorporada?

Intenté encontrar una media geométrica incorporada pero no pude.

(Obviamente, un integrado no me va a ahorrar tiempo mientras trabajo en el shell, ni sospecho que haya ninguna diferencia en la precisión; para los scripts, trato de usar los elementos integrados con la mayor frecuencia posible, donde el (acumulativo) El aumento de rendimiento suele ser notable.

En caso de que no haya uno (que dudo que sea el caso) aquí está el mío.

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

Aquí hay una función vectorizada, tolerante a cero y NA para calcular la media geométrica en R. El meancálculo detallado que involucra length(x)es necesario para los casos donde xcontiene valores no positivos.

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

Gracias a @ ben-bolker por señalar la na.rmtransferencia y a @Gregor por asegurarse de que funciona correctamente.

Creo que algunos de los comentarios están relacionados con una falsa equivalencia de NAvalores en los datos y ceros. En la aplicación que tenía en mente, son iguales, pero por supuesto, esto no es cierto en general. Por lo tanto, si desea incluir la propagación opcional de ceros y tratar la length(x)diferencia de manera diferente en el caso de la NAeliminación, la siguiente es una alternativa un poco más larga a la función anterior.

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

Tenga en cuenta que también comprueba los valores negativos y devuelve un valor más informativo y apropiado NaNrespetando que la media geométrica no está definida para valores negativos (pero sí para ceros). Gracias a los comentaristas que se quedaron en mi caso sobre esto.

No, pero hay algunas personas que han escrito uno, como aquí .

Otra posibilidad es usar esto:

exp(mean(log(x)))

Podemos usar el paquete psych y llamar a la función geometric.mean .

los

exp(mean(log(x)))

funcionará a menos que haya un 0 en x. Si es así, el registro producirá -Inf (-Infinite) que siempre resulta en una media geométrica de 0.

Una solución es eliminar el valor -Inf antes de calcular la media:

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

Puede usar una sola línea para hacer esto, pero significa calcular el registro dos veces, lo cual es ineficiente.

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

Utilizo exactamente lo que dice Mark. De esta manera, incluso con tapply, puede usar la meanfunción incorporada, ¡sin necesidad de definir la suya! Por ejemplo, para calcular medias geométricas por grupo de datos $ valor:

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

Esta versión ofrece más opciones que las otras respuestas.

• Permite al usuario distinguir entre resultados que no son números (reales) y aquellos que no están disponibles. Si hay números negativos, entonces la respuesta no será un número real, por lo que NaNse devuelve. Si son todos los NAvalores, la función volverá en su NA_real_lugar para reflejar que un valor real literalmente no está disponible. Esta es una diferencia sutil, pero una que podría producir resultados (ligeramente) más sólidos.

• El primer parámetro opcional zero.rmestá destinado a permitir que el usuario tenga ceros que afecten la salida sin convertirla en cero. Si zero.rmse establece en FALSEy etase establece en NA_real_(su valor predeterminado), los ceros tienen el efecto de reducir el resultado a uno. No tengo ninguna justificación teórica para esto, simplemente parece tener más sentido no ignorar los ceros sino "hacer algo" que no implique hacer automáticamente el resultado cero.

• etaes una forma de manejar ceros que se inspiró en la siguiente discusión: 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)
}

El paquete EnvStats tiene una función para geoMean y geoSd .

En caso de que falten valores en sus datos, este no es un caso raro. necesitas agregar un argumento más.

Puede probar el siguiente código:

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

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