Media geometrica: c'è un built-in?

Ho provato a trovare un built-in per la media geometrica ma non ci sono riuscito.

(Ovviamente un built-in non mi farà risparmiare tempo mentre lavoro nella shell, né ho il sospetto che ci sia alcuna differenza in termini di accuratezza; per gli script cerco di utilizzare i built-in il più spesso possibile, dove il (cumulativo) il miglioramento delle prestazioni è spesso evidente.

Nel caso in cui non ce ne sia uno (che dubito sia il caso) ecco il mio.

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

Ecco una funzione vettorizzata, con tolleranza zero e NA per il calcolo della media geometrica in R. Il meancalcolo dettagliato che coinvolge length(x)è necessario per i casi in cui xcontiene valori non positivi.

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

Grazie a @ ben-bolker per aver notato il na.rmpassaggio e @Gregor per essersi assicurato che funzioni correttamente.

Penso che alcuni dei commenti siano correlati a una falsa equivalenza di NAvalori nei dati e negli zeri. Nell'applicazione avevo in mente che sono gli stessi, ma ovviamente questo non è generalmente vero. Pertanto, se si desidera includere la propagazione facoltativa degli zeri e trattare length(x)diversamente in caso di NArimozione, la seguente è un'alternativa leggermente più lunga alla funzione sopra.

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

Si noti che controlla anche eventuali valori negativi e restituisce un valore più informativo e appropriato NaNrispettando che la media geometrica non è definita per i valori negativi (ma è per gli zeri). Grazie ai commentatori che sono rimasti sul mio caso su questo.

No, ma ci sono alcune persone che ne hanno scritto uno, come qui .

Un'altra possibilità è usare questo:

exp(mean(log(x)))

Possiamo usare il pacchetto psych e chiamare la funzione geometric.mean .

Il

exp(mean(log(x)))

funzionerà a meno che non ci sia uno 0 in x. In tal caso, il log produrrà -Inf (-Infinite) che restituisce sempre una media geometrica pari a 0.

Una soluzione è rimuovere il valore -Inf prima di calcolare la media:

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

Puoi usare una riga per farlo, ma significa calcolare il registro due volte, il che è inefficiente.

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

Uso esattamente quello che dice Mark. In questo modo, anche con tapply, puoi utilizzare la meanfunzione integrata, senza bisogno di definire la tua! Ad esempio, per calcolare le medie geometriche dei dati $ value per gruppo:

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

Questa versione fornisce più opzioni rispetto alle altre risposte.

• Consente all'utente di distinguere tra risultati che non sono numeri (reali) e quelli che non sono disponibili. Se sono presenti numeri negativi, la risposta non sarà un numero reale, quindi NaNviene restituito. Se sono tutti NAvalori, la funzione restituirà NA_real_invece per riflettere che un valore reale non è letteralmente disponibile. Questa è una differenza sottile, ma potrebbe produrre risultati (leggermente) più robusti.

• Il primo parametro facoltativo ha lo zero.rmscopo di consentire all'utente di avere degli zeri sull'output senza renderlo zero. Se zero.rmè impostato su FALSEe etaè impostato su NA_real_(il suo valore predefinito), gli zeri hanno l'effetto di ridurre il risultato verso uno. Non ho alcuna giustificazione teorica per questo - sembra solo avere più senso non ignorare gli zeri ma "fare qualcosa" che non implichi l'azzeramento automatico del risultato.

• etaè un modo di gestire gli zeri che è stato ispirato dalla seguente discussione: 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)
}

Il pacchetto EnvStats ha una funzione per geoMean e geoSd .

Nel caso in cui ci siano valori mancanti nei dati, questo non è un caso raro. devi aggiungere un altro argomento.

Puoi provare a seguire il codice:

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

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