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

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

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.

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

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

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

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

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

Le package EnvStats a une fonction pour geoMean et geoSd .

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

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