Média geométrica: há um embutido?

106

Tentei encontrar um meio geométrico integrado, mas não consegui.

(Obviamente, um built-in não vai me poupar tempo enquanto trabalho no shell, nem suspeito que haja qualquer diferença na precisão; para scripts, tento usar built-ins tão frequentemente quanto possível, onde o (cumulativo) o ganho de desempenho geralmente é perceptível.

Caso não haja (o que duvido seja o caso) aqui está o meu.

gm_mean = function(a){prod(a)^(1/length(a))}
doug
fonte
11
Cuidado com números negativos e transbordamentos. prod (a) ficará abaixo ou transbordará muito rapidamente. Tentei cronometrar isso usando uma grande lista e rapidamente peguei o Inf usando seu método vs 1.4 com exp (mean (log (x))); o problema de arredondamento pode ser bastante grave.
Tristan,
Eu escrevi a função acima rapidamente porque tinha certeza de que 5 minutos depois de postar este Q, alguém me diria que o R é integrado para gm. Portanto, não há integração, portanto, vale a pena reservar um tempo para recodificar à luz de seus comentários. + 1 de mim.
doug de
1
Acabei de marcar esta média geométrica e embutida , 9 anos depois.
smci

Respostas:

77

Aqui está uma função vetorial, tolerante a zero e NA, para calcular a média geométrica em R. O meancálculo detalhado length(x)é necessário para os casos em que xcontém valores não positivos.

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

Obrigado a @ben-bolker por observar a na.rmpassagem e a @Gregor por ter certeza de que funciona corretamente.

Acho que alguns dos comentários estão relacionados a uma falsa equivalência de NAvalores nos dados e zeros. No aplicativo que eu tinha em mente, eles são iguais, mas é claro que isso geralmente não é verdade. Portanto, se você deseja incluir a propagação opcional de zeros e tratar de forma length(x)diferente no caso de NAremoção, a seguinte alternativa é um pouco mais longa para a função acima.

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

Observe que ele também verifica se há valores negativos e retorna uma informação mais informativa e apropriada, NaNrespeitando que a média geométrica não é definida para valores negativos (mas é para zeros). Agradeço aos comentaristas que permaneceram no meu caso sobre isso.

Paul McMurdie
fonte
2
não seria melhor passar na.rmcomo um argumento (ou seja, deixar o usuário decidir se deseja ser tolerante a NA ou não, para consistência com outras funções de resumo de R)? Estou nervoso sobre a exclusão automática de zeros - também faria disso uma opção.
Ben Bolker
1
Talvez você esteja certo sobre passar na.rmcomo uma opção. Vou atualizar minha resposta. Quanto à exclusão de zeros, a média geométrica é indefinida para valores não positivos, incluindo zeros. O acima é uma correção comum para a média geométrica, em que zeros (ou, neste caso, todos os diferentes de zero) recebem um valor fictício de 1, que não tem efeito sobre o produto (ou, equivalentemente, zero na soma logarítmica).
Paul McMurdie
* Eu quis dizer uma correção comum para valores não positivos, zero sendo o mais comum quando a média geométrica está sendo usada.
Paul McMurdie
1
Sua na.rmpassagem não funciona como codificada ... veja gm_mean(c(1:3, NA), na.rm = T). Você precisa remover o & !is.na(x)do subconjunto do vetor e, como o primeiro argumento de sumé ..., você precisa passar na.rm = na.rmpor nome e também precisa excluir 0's e NA' s do vetor na lengthchamada.
Gregor Thomas
2
Cuidado: por xconter apenas zero (s), assim x <- 0, exp(sum(log(x[x>0]), na.rm = TRUE)/length(x))1para a média geométrica, o que não faz sentido.
adatum
88

Não, mas há algumas pessoas que escreveram um, como aqui .

Outra possibilidade é usar:

exp(mean(log(x)))
Mark Byers
fonte
Outra vantagem de usar exp (mean (log (x))) é que você pode trabalhar com listas longas de números grandes, o que é problemático ao usar a fórmula mais óbvia usando prod (). Observe que prod (a) ^ (1 / comprimento (a)) e exp (média (log (a))) fornecem a mesma resposta.
lukeholman
o link foi corrigido
PatrickT
15

Podemos usar o pacote psych e chamar a função geometric.mean .

AliCivil
fonte
1
psych::geometric.mean()
smci
Essas funções deveriam levar as séries e não seu crescimento, pelo menos como opção, eu diria.
Christoph Hanck
12

o

exp(mean(log(x)))

funcionará a menos que haja um 0 em x. Nesse caso, o log produzirá -Inf (-Infinite) que sempre resulta em uma média geométrica de 0.

Uma solução é remover o valor -Inf antes de calcular a média:

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

Você pode usar uma linha única para fazer isso, mas significa calcular o log duas vezes, o que é ineficiente.

exp(mean(log(i[is.finite(log(i))])))
Alan James Salmoni
fonte
por que calcular o log duas vezes quando você pode fazer: exp (mean (x [x! = 0]))
zzk
ambas as abordagens erram a média, porque o denominador da média sum(x) / length(x)está errado se você filtrar x e depois passá-lo para mean.
Paul McMurdie
Acho que filtrar é uma má ideia, a menos que você explicitamente pretenda fazê-lo (por exemplo, se eu estivesse escrevendo uma função de uso geral , não faria a filtragem o padrão) - OK, se este for um pedaço de código único e você pensou com muito cuidado sobre o que realmente significa filtrar zeros no contexto do seu problema (!)
Ben Bolker
Por definição, uma média geométrica de um conjunto de números contendo zero deve ser zero! math.stackexchange.com/a/91445/221143
Chris de
6

Eu uso exatamente o que Mark diz. Desta forma, mesmo com tapply, você pode usar a meanfunção embutida, sem precisar definir a sua! Por exemplo, para calcular médias geométricas por grupo de dados $ value:

exp(tapply(log(data$value), data$group, mean))
TMS
fonte
3

Esta versão oferece mais opções do que as outras respostas.

  • Permite ao usuário distinguir entre resultados que não são números (reais) e aqueles que não estão disponíveis. Se números negativos estiverem presentes, a resposta não será um número real, então NaNé retornado. Se todos forem NAvalores, a função retornará em NA_real_vez disso para refletir que um valor real literalmente não está disponível. Esta é uma diferença sutil, mas que pode produzir resultados (ligeiramente) mais robustos.

  • O primeiro parâmetro opcional zero.rmdestina-se a permitir que o usuário faça com que os zeros afetem a saída sem torná-la zero. Se zero.rmestiver definido como FALSEe etaestiver definido como NA_real_(seu valor padrão), os zeros têm o efeito de reduzir o resultado para um. Não tenho nenhuma justificativa teórica para isso - apenas parece fazer mais sentido não ignorar os zeros, mas "fazer algo" que não envolva tornar o resultado zero automaticamente.

  • etaé uma maneira de lidar com zeros que foi inspirada na seguinte discussão: 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)
}
Chris Coffee
fonte
1
Você pode adicionar alguns detalhes explicando como isso difere / melhora as soluções existentes? (Eu pessoalmente não gostaria de adicionar uma dependência pesada como dplyrpara tal utilitário, a menos que necessário ...)
Ben Bolker
Eu concordo, os case_whens eram um pouco bobos, então eu os retirei e a dependência em favor de ifs. Eu também forneci alguns detalhes.
Chris Coffee
1
Segui sua última ideia e alterei o padrão de nan.rmpara TRUEpara alinhar todos os três parâmetros `` `.rm``.
Chris Coffee
1
Um outro detalhe estilístico. ifelseé projetado para vetorização. Com uma única condição para verificar, seria mais idiomático de usarvalue.count <- if(zero.rm) sum(x[!is.na(x)] > 0) else sum(!is.na(x))
Gregor Thomas
Parece melhor do que ifelsetambém. Alterado. Obrigado!
Chris Coffee
3

Caso haja valores ausentes em seus dados, esse não é um caso raro. você precisa adicionar mais um argumento.

Você pode tentar o seguinte código:

exp(mean(log(i[ is.finite(log(i)) ]), na.rm = TRUE))
Tian Yi
fonte
1
exp(mean(log(x1))) == prod(x1)^(1/length(x1))
user12882764
fonte