построчно weighted.mean в dplyr с использованием весов из другого 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, и то же самое для колонн с 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)])) 

Это работает хорошо, но это не эффективно и не шикарно, я woud хотел бы избежать явно упоминать имена столбцов (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 тот же, что может быть ОК. Решение, действительно заботящееся о согласовании между значениями и весами в 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