0

些細な質問で申し訳ありません。これが私のサンプルデータです：

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

特定の日とシンボルに対して、テーブル 'x' には 2 つの値 (V1、V2) があります。

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

特定の日のすべての値 (V1、V2) には、3 つのグループの重み (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

ループなしで 2 つのテーブルの加重値を計算する方法** たとえば、'20130101' では、'x1' の V1 と V2 はそれぞれ 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
...
4

3 に答える 3

2

1 つのアプローチを次に示します。

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がピリオドでソートされ、1 対 1 で一致していると想定できない場合は、最初に を呼び出す必要があります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
于 2013-11-02T13:50:25.927 に答える
1

使用方法（ andと列のみが最初であるとmapply仮定）：V1V2V1

#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
于 2013-11-02T13:49:56.623 に答える
1 
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
于 2013-11-02T13:50:03.057 に答える