Среднее геометрическое: есть ли встроенное? - PullRequest
89 голосов
/ 08 апреля 2010

Я пытался найти встроенное для среднего геометрического, но не смог.

(Очевидно, что встроенная функция не спасет меня ни разу при работе в оболочке, и я не подозреваю, что есть разница в точности; для сценариев я стараюсь использовать встроенные функции как можно чаще, где (совокупный) прирост производительности часто заметен.

В случае, если его нет (что я сомневаюсь в этом), вот мой.

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

Ответы [ 8 ]

77 голосов
/ 08 апреля 2010

Нет, но есть несколько человек, которые написали один, например, здесь .

Другая возможность заключается в использовании этого:

exp(mean(log(x)))
60 голосов
/ 28 августа 2014

Вот векторизованная, нулевая и NA-толерантная функция для вычисления среднего геометрического в R. Подробное mean вычисление, включающее length(x), необходимо для случаев, когда x содержит неположительные значения.

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

Спасибо @ ben-bolker за отметку na.rm pass-through и @Gregor за то, что он работает правильно.

Я думаю, что некоторые комментарии связаны с ложной эквивалентностьюNA значений в данных и нулях.В приложении, которое я имел в виду, они одинаковы, но, конечно, это не совсем так.Таким образом, если вы хотите включить необязательное распространение нулей и трактовать length(x) по-разному в случае удаления NA, ниже приведена несколько более длинная альтернатива указанной выше функции.

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

Примечаниечто он также проверяет наличие любых отрицательных значений и возвращает более информативный и соответствующий NaN, учитывая, что геометрическое среднее не определено для отрицательных значений (но для нулей).Спасибо комментаторам, которые остались в моем случае по этому поводу.

12 голосов
/ 12 февраля 2013

exp(mean(log(x)))

будет работать, если в х нет 0. Если это так, журнал выдаст -Inf (-Infinite), что всегда приводит к среднему геометрическому значению 0.

Одним из решений является удаление значения -Inf перед вычислением среднего значения:

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

Вы можете использовать для этого однострочник, но это означает, что вычислять журнал дважды, что неэффективно.

exp(mean(log(i[is.finite(log(i))])))
11 голосов
/ 08 декабря 2012

вы можете использовать psych пакет и вызывать функцию geometric.mean в этом.

6 голосов
/ 31 октября 2012

Я использую именно то, что говорит Марк. Таким образом, даже с tapply, вы можете использовать встроенную функцию mean, не нужно определять вашу! Например, чтобы вычислить геометрические средние значения данных для каждой группы $ value:

exp(tapply(log(data$value), data$group, mean))
3 голосов
/ 10 февраля 2014

Если в ваших данных отсутствуют значения, это не редкий случай. вам нужно добавить еще один аргумент. Вы можете попробовать следующие коды.

exp(mean(log(i[is.finite(log(i))]),na.rm=T))
2 голосов
/ 28 мая 2018

Пакет EnvStats имеет функцию для geoMean и geoSd

0 голосов
/ 24 июня 2019

Вот моя версия. Он имеет следующие особенности, которые отличают его от принятого в настоящее время ответа Пола МакМерди:

  1. Когда значения na.rm == TRUE, NA игнорируются в знаменателе - следовательно, в знаменателе используется переменная подсчета не пропущенных значений values.count вместо length(x).
  2. Опционально различает NaN и общие NA значения, с параметром .rm для каждого. По умолчанию NaN s "плохие", так же как отрицательные числа плохие, поэтому возвращается NaN. Наличие двух параметров для обработки пропущенных значений, очевидно, не является идеальным, но способ, которым я установил значения по умолчанию для этих параметров и упорядочил регистры в операторе case_when, должен (мы надеемся) устранить возможность неожиданного поведения.
  3. Моя версия включает в себя еще один необязательный параметр eta, который обрабатывает нули. eta по умолчанию NA_real_, и в этом случае нули подсчитываются в знаменателе, но не распространяются (аналог необязательного параметра zero.propagate = FALSE в принятом ответе). Когда передается положительное число, eta функционирует как искусственная константа, добавляемая к x (но только в том случае, если x содержит нули). Когда передается любое другое число (предположительно 0), нули распространяются так же, как когда zero.propagate установлено равным TRUE в принятом ответе.

Я уверен, что могут потребоваться настройки (например, лучше добавить eta (учитывая, что eta - положительное число), независимо от того, есть нули или нет). Я думал даже о том, чтобы функция динамически выбирала значение для eta на основе x, но решила не добавлять дополнительную сложность.

suppressMessages(library(dplyr))

geomean <- function(x, na.rm = TRUE, nan.rm = FALSE, eta = NA_real_) {
  nan.count <- is.nan(x) %>%
    sum()
  na.count <- is.na(x) %>%
    sum()
  value.count <- !is.na(x) %>%
    sum()
  case_when(
    #Handle cases when there are negative values, all values are missing, or
    #missing values are not tolerated.
    (nan.count > 0 & !nan.rm) | any(x < 0, na.rm = TRUE) ~ NaN,
    (na.count > 0 & !na.rm) | value.count == 0 ~ 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.
    all(x > 0, na.rm = TRUE) ~ exp(mean(log(x), na.rm = TRUE)),
    all(x == 0, na.rm = TRUE) ~ 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.
    is.na(eta) ~ exp(sum(log(x[x > 0]), na.rm = TRUE) / value.count),
    eta > 0 ~ exp(mean(log(x + eta), na.rm = TRUE)) - eta,
    TRUE ~ 0 #only propagate zeroes when eta is set to 0 (or less than 0)
  )
}
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...