Как рассчитать взвешенное значение без цикла?

Question

Извините, что задал тривиальный вопрос. Вот мой пример данных:

(x <- data.frame(period=c('20130101','20130102'),symbol=c('x1','x2'),V1=c(1,2),V2=c(3,4))) 
(y <- data.frame(period=c('20130101','20130101','20130102','20130102'), 
      symbol=rep(c('V1','V2'),2),w1=rep(c(0.5,0.5),2),w2=rep(c(0.3,0.7),2), 
      w3=rep(c(0.2,0.8),2))) 

В данный день и символ, есть два значения (V1, V2), в таблице «х».

period symbol V1 V2 
1 20130101 x1 1 3 
2 20130102 x2 2 4 

В данный день, каждое значение (V1, V2) имеет три группы вес (w1, w2, w3).

period symbol w1 w2 w3 
1 20130101 V1 0.5 0.3 0.2 
2 20130101 V2 0.5 0.7 0.8 
3 20130102 V1 0.5 0.3 0.2 
4 20130102 V2 0.5 0.7 0.8 

Как рассчитать взвешенное значение по двум таблицам без цикла? ** Например, в «20130101», V1 и V2 из «x1» равно 1 и 3 соответственно. Затем, найдя таблицу 'y' для даты '20130101' и V1 и V2, мы получим 3 группы весов. Взвешенное значение вычисляется по формуле:

wv1=1*0.5 + 3*0.5=2 
    wv2=1*0.3 + 3*0.7=2.4 
    wv3=1*0.2 + 3*0.8=2.6 

таблица результатов выглядит следующим образом:

period symbol wv1 wv2 wv3 
1 20130101 x1 2 2.4 2.6 
... 

Answer 1

Способ использования mapply (предполагается, что у вас есть только V1 и V2 и V1 столбец является первым):

#function to apply multiple arguments 
fun <- function(period., symbol., V1., V2.) 
{ 
row1. <- y$period == as.numeric(as.character(period.)) & y$symbol == "V1" 
row2. <- y$period == as.numeric(as.character(period.)) & y$symbol == "V2" 

res <- y[row1.,c("w1", "w2", "w3")] * V1. + y[row2.,c("w1", "w2", "w3")] * V2. 

ret <- c(period = as.numeric(as.character(period.)), 
      symbol = as.character(symbol.), 
       setNames(res, c("wv1", "wv2", "wv3"))) 
return(ret) 
} 

do.call(rbind, mapply(fun, x$period, x$symbol, x$V1, x$V2, SIMPLIFY = F)) 
#  period symbol wv1 wv2 wv3 
#[1,] 20130101 "x1" 2 2.4 2.6 
#[2,] 20130102 "x2" 3 3.4 3.6 

Answer 2

One way: 
l<-reshape(y,idvar="period",timevar="symbol",direction="wide") 
> l 
    period w1.V1 w2.V1 w3.V1 w1.V2 w2.V2 w3.V2 
1 20130101 0.5 0.3 0.2 0.5 0.7 0.8 
3 20130102 0.5 0.3 0.2 0.5 0.7 0.8 

nn<-merge(l,x,by="period") 
> nn 
    period w1.V1 w2.V1 w3.V1 w1.V2 w2.V2 w3.V2 symbol V1 V2 
1 20130101 0.5 0.3 0.2 0.5 0.7 0.8  x1 1 3 
2 20130102 0.5 0.3 0.2 0.5 0.7 0.8  x2 2 4 


nn$wv1<-with(nn,w1.V1*V1+w1.V2*V2) 
nn$wv2<-with(nn,w2.V1*V1+w2.V2*V2) 
nn$wv3<-with(nn,w3.V1*V1+w3.V2*V2) 

nn 
    period w1.V1 w2.V1 w3.V1 w1.V2 w2.V2 w3.V2 symbol V1 V2 wv1 wv2 wv3 
1 20130101 0.5 0.3 0.2 0.5 0.7 0.8  x1 1 3 2 2.4 2.6 
2 20130102 0.5 0.3 0.2 0.5 0.7 0.8  x2 2 4 3 3.4 3.6 



    nn[,c(1,8,11:13)] 
    period symbol wv1 wv2 wv3 
1 20130101  x1 2 2.4 2.6 
2 20130102  x2 3 3.4 3.6 

Answer 3

Адрес: proach:

cbind(x[,1:2],Reduce(`+`,lapply(split(y,y$symbol), 
    function(z) x[,as.character(z$symbol[1])]*z[,3:5]))) 
##  period symbol w1 w2 w3 
## 1 20130101  x1 2 2.4 2.6 
## 3 20130102  x2 3 3.4 3.6 

Это может быть расширено в зависимости от того, какое общее решение вы хотите. Например, если вы не можете предположить, что x и y сортируются по периодам и соответствием один к одному, то вам нужно сначала сделать вызов match:

ysplit<-lapply(split(y,y$symbol),function(z) z[match(x$period,z$period),]) 
vals<-Reduce(`+`,lapply(ysplit,function(z) x[,as.character(z$symbol[1])]*z[,3:5])) 
cbind(x[,1:2],vals) 

Если вы хотите, чтобы получить строку и столбец имена правые:

cbind(x[,1:2],setNames(vals,c("wv1","wv2","wv3")),row.names=row.names(x)) 
##  period symbol wv1 wv2 wv3 
## 1 20130101  x1 2 2.4 2.6 
## 2 20130102  x2 3 3.4 3.6 

Если вы хотите, общее решение, которое принимает произвольное количество веса вы можете разместить это с некоторыми незначительными изменениями:

y$w4<-c(0.1,0.9,0.1,0.9) 
ysplit<-lapply(split(y,y$symbol),function(z) z[match(x$period,z$period),]) 

vals<-Reduce(`+`,lapply(ysplit,function(z) 
     x[,as.character(z$symbol[1])]*z[,substring(names(z),1,1)=="w"])) 
cbind(x[,1:2],setNames(vals,paste0("wv",1:ncol(vals))),row.names=row.names(x)) 

##  period symbol wv1 wv2 wv3 wv4 
## 1 20130101  x1 2 2.4 2.6 2.8 
## 2 20130102  x2 3 3.4 3.6 3.8