web-dev-qa-db-fra.com

Moyenne géométrique: y a-t-il une fonction intégrée?

J'ai essayé de trouver une moyenne géométrique intégrée, mais je n'ai pas réussi.

(Évidemment, un intégré ne me fera pas gagner de temps tout en travaillant dans le shell, et je ne soupçonne pas qu'il y ait une différence de précision; pour les scripts, j'essaie d'utiliser les intégrés aussi souvent que possible, où le (cumulatif) le gain de performance est souvent perceptible.

Au cas où il n'y en aurait pas (ce dont je doute), voici le mien.

gm_mean = function(a){prod(a)^(1/length(a))}
rstatisticsbuilt-ingeometric-mean
91
doug

Voici une fonction vectorisée, tolérante à zéro et NA pour le calcul de la moyenne géométrique dans R. Le calcul détaillé mean impliquant length(x) est nécessaire pour les cas où x contient non -valeurs positives.

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

Merci à @ ben-bolker d'avoir noté le pass-through na.rm Et à @Gregor de s'assurer qu'il fonctionne correctement.

Je pense que certains des commentaires sont liés à une fausse équivalence des valeurs de NA dans les données et les zéros. Dans l'application que j'avais en tête, ce sont les mêmes, mais bien sûr ce n'est généralement pas vrai. Ainsi, si vous souhaitez inclure la propagation facultative des zéros et traiter la length(x) différemment dans le cas de la suppression de NA, ce qui suit est une alternative légèrement plus longue à la fonction ci-dessus.

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

Notez qu'il vérifie également les valeurs négatives et renvoie un NaN plus informatif et approprié en respectant que la moyenne géométrique n'est pas définie pour les valeurs négatives (mais pour les zéros). Merci aux commentateurs qui sont restés sur mon cas à ce sujet.

63
Paul McMurdie

Non, mais il y a quelques personnes qui en ont écrit un, comme ici .

Une autre possibilité consiste à utiliser ceci:

exp(mean(log(x)))
78
Mark Byers

Le

exp(mean(log(x)))

fonctionnera sauf s'il y a un 0 dans x. Si c'est le cas, le journal produira -Inf (-Infinite), ce qui donne toujours une moyenne géométrique de 0.

Une solution consiste à supprimer la valeur -Inf avant de calculer la moyenne:

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

Vous pouvez utiliser une ligne unique pour ce faire, mais cela signifie calculer le journal deux fois, ce qui est inefficace.

exp(mean(log(i[is.finite(log(i))])))
12
Alan James Salmoni

vous pouvez utiliser le package psych et appeler geometric.mean fonction en cela.

11
AliCivil

J'utilise exactement ce que dit Mark. De cette façon, même avec tapply, vous pouvez utiliser la fonction intégrée mean, pas besoin de définir la vôtre! Par exemple, pour calculer des moyennes géométriques par groupe de données $ value:

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

Dans le cas où il manque des valeurs dans vos données, ce n'est pas un cas rare. vous devez ajouter un argument supplémentaire. Vous pouvez essayer les codes suivants.

exp(mean(log(i[is.finite(log(i))]),na.rm=T))
3
Tian Yi

Le package EnvStats a une fonction pour geoMean et geoSd

2
PrinzvonK

Voici ma version. Il présente les caractéristiques suivantes qui le distinguent de la réponse actuellement acceptée par Paul McMurdie:

  1. Lorsque na.rm == TRUE, Les valeurs NA sont ignorées dans le dénominateur - d'où l'utilisation de valeurs non manquantes comptent la variable values.count Dans le dénominateur au lieu de length(x).
  2. Il distingue éventuellement entre les valeurs NaN et génériques NA, avec un paramètre .rm Pour chacune. Par défaut, NaNs sont "mauvais", tout comme les nombres négatifs sont mauvais, donc NaN est retourné. Avoir deux paramètres pour gérer les valeurs manquantes n'est évidemment pas idéal, mais la façon dont j'ai défini les valeurs par défaut pour ces paramètres et organisé les cas dans l'instruction case_when Devrait (espérons-le) éviter la possibilité d'un comportement inattendu.
  3. Ma version inclut un autre paramètre facultatif eta qui gère les zéros. eta par défaut à NA_real_, auquel cas les zéros sont comptés dans le dénominateur mais ne sont pas propagés (analogue au paramètre facultatif zero.propagate = FALSE dans la réponse acceptée). Lorsqu'un nombre positif est passé, eta fonctionne comme une constante artificielle à ajouter à x (mais uniquement dans le cas où x contient des zéros). Lorsqu'un autre nombre est passé (vraisemblablement 0), les zéros sont propagés, tout comme lorsque zero.propagate Est égal à TRUE dans la réponse acceptée.

Je suis sûr que des ajustements peuvent être nécessaires (par exemple, il peut être préférable d'ajouter eta (étant donné que eta est un nombre positif), qu'il y ait ou non des zéros). J'ai pensé même à la fonction de choisir dynamiquement une valeur pour eta basée sur x mais j'ai opté pour ne pas ajouter de complexité supplémentaire.

suppressMessages(library(dplyr))

geomean <- function(x, na.rm = TRUE, nan.rm = FALSE, eta = NA_real_) {
  nan.count <- is.nan(x) %>%
    sum()
  na.count <- is.na(x) %>%
    sum()
  value.count <- !is.na(x) %>%
    sum()
  case_when(
    #Handle cases when there are negative values, all values are missing, or
    #missing values are not tolerated.
    (nan.count > 0 & !nan.rm) | any(x < 0, na.rm = TRUE) ~ NaN,
    (na.count > 0 & !na.rm) | value.count == 0 ~ 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.
    all(x > 0, na.rm = TRUE) ~ exp(mean(log(x), na.rm = TRUE)),
    all(x == 0, na.rm = TRUE) ~ 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.
    is.na(eta) ~ exp(sum(log(x[x > 0]), na.rm = TRUE) / value.count),
    eta > 0 ~ exp(mean(log(x + eta), na.rm = TRUE)) - eta,
    TRUE ~ 0 #only propagate zeroes when eta is set to 0 (or less than 0)
  )
}
1
Chris Coffee