Moyenne géométrique: y a-t-il un intégré?

106

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

(De toute évidence, un intégré ne me fera pas gagner de temps lorsque je travaille dans le shell, et je ne soupçonne pas non plus qu'il y ait une différence de précision; pour les scripts, j'essaie d'utiliser des intégrés aussi souvent que possible, où le (cumulatif) le gain de performances est souvent perceptible.

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

gm_mean = function(a){prod(a)^(1/length(a))}
doug
la source
11
Attention aux nombres négatifs et aux débordements. prod (a) sous ou débordera très rapidement. J'ai essayé de chronométrer cela en utilisant une grande liste et j'ai rapidement obtenu Inf en utilisant votre méthode contre 1,4 avec exp (mean (log (x))); le problème d'arrondi peut être assez grave.
Tristan
Je viens d'écrire la fonction ci-dessus rapidement parce que j'étais sûr que 5 minutes après la publication de ce Q, quelqu'un me dirait le intégré de R pour gm. Donc, pas de intégré, donc cela vaut la peine de prendre le temps de recoder à la lumière de vos remarques. + 1 de ma part.
doug
1
Je viens de taguer cette moyenne géométrique et intégrée , 9 ans plus tard.
smci

Réponses:

78

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

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

Merci à @ ben-bolker pour avoir noté le na.rmpassage et @Gregor pour s'assurer qu'il fonctionne correctement.

Je pense que certains des commentaires sont liés à une fausse équivalence des NAvaleurs dans les données et des 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 length(x)différemment en cas de NAsuppression, voici 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 une valeur plus informative et plus appropriée en NaNce qui concerne le fait 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.

Paul McMurdie
la source
2
ne serait-il pas préférable de passer na.rmen argument (c'est-à-dire de laisser l'utilisateur décider s'il veut être tolérant à NA ou non, par souci de cohérence avec les autres fonctions de résumé R)? Je suis nerveux à l'idée d'exclure automatiquement les zéros - j'en ferais également une option.
Ben Bolker
1
Peut-être avez-vous raison de passer na.rmcomme une option. Je mettrai à jour ma réponse. Quant à l'exclusion des zéros, la moyenne géométrique n'est pas définie pour les valeurs non positives, y compris les zéros. Ce qui précède est une solution courante pour la moyenne géométrique, dans laquelle les zéros (ou dans ce cas tous les non-zéros) reçoivent une valeur fictive de 1, ce qui n'a aucun effet sur le produit (ou, de manière équivalente, zéro dans la somme logarithmique).
Paul McMurdie
* Je voulais dire un correctif commun pour les valeurs non positives, zéro étant le plus courant lorsque la moyenne géométrique est utilisée.
Paul McMurdie
1
Votre na.rmpass-through ne fonctionne pas comme codé ... voyez gm_mean(c(1:3, NA), na.rm = T). Vous devez supprimer le & !is.na(x)du sous-ensemble vectoriel, et comme le premier argument de sumest ..., vous devez passer na.rm = na.rmpar nom, et vous devez également exclure 0les et NAdu vecteur dans l' lengthappel.
Gregor Thomas
2
Attention: pour xne contenir que zéro (s), comme x <- 0, exp(sum(log(x[x>0]), na.rm = TRUE)/length(x))donne 1la moyenne géométrique, ce qui n'a pas de sens.
adatum le
88

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

Une autre possibilité est d'utiliser ceci:

exp(mean(log(x)))
Mark Byers
la source
Un autre avantage de l'utilisation de exp (mean (log (x))) est que vous pouvez travailler avec de longues listes de grands nombres, ce qui est problématique lorsque vous utilisez la formule la plus évidente utilisant prod (). Notez que prod (a) ^ (1 / length (a)) et exp (mean (log (a))) donnent la même réponse.
lukeholman
le lien a été corrigé
PatrickT
15

Nous pouvons utiliser le package psych et appeler la fonction géométrique.mean .

AliCivil
la source
1
psych::geometric.mean()
smci
Ces fonctions devraient prendre la série et non leur croissance, du moins en option, je dirais.
Christoph Hanck
12

le

exp(mean(log(x)))

fonctionnera sauf s'il y a un 0 dans x. Si tel est le cas, le journal produira -Inf (-Infinite) qui aboutit 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 pour ce faire, mais cela signifie calculer le journal deux fois, ce qui est inefficace.

exp(mean(log(i[is.finite(log(i))])))
Alan James Salmoni
la source
pourquoi calculer le journal deux fois lorsque vous pouvez faire: exp (mean (x [x! = 0]))
zzk
les deux approches obtiennent une mauvaise moyenne, car le dénominateur de la moyenne sum(x) / length(x)est faux si vous filtrez x puis le passez à mean.
Paul McMurdie
Je pense que le filtrage est une mauvaise idée à moins que vous ne vouliez explicitement le faire (par exemple, si j'écrivais une fonction à usage général, je ne ferais pas de filtrage la valeur par défaut) - OK s'il s'agit d'un morceau de code unique et que vous réfléchi très attentivement à ce que le filtrage des zéros signifie réellement dans le contexte de votre problème (!)
Ben Bolker
Par définition, une moyenne géométrique d'un ensemble de nombres contenant zéro devrait être zéro! math.stackexchange.com/a/91445/221143
Chris
6

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

exp(tapply(log(data$value), data$group, mean))
TMS
la source
3

Cette version offre plus d'options que les autres réponses.

  • Il permet à l'utilisateur de faire la distinction entre les résultats qui ne sont pas des nombres (réels) et ceux qui ne sont pas disponibles. Si des nombres négatifs sont présents, la réponse ne sera pas un nombre réel, elle NaNest donc renvoyée. S'il s'agit de toutes les NAvaleurs, la fonction retournera à la NA_real_place pour indiquer qu'une valeur réelle n'est littéralement pas disponible. Il s'agit d'une différence subtile, mais qui pourrait donner des résultats (légèrement) plus robustes.

  • Le premier paramètre facultatif zero.rmest destiné à permettre à l'utilisateur d'avoir des zéros affectant la sortie sans la rendre nulle. Si zero.rmest défini sur FALSEet etaest défini sur NA_real_(sa valeur par défaut), les zéros ont pour effet de réduire le résultat vers un. Je n'ai aucune justification théorique pour cela - il semble juste plus logique de ne pas ignorer les zéros mais de "faire quelque chose" qui n'implique pas de rendre automatiquement le résultat nul.

  • etaest une façon de gérer les zéros qui a été inspirée par la discussion suivante: 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)
}
Chris Coffee
la source
1
Pouvez-vous ajouter quelques détails expliquant en quoi cela diffère / améliore les solutions existantes? ( dplyr
Personnellement,
Je suis d'accord, les case_whens étaient un peu ridicules, alors je les ai supprimés et la dépendance en faveur de l' ifart. J'ai également fourni quelques précisions.
Chris Coffee le
1
Je suis allé avec votre dernière idée et a changé la valeur par défaut nan.rmpour TRUEaligner les trois `` `paramètres .rm``.
Chris Coffee le
1
Un autre pinaillage stylistique. ifelseest conçu pour la vectorisation. Avec une seule condition à vérifier, il serait plus idiomatique à utiliservalue.count <- if(zero.rm) sum(x[!is.na(x)] > 0) else sum(!is.na(x))
Gregor Thomas
Ça a l'air plus beau que ça ifelseaussi. Modifié. Merci!
Chris Coffee le
3

Au cas où il y aurait des valeurs manquantes dans vos données, ce n'est pas un cas rare. vous devez ajouter un argument supplémentaire.

Vous pouvez essayer le code suivant:

exp(mean(log(i[ is.finite(log(i)) ]), na.rm = TRUE))
Tian Yi
la source
1
exp(mean(log(x1))) == prod(x1)^(1/length(x1))
user12882764
la source