Геометричне середнє: чи є вбудований?

Я намагався знайти вбудований для геометричного середнього, але не міг.

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

На випадок, якщо такого немає (що я сумніваюся, так) ось моє.

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

Ось векторизована, нульова та NA-толерантна функція для обчислення геометричної середньої величини в Р. Дослідний 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 .

The

exp(mean(log(x)))

буде працювати, якщо немає 0 у x. Якщо так, то журнал створить -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))])))

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

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