R 查询 - 是否可以同时使用 "sapply"和 "weighted.mean"函数？

Question

我一直在使用代码来运行特定变量值(人口统计中断)的均值，但是我现在拥有具有权重变量并且需要计算加权均值的数据。我已经在使用代码来计算样本均值，并且想知道是否可以更改更改或调整函数来计算加权均值。这是一些生成示例数据的代码

df <- data.frame(gender=c(2,2,1,1,2,2,1,1,1,1,1,1,2,2,2,2,1,2,2,1),
                 agegroup=c(2,2,7,5,5,5,2,7,2,2,4,4,4,3,4,5,3,3,6,6),
                 attitude_1=c(4,3,4,4,4,4,4,4,5,2,5,5,5,4,3,2,3,4,2,4),
                 attitude_2=c(4,4,1,3,4,2,4,5,5,5,5,4,5,4,3,3,4,4,4,4),
                 attitude_3=c(2,2,1,1,3,2,5,1,4,2,2,2,3,3,4,1,4,1,3,1),
                 income=c(40794,74579,62809,47280,72056,57908,70784,96742,66629,117530,79547,54110,39569,111217,109146,56421,106206,28385,85830,71110),
                 weight=c(1.77,1.89,2.29,6.14,2.07,5.03,0.73,1.60,1.95,2.56,5.41,2.02,6.87,3.23,3.01,4.68,3.42,2.75,2.31,4.04))

到目前为止，我一直在使用此代码来获取示例方法

assign("Gender_Profile_1", 
       data.frame(sapply(subset(df, gender==1), FUN = function(x) mean(x, na.rm = TRUE))))

> Gender_Profile_1
           sapply.subset.df..gender....1...FUN...function.x..mean.x..na.rm...TRUE..
gender                                                                        1.000
agegroup                                                                      4.200
attitude_1                                                                    4.000
attitude_2                                                                    4.000
attitude_3                                                                    2.300
income                                                                    77274.700
weight                                                                        3.016

如您所见，它会生成具有所有变量均值的 Gender_Profile_1。在我尝试计算加权平均值时，我尝试将 "FUN=" 部分更改为此

assign("Gender_Profile_1", 
       data.frame(sapply(subset(df, gender==1), FUN = function(x) weighted.mean(x, w=weight,na.rm = TRUE))))

我收到以下错误消息

 Error in weighted.mean.default(x, w = weight, na.rm = TRUE) : 
  'x' and 'w' must have the same length 

我一直在尝试各种 df$weight 和 df$x 的排列，但似乎没有任何效果。任何帮助或想法都会很棒。非常感谢

Answer 1

基础R

如果您想坚持使用 base R，您可以执行以下操作:

# define func to return all weighted means
all_wmeans <- function(data_subset) {

  # which cols to summarise? all but gender and weight
  summ_cols <- setdiff(names(data_subset), c('gender', 'weight'))

  # for each col, calc weighted mean with weights from the 'weight' column
  result <- lapply(data_subset[, summ_cols], 
                   weighted.mean, w=data_subset$weight)

  # squeeze the resuling list back to a data.frame and return
  return(data.frame(result))
}

# now, split the df on gender, and apply the func to each chunk
lapply(split(df, df$gender), all_wmeans)

对于 gender 的每个值，结果是两个数据框的列表:

$`1`
  agegroup attitude_1 attitude_2 attitude_3   income
1 4.397546   4.027851   3.950597   1.962202 74985.25

$`2`
  agegroup attitude_1 attitude_2 attitude_3   income
1 4.092234   3.642666   3.676287   2.388872 64075.23

神奇的data.table

如果您不介意使用包，dplyr 和 data.table 是很棒的包，可以使这类事情变得更加简单。这是 data.table:

# load library and create a data.table object
library(data.table)
my_dt <- data.table(df)

# now it's a one liner:
my_dt[, lapply(.SD, weighted.mean, w=.SD$weight), by=gender]

返回:

   gender agegroup attitude_1 attitude_2 attitude_3   income   weight
1:      2 4.092234   3.642666   3.676287   2.388872 64075.23 4.099426
2:      1 4.397546   4.027851   3.950597   1.962202 74985.25 3.904483

data.table 代码还按性别对行进行分组，并使用 lapply 将函数和额外参数应用于 D S子集strong>ata(这就是 .SD 调用的内容)。从概念上讲，它与基本 R 代码完全相同，只是紧凑且快速。