Question

我正在寻找类似于weighted.mean()的形式。我已经通过搜索找到了一些写出整个函数的解决方案，但是会感谢一些用户友好的东西。

Answer 1

以下包都有计算加权中位数的功能：'aroma.light'，'isotone'，'limma'，'cwhmisc'，'ergm'，'laeken'，'matrixStats，'PSCBS'，以及'bigvis'（在github上）。

为了找到它们，我在'sos'包中使用了无价的findFn（），它是R内置帮助的扩展。

findFn('weighted median')

或者，

???'weighted median'

作为???是?some.function

的help(some.function)的快捷方式

Answer 2

使用（整数）权重x的相同长度向量计算向量w的加权中位数：

median(rep(x, times=w))

Answer 3

使用@ wkmor1和@Jaitropmange的答案的一些经验。

我已经检查了3个软件包中的3个函数，isotone，laeken和matrixStats。只有matrixStats才能正常运行。其他两个（就像median(rep(x, times=w)解决方案一样）给出整数输出。只要我计算了人口的年龄中位数，小数点就很重要。

可重复的例子。计算人口的年龄中位数

df <- data.frame(age = 0:100,
                 pop = spline(c(4,7,9,8,7,6,4,3,2,1),n = 101)$y)

library(isotone)
library(laeken)
library(matrixStats)

isotone::weighted.median(df$age,df$pop)
# [1] 36
laeken::weightedMedian(df$age,df$pop)
# [1] 36
matrixStats::weightedMedian(df$age,df$pop)
# [1] 36.164
median(rep(df$age, times=df$pop))
# [1] 35

摘要

matrixStats::weightedMedian()是可靠的解决方案

Answer 4

真的很老，但我刚刚遇到它，并对不同方法进行了一些测试。 spatstat::weighted.median()似乎比median(rep(x, times=w))快14倍，如果你想运行这个函数几次，它实际上是显而易见的。测试是一项相对较大的调查，约有15,000人。

Answer 5

如果您正在使用survey套餐，假设您已经定义了您的调查设计，并且x是您感兴趣的变量：

svyquantile(~x, mydesign, c(0.5))

Answer 6

在这里发布 spatstat 函数的源代码（在user2522202＆＃39;答案中提到），因为人们可能不想安装这个有很多依赖关系的软件包，只是为了获得加权中值/分位数。函数本身没有依赖关系。我已经添加了 Roxygen 代码，以防您想将其放入包中。

#' Weighted quantile
#'
#' Function copied from **spatstat** package.
#'
#' @param x Vector of values
#' @param w Vector of weights
#' @param probs Vector of probabilities
#' @param na.rm Ignore missing data?
#' @export
weighted.quantile <- function(x, w, probs=seq(0,1,0.25), na.rm=TRUE) {
  x <- as.numeric(as.vector(x))
  w <- as.numeric(as.vector(w))
  if(anyNA(x) || anyNA(w)) {
    ok <- !(is.na(x) | is.na(w))
    x <- x[ok]
    w <- w[ok]
  }
  stopifnot(all(w >= 0))
  if(all(w == 0)) stop("All weights are zero", call.=FALSE)
  #'
  oo <- order(x)
  x <- x[oo]
  w <- w[oo]
  Fx <- cumsum(w)/sum(w)
  #'
  result <- numeric(length(probs))
  for(i in seq_along(result)) {
    p <- probs[i]
    lefties <- which(Fx <= p)
    if(length(lefties) == 0) {
      result[i] <- x[1]
    } else {
      left <- max(lefties)
      result[i] <- x[left]
      if(Fx[left] < p && left < length(x)) {
        right <- left+1
        y <- x[left] + (x[right]-x[left]) * (p-Fx[left])/(Fx[right]-Fx[left])
        if(is.finite(y)) result[i] <- y
      }
    }
  }
  names(result) <- paste0(format(100 * probs, trim = TRUE), "%")
  return(result)
}


#' Weighted median
#'
#' Function copied from **spatstat** package.
#'
#' @param x Vector of values
#' @param w Vector of weights
#' @param na.rm Ignore missing data?
#' @export
weighted.median <- function(x, w, na.rm=TRUE) {
  unname(weighted.quantile(x, probs=0.5, w=w, na.rm=na.rm))
}

Answer 7

一个人也可以使用stats::density创建一个加权PDF，然后将其转换为CDF，具体说明如here：

my_wtd_q = function(x, w, prob, n = 4096) 
  with(density(x, weights = w/sum(w), n = n), 
       x[which.max(cumsum(y*(x[2L] - x[1L])) >= prob)])

然后my_wtd_q(x, w, .5)将是加权中位数。

通过重新规范化操作，可以更小心地确保density下的总面积是一个。

Answer 8

使用Deleet的来源和ikashnitsky的数据，可以在 base 中使用以下方法计算加权中位数：

df <- data.frame(age = 0:100,
                 pop = spline(c(4,7,9,8,7,6,4,3,2,1),n = 101)$y)

medianWeighted <- function(x, w) {
  x <- aggregate(w[w>0] ~ x[w>0], FUN=sum)
  approxfun(filter(c(0,cumsum(x$w)/sum(x$w)), c(.5,.5), sides=1)[-1], x$x)(.5)
}
medianWeighted(df$age,df$pop) #Interpolates between observed Numbers
#[1] 36.164

medianWeightedI <- function(x, w) { 
  w <- w[order(x)]
  x <- x[order(x)]
  x[which.min(abs(filter(c(0,cumsum(w)/sum(w)), c(.5,.5), sides=1)[-1] - 0.5))]
}
medianWeightedI(df$age,df$pop) #Takes only numbers which have been observed
#[1] 36

如果您还想计算加权分位数。

quantileWeighted <- function(x, w, probs = seq(0, 1, 0.25)) {
  x <- aggregate(w[w>0] ~ x[w>0], FUN=sum)
  approxfun(filter(c(0,cumsum(x$w)/sum(x$w)), c(.5,.5), sides=1)[-1], x$x, rule=2)(probs)
}
quantileWeighted(df$age, df$pop)
#[1]   0.00000  20.21336  36.16400  55.98371 100.00000

quantileWeightedI <- function(x, w, probs = seq(0, 1, 0.25)) {
  x <- aggregate(w[w>0] ~ x[w>0], FUN=sum)
  stepfun(cumsum(x$w[-nrow(x)])/sum(x$w[-nrow(x)]), x$x)(probs)
}
quantileWeightedI(df$age, df$pop)
#[1]   0  20  36  56 100

Answer 9

这只是一个简单的解决方案，几乎可以在任何地方使用。

weighted.median <- function(x, w) {
  w <- w[order(x)]
  x <- x[order(x)]

  prob <- cumsum(w)/sum(w)
  ps <- which(abs(prob - .5) == min(abs(prob - .5)))
  return(x[ps])
}

有加权.median（）函数吗？

9 个答案:

可重复的例子。计算人口的年龄中位数

摘要