weighted.mean zeilenweise in dplyr Gewichte von einem anderen unter Verwendung data.frame

Question

I eine data.frame mit Säulen aus verschiedenen Gruppen haben (hier und ab) und eine weitere data.frame die Gewichte, die einen gewichteten Mittelwert auszuführen:

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

für jede Zeile in test, I Stab einen gewichteten Mittelwert für die Spalten, die durch ihre entsprechenden Wert gegeben mit den Gewichten a auszuführen in tweights, und das gleiche für die Säulen mit b enthält.

Was habe ich versucht zu tun:

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)])) 

Das ist gut funktioniert, aber das ist nicht effizient noch elegant, ich woud mag ausdrücklich zu vermeiden, dass die Spaltennamen zu erwähnen (a.1, a.2 usw.), und den zweiten Teil weder grepl Aufruf sieht nicht sehr sauber zu mir ...

ich habe versucht, so etwas wie diese, aber es ist falsch:

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" 

---

Beachten Sie, dass ich hier davon ausgehe, dass die Reihenfolge der Spalten a.1 : a.n und die Reihenfolge der entsprechenden Zeilen in tweights die gleiche ist, was in Ordnung sein kann. Eine Lösung, die sich wirklich um die Übereinstimmung zwischen den Werten und Gewichten in weighted.mean kümmert, wäre noch besser ...

Answer 1

Vielleicht eine benutzerdefinierte Funktion?

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

Jetzt können Sie gerade einen Anruf wie machen:

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

Oder für alle Buchstaben:

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