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

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

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

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

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

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

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

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

exp(mean(log(x)))

Мы можем использовать психологический пакет и вызвать geometric.mean функции.

В

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

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

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

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

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

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

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

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

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

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