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

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

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

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

gm_mean = function(a){prod(a)^(1/length(a))}
Источник

7 ответов

Решение

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

Источник

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

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

exp(mean(log(x)))
Источник

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

Источник 

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))])))
Источник

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

exp(tapply(log(data$value), data$group, mean))
Источник

В пакете EnvStats есть функция для geoMean и geoSd

Источник

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

  • Это позволяет пользователю различать результаты, которые не являются (реальными) числами, и те, которые недоступны. Если присутствуют отрицательные числа, ответ не будет действительным числом, поэтому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)
}
Источник

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

exp(mean(log(i[is.finite(log(i))]),na.rm=T))
Источник 
exp(mean(log(x1))) == prod(x1)^(1/length(x1))
Источник
Другие вопросы по тегам