Geometrisches Mittel: Gibt es ein eingebautes?

Ich habe versucht, ein eingebautes geometrisches Mittel zu finden, konnte es aber nicht.

(Offensichtlich spart mir ein eingebautes System keine Zeit, während ich in der Shell arbeite, und ich vermute auch nicht, dass es einen Unterschied in der Genauigkeit gibt. Bei Skripten versuche ich, eingebaute Elemente so oft wie möglich zu verwenden, wobei die (kumulativen) Leistungssteigerung ist oft spürbar.

Für den Fall, dass es keinen gibt (was ich bezweifle, ist der Fall), hier ist meiner.

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

Hier ist eine vektorisierte, null- und NA-tolerante Funktion zur Berechnung des geometrischen Mittelwerts in R. Die ausführliche meanBerechnung length(x)ist für die Fälle erforderlich, in denen xnicht positive Werte enthalten sind.

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

Vielen Dank an @ ben-bolker für das Notieren des na.rmDurchgangs und an @Gregor für das Sicherstellen, dass es korrekt funktioniert.

Ich denke, einige der Kommentare beziehen sich auf eine falsche Äquivalenz von NAWerten in den Daten und Nullen. In der Anwendung, an die ich gedacht hatte, sind sie gleich, aber das ist natürlich im Allgemeinen nicht wahr. Wenn Sie also die optionale Weitergabe von Nullen einschließen und diese beim Entfernen length(x)anders behandeln möchten NA, ist das Folgende eine etwas längere Alternative zu der obigen Funktion.

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

Beachten Sie, dass auch nach negativen Werten gesucht wird und eine aussagekräftigere und angemessenere Rückgabe erfolgt NaN, wobei zu berücksichtigen ist, dass das geometrische Mittel nicht für negative Werte definiert ist (sondern für Nullen). Vielen Dank an die Kommentatoren, die diesbezüglich in meinem Fall geblieben sind.

Nein, aber es gibt einige Leute, die eine geschrieben haben, wie hier .

Eine andere Möglichkeit ist, dies zu verwenden:

exp(mean(log(x)))

Wir können das psych-Paket verwenden und die Funktion geometric.mean aufrufen .

Das

exp(mean(log(x)))

funktioniert nur, wenn x eine 0 enthält. In diesem Fall erzeugt das Protokoll -Inf (-Infinite), was immer zu einem geometrischen Mittelwert von 0 führt.

Eine Lösung besteht darin, den -Inf-Wert vor der Berechnung des Mittelwerts zu entfernen:

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

Sie können dazu einen Einzeiler verwenden, dies bedeutet jedoch, dass das Protokoll zweimal berechnet wird, was ineffizient ist.

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

Ich benutze genau das, was Mark sagt. Auf diese Weise können Sie auch mit tapply die integrierte meanFunktion verwenden, ohne Ihre definieren zu müssen! Zum Beispiel, um geometrische Mittelwerte für Daten pro Gruppe zu berechnen $ value:

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

Diese Version bietet mehr Optionen als die anderen Antworten.

• Der Benutzer kann zwischen Ergebnissen, die keine (reellen) Zahlen sind, und Ergebnissen, die nicht verfügbar sind, unterscheiden. Wenn negative Zahlen vorhanden sind, ist die Antwort keine reelle Zahl und NaNwird zurückgegeben. Wenn es sich nur um NAWerte handelt, kehrt die Funktion zurück, NA_real_um anzuzeigen, dass ein realer Wert buchstäblich nicht verfügbar ist. Dies ist ein subtiler Unterschied, der jedoch zu (geringfügig) robusteren Ergebnissen führen kann.

• Der erste optionale Parameter zero.rmsoll es dem Benutzer ermöglichen, dass Nullen die Ausgabe beeinflussen, ohne sie auf Null zu setzen. Wenn zero.rmauf FALSEund etaauf NA_real_(sein Standardwert) gesetzt ist, haben Nullen den Effekt, dass das Ergebnis auf eins verkleinert wird. Ich habe keine theoretische Rechtfertigung dafür - es scheint nur sinnvoller zu sein, die Nullen nicht zu ignorieren, sondern "etwas zu tun", bei dem das Ergebnis nicht automatisch auf Null gesetzt wird.

• etaist eine Methode zum Umgang mit Nullen, die von der folgenden Diskussion inspiriert wurde: 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)
}

Das EnvStats-Paket verfügt über eine Funktion für geoMean und geoSd .

Falls in Ihren Daten Werte fehlen, ist dies kein seltener Fall. Sie müssen ein weiteres Argument hinzufügen.

Sie können folgenden Code versuchen:

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

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