Geometrisches Mittel: Gibt es ein eingebautes?

104

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))}
Doug
quelle
11
Vorsicht bei negativen Zahlen und Überläufen. Produkt (a) wird sehr schnell unter- oder überlaufen. Ich habe versucht, dies mit einer großen Liste zu messen und habe schnell Inf mit Ihrer Methode gegen 1.4 mit exp (mean (log (x))) erhalten. Das Rundungsproblem kann sehr schwerwiegend sein.
Tristan
Ich habe gerade die obige Funktion schnell geschrieben, weil ich mir sicher war, dass 5 Minuten nach dem Posten dieses Q mir jemand sagen würde, dass R für gm eingebaut ist. Es ist also kein eingebautes Gerät vorhanden. Es lohnt sich also, sich die Zeit zu nehmen, um im Lichte Ihrer Bemerkungen neu zu codieren. + 1 von mir.
Doug
1
Ich habe gerade diesen geometrischen Mittelwert markiert und 9 Jahre später eingebaut .
smci

Antworten:

76

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.

Paul McMurdie
quelle
2
Wäre es nicht besser, na.rmals Argument durchzugehen (dh den Benutzer entscheiden zu lassen, ob er NA-tolerant sein möchte oder nicht, um die Konsistenz mit anderen R-Zusammenfassungsfunktionen zu gewährleisten)? Ich bin nervös, Nullen automatisch auszuschließen - ich würde das auch zu einer Option machen.
Ben Bolker
1
Vielleicht haben Sie Recht, na.rmwenn Sie als Option bestehen. Ich werde meine Antwort aktualisieren. Was das Ausschließen von Nullen betrifft, ist das geometrische Mittel für nicht positive Werte, einschließlich Nullen, undefiniert. Das Obige ist eine übliche Korrektur für das geometrische Mittel, bei der Nullen (oder in diesem Fall alle Nicht-Nullen) einen Dummy-Wert von 1 erhalten, der keine Auswirkung auf das Produkt hat (oder äquivalent Null in der logarithmischen Summe).
Paul McMurdie
* Ich meinte eine allgemeine Korrektur für nicht positive Werte, wobei Null die häufigste ist, wenn der geometrische Mittelwert verwendet wird.
Paul McMurdie
1
Ihr na.rmPass-Through funktioniert nicht wie codiert ... siehe gm_mean(c(1:3, NA), na.rm = T). Sie müssen das & !is.na(x)aus der Vektor-Teilmenge entfernen , und da das erste Argument von sumist ..., müssen Sie den na.rm = na.rmNamen übergeben und Sie müssen auch 0's und NA' s aus dem Vektor im lengthAufruf ausschließen.
Gregor Thomas
2
Achtung: für xnur Null (en) enthält, wie x <- 0, exp(sum(log(x[x>0]), na.rm = TRUE)/length(x))gibt 1für das geometrische Mittel, die keinen Sinn machen.
Adatum
88

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

Eine andere Möglichkeit ist, dies zu verwenden:

exp(mean(log(x)))
Mark Byers
quelle
Ein weiterer Vorteil der Verwendung von exp (mean (log (x))) besteht darin, dass Sie mit langen Listen großer Zahlen arbeiten können. Dies ist problematisch, wenn Sie die offensichtlichere Formel mit prod () verwenden. Beachten Sie, dass prod (a) ^ (1 / Länge (a)) und exp (Mittelwert (log (a))) die gleiche Antwort geben.
Lukeholman
Der Link wurde behoben
PatrickT
15

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

AliCivil
quelle
1
psych::geometric.mean()
smci
Diese Funktionen sollten die Serie und nicht ihr Wachstum nehmen, zumindest als Option, würde ich sagen.
Christoph Hanck
12

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))])))
Alan James Salmoni
quelle
Warum das Protokoll zweimal berechnen, wenn Sie können: exp (Mittelwert (x [x! = 0]))
zzk
Bei beiden Ansätzen wird der Mittelwert falsch angegeben, da der Nenner für den Mittelwert sum(x) / length(x)falsch ist, wenn Sie x filtern und dann an übergeben mean.
Paul McMurdie
Ich denke, das Filtern ist eine schlechte Idee, es sei denn, Sie beabsichtigen dies ausdrücklich (z. B. wenn ich eine Allzweckfunktion schreibe, würde ich das Filtern nicht zum Standard machen) - OK, wenn dies ein einmaliger Code ist und Sie Ich habe mir sehr genau überlegt, was das Herausfiltern von Nullen im Kontext Ihres Problems (!) tatsächlich bedeutet
Ben Bolker
Per Definition sollte ein geometrisches Mittel einer Menge von Zahlen, die Null enthalten, Null sein! math.stackexchange.com/a/91445/221143
Chris
6

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))
TMS
quelle
3

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)
}
Chris Coffee
quelle
1
Können Sie einige Details hinzufügen, die erklären, wie sich dies von bestehenden Lösungen unterscheidet / diese verbessert? (Ich persönlich möchte keine starke Abhängigkeit wie dplyrfür ein solches Dienstprogramm hinzufügen, es sei denn, dies ist erforderlich ...)
Ben Bolker
Ich stimme zu, die case_whens waren ein wenig albern, also habe ich sie und die Abhängigkeit zugunsten von ifs entfernt. Ich habe auch einige Ausarbeitungen gemacht.
Chris Coffee
1
Ich ging mit dem letztere Idee und verändern die Standardeinstellung nan.rmauf TRUEauszurichten alle drei `` `.rm`` Parameter.
Chris Coffee
1
Ein weiterer stilistischer Trottel. ifelseist für die Vektorisierung ausgelegt. Mit einer einzigen zu überprüfenden Bedingung wäre die Verwendung idiomatischervalue.count <- if(zero.rm) sum(x[!is.na(x)] > 0) else sum(!is.na(x))
Gregor Thomas
Es sieht auch besser aus als ifelse. Geändert. Vielen Dank!
Chris Coffee
3

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))
Tian Yi
quelle
1
exp(mean(log(x1))) == prod(x1)^(1/length(x1))
user12882764
quelle