dplyr 中的 Rowwise weighted.mean 使用來自另一個 data.frame 的權重

Question

我有一個 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))

對於test每一行，我想對包含a的列執行加權平均值，權重由它們在tweights的相應值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 : an列的順序和tweights對應行的tweights是一樣的，這樣就可以了。 真正處理weighted.mean值和權重之間匹配的解決方案會更好......

Answer 1

也許是自定義功能？

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

現在您可以撥打如下電話：

getWM('a')
[1] 5.2 6.0 6.8 7.6 8.4

或者，對於所有字母：

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