Среднее геометрическое: есть ли встроенный?


106

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

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

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

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

11
Будьте осторожны с отрицательными числами и переполнениями. prod (a) очень быстро опустится или переполнится. Я попытался рассчитать время, используя большой список, и быстро получил Inf, используя ваш метод по сравнению с 1.4 с exp (mean (log (x))); проблема округления может быть довольно серьезной.
Тристан

Я просто быстро написал функцию выше, потому что был уверен, что через 5 минут после публикации этого Q кто-нибудь скажет мне, что R встроен для gm. Так что нет встроенного, поэтому определенно стоит потратить время на перекодировку в свете ваших замечаний. +1 от меня.
Дуг

1
Я только что пометил это среднее геометрическое и встроенное 9 лет спустя.
smci

Ответы:


79

Вот векторизованная, допускающая ноль и 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сквозной переход, и @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учитывая, что среднее геометрическое не определено для отрицательных значений (а предназначено для нулей). Спасибо комментаторам, которые остались в моем случае по этому поводу.


2
не было бы лучше передать na.rmв качестве аргумента (т.е. позволить пользователю решить, хотят ли они быть NA-толерантными или нет, для согласованности с другими сводными функциями R)? Я нервничаю по поводу автоматического исключения нулей - я бы тоже сделал это опцией.
Бен Болкер

1
Возможно, вы правы, говоря о передаче na.rmв качестве варианта. Я обновлю свой ответ. Что касается исключения нулей, среднее геометрическое не определено для неположительных значений, включая нули. Вышеупомянутое является обычным исправлением для среднего геометрического, в котором нулям (или в данном случае всем ненулевым) присваивается фиктивное значение 1, которое не влияет на продукт (или, что эквивалентно, ноль в логарифмической сумме).
Пол МакМерди

* Я имел в виду обычное исправление для неположительных значений, при этом ноль является наиболее распространенным при использовании среднего геометрического.
Пол Макмерди

1
Ваш na.rmсквозной канал работает не так, как закодировано ... понимаете gm_mean(c(1:3, NA), na.rm = T). Вам нужно удалить & !is.na(x)из подмножества векторов, и, поскольку первый аргумент sumравен ..., вам нужно передать na.rm = na.rmпо имени, и вам также нужно исключить 0и NAиз вектора в lengthвызове.
Грегор Томас

2
Осторожно: за xсодержащие только ноль (ы), как x <- 0, exp(sum(log(x[x>0]), na.rm = TRUE)/length(x))дает 1для среднего геометрического, который не имеет смысла.
adatum

88

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

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

exp(mean(log(x)))

Еще одно преимущество использования exp (mean (log (x))) заключается в том, что вы можете работать с длинными списками больших чисел, что проблематично при использовании более очевидной формулы с использованием prod (). Обратите внимание, что prod (a) ^ (1 / length (a)) и exp (mean (log (a))) дают одинаковый ответ.
lukeholman

ссылка исправлена
PatrickT


12

В

exp(mean(log(x)))

будет работать, если в 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))])))

зачем вычислять журнал дважды, если можно: exp (mean (x [x! = 0]))
zzk

1
оба подхода получают неправильное среднее значение, потому что знаменатель среднего значения sum(x) / length(x)неверен, если вы отфильтруете x, а затем передадите его в mean.
Пол МакМерди

Я думаю, что фильтрация - плохая идея, если вы явно не собираетесь это делать (например, если бы я писал функцию общего назначения, я бы не делал фильтрацию по умолчанию) - ОК, если это одноразовый фрагмент кода и вы очень тщательно подумал о том, что на самом деле означает фильтрация обнулений в контексте вашей проблемы (!)
Бен Болкер

По определению среднее геометрическое для набора чисел, содержащих ноль, должно быть равно нулю! math.stackexchange.com/a/91445/221143
Крис,

6

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

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

3

Эта версия предоставляет больше возможностей, чем другие ответы.

  • Это позволяет пользователю различать результаты, которые не являются (реальными) числами, и те, которые недоступны. Если присутствуют отрицательные числа, ответ не будет действительным числом, поэтому он NaNбудет возвращен. Если это все NAзначения, тогда функция вернется, NA_real_чтобы отразить, что реальное значение буквально недоступно. Это небольшое различие, но оно может дать (немного) более надежные результаты.

  • Первый необязательный параметр zero.rmпредназначен для того, чтобы позволить пользователю иметь нули, влияющие на вывод, не делая его нулевым. Если zero.rmустановлено FALSEи etaустановлено NA_real_(значение по умолчанию), нули приводят к уменьшению результата до единицы. У меня нет никакого теоретического обоснования для этого - просто кажется более разумным не игнорировать нули, а «сделать что-то», что не предполагает автоматического обнуления результата.

  • etaэто способ обработки нулей, вдохновленный следующим обсуждением: 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)
}

2
Не могли бы вы добавить некоторые детали, объясняющие, чем это отличается от существующих решений или улучшает их? (Я лично не хотел бы добавлять тяжелую зависимость, например, dplyrдля такой утилиты, если в этом нет необходимости ...)
Бен Болкер

Я согласен, case_whens были немного глупыми, поэтому я удалил их и зависимость в пользу ifs. Я также внес некоторые уточнения.
Chris Coffee,

1
Я поддержал вашу последнюю идею и изменил значение по умолчанию nan.rmна, TRUEчтобы выровнять все три параметра `` .rm``.
Chris Coffee,

1
Еще одна стилистическая придирка. ifelseпредназначен для векторизации. С единственным условием для проверки было бы более идиоматично использоватьvalue.count <- if(zero.rm) sum(x[!is.na(x)] > 0) else sum(!is.na(x))
Грегор Томас

Выглядит лучше, чем ifelseтоже. Изменено. Спасибо!
Chris Coffee,


3

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

Вы можете попробовать следующий код:

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

Используя наш сайт, вы подтверждаете, что прочитали и поняли нашу Политику в отношении файлов cookie и Политику конфиденциальности.
Licensed under cc by-sa 3.0 with attribution required.