行加权。使用来自另一个data.frame的权重以dplyr表示的平均值

我有一个data.frame，其中包含来自不同组的列（这里是

a

和

b

），还有另一个data.frame，其中包含用于执行加权平均值的权重：

test = data.frame(a.1=rep(2,5), b.1=rep(3,5), a.2=6:10, b.2=11:15)
tweights = data.frame(name=c('a.1', 'b.1', 'a.2', 'b.2'), 
                     w=c(0.2, 0.33, 0.8, 0.67))

对于

测试中的每一行

，我想对包含

a

的列进行加权平均，其权重由

tweights

中的相应值给出，对包含

b

的列也一样

我想做的是：

test %>% rowwise() %>% 
  mutate(awmean = weighted.mean(c(a.1, a.2), 
                                tweights$w[grepl('a', tweights$name)]),
         bwmean = weighted.mean(c(b.1, b.2), 
                                tweights$w[grepl('b', tweights$name)]))

这很好，但既不高效也不优雅，我希望避免明确提到列名（

a.1

，

a.2

等），第二部分调用

grepl

对我来说也不是很干净

我尝试过类似的方法，但它是错误的：

test %>% rowwise() %>%
  mutate(awmean = weighted.mean(contains('a'),
                                tweights$w[grepl('a', tweights$name)]))

Error: error in evaluating the argument 'x' in selecting a method 
for function 'weighted.mean': Error: could not find function "contains"

---

---

注意，这里我假设列

a.1:a.n

的顺序与

tweights

中相应行的顺序相同，这可以确定。一个解决方案真正考虑了

加权中的值和权重之间的匹配。mean

会更好…

可能是一个自定义函数

# get weighted means, for names beginning with a certain letter
getWM <- function(letter1) {
  rgx <- paste0('^', letter1)
  apply(test[, grep(rgx, names(test))], 1, weighted.mean,
        w = subset(tweights, grepl(rgx, name))$w )
}

或者，对于所有字母：

first_letters <- unique(gsub('[^a-z]', '', names(test)))
sapply(first_letters, getWM)

       a     b
[1,] 5.2  8.36
[2,] 6.0  9.03
[3,] 6.8  9.70
[4,] 7.6 10.37
[5,] 8.4 11.04

---

first_letters
matrixStats:：rowWeightedMeans（cbind（test$a.1，test$a.2），tweights$w[c（1，3）]）
谢谢@khasha，但这要求我知道并明确提到包含
a
的所有列名，并且我知道tweights$w

中相应权重的索引。有没有更通用的方法？嗯，你对长数据形状也满意吗<代码>测试%>%mutate（obs=1:n（））%%>%gather（name，value，-obs）%%>%left_join（tweights）%%>%separate（name，c（“char”，“num”））%%>%groupby（obs，char）%%>%mutate（wmean=weighted.mean（value，w））%%>%select（-w）。（需要

library（tidyr））

。谢谢@lukeA，非常有帮助和有趣（我不知道

tidyr

），尽管使用长形确实不太舒服。顺便说一句，通过管道连接到您的命令的

摘要（wmean=wmean[1]）

是否会删除一些冗余信息？谢谢@arvi1000，非常好，工作正常！我仍在尝试在

dplyr

语法中找到一个（1行）解决方案，但这非常有用！

first_letters <- unique(gsub('[^a-z]', '', names(test)))
sapply(first_letters, getWM)

       a     b
[1,] 5.2  8.36
[2,] 6.0  9.03
[3,] 6.8  9.70
[4,] 7.6 10.37
[5,] 8.4 11.04