2016-04-11 80 views
1

创建新列如果这是一个重复的事先道歉,但我花了大量的时间搜索,并没有发现任何与我的问题有关的东西。data.table r参照列

我在data.table中有一列,其中包含我想要用来创建新列的列的名称。也就是说,对于每一行,我想根据列中的值查找不同的列。

我试图使用get(),但没有奏效:

d<-data.table(A=1:10,B=11:20,Ref_Col=rep(c("A","B"),5)) 
d[,new_col:=get(Ref_Col)] 

下面是输出,我想:

 A B Ref_Col new_col 
1: 1 11  A  1 
2: 2 12  B  12 
3: 3 13  A  3 
4: 4 14  B  14 
5: 5 15  A  5 
6: 6 16  B  16 
7: 7 17  A  7 
8: 8 18  B  18 
9: 9 19  A  9 
10: 10 20  B  20 

任何帮助深表感谢。

+0

尝试'd [,new_col:= ifelse(Ref_Col == “A” ,A,B)]' – nicola

+0

感谢尼古拉的快速回复。我应该在我的问题中提到data.table(〜30)中实际上只有2列。所以如果这样做每个都不实际。 – mat

+4

尝试:'d [,new_col:= get(Ref_Col),by = Ref_Col]' – Arun

回答

3

在阅读您的问题时,我的第一印象是index matrix在这里是完美的。我已经设计了一个围绕这个想法的解决方案,但是我必须警告你,它最终会比人们希望的要多得多。

这里的整个事情:

d[,new_col:= 
    as.matrix(d[,unique(d[,Ref_Col]),with=F])[ 
     matrix(c(seq_len(nrow(d)),match(Ref_Col,unique(Ref_Col))),nrow(d)) 
    ] 
]; 
##  A B Ref_Col new_col 
## 1: 1 11  A  1 
## 2: 2 12  B  12 
## 3: 3 13  A  3 
## 4: 4 14  B  14 
## 5: 5 15  A  5 
## 6: 6 16  B  16 
## 7: 7 17  A  7 
## 8: 8 18  B  18 
## 9: 9 19  A  9 
## 10: 10 20  B  20 

让我们打破下来一块在同一时间:


c(seq_len(nrow(d)),match(Ref_Col,unique(Ref_Col))) 

首先我构想了一个将包括指数的基础数据向量矩阵。左栏是行下标,右栏是栏下标。现在,矩阵的限制是它们不能包含异构类型。因此,我们必须在整数索引和字符名称之间进行选择。由于你的data.table没有行名,我们必须使用整数索引(并且整数索引可能会更快)。行索引很容易构建;它只是从1到nrow(d)的序列。列索引必须是match(),从Ref_Col的值到我们将建立索引的对象的列名。要跳到前面,我们实际上不会索引d,而是根据Ref_Col列中至少引用一次的列构建的矩阵。因此,正确的列索引基于矢量unique(Ref_Col)中列名的位置。


matrix(...,nrow(d)) 

下一步是显然以形成矩阵出底层数据载体。


as.matrix(d[,unique(d[,Ref_Col]),with=F])[...] 

不幸的是,data.table目前不支持索引与索引矩阵。为了解决这个问题,我们必须强迫一个支持索引矩阵索引的数据类型。两个最合理的选择是数据帧或矩阵。由于new_col列必须包含单个矢量类型,因此强制转换为矩阵(并因此将所有指示对象列变为单一类型)不是问题。我简单地考虑过,因为data.table已经是一个有效的data.frame(即它在R的伪OOP范式下“从data.frame继承”),并且由于R在引擎盖下使用copy-on-modify优化,强制data.frame的成本可能更低,并且希望避免拷贝,但运行tracemem()则表明,R在强制data.frame时实际上复制了整个data.table。(更新:我刚刚发现R在内部将数据帧强制转换为矩阵,就在它将要被索引矩阵索引之前,因此在索引矩阵索引之前强制使用data.frame不会购买任何东西超过和强制直接矩阵)所以我刚刚去了as.matrix()。是的,它仍然在这种情况下复制数据,但至少它会复制更少的数据,因为我们可以首先用unique(d[,Ref_Col])(需要with=F)索引参考列。


d[,new_col:=...] 

最后,我们可以从施加所述索引矩阵到组合指涉矩阵的结果赋给新列。


性能

我做了一些基准测试:

library(data.table); 
library(microbenchmark); 

chinsoon <- function(d) { d[,id:=seq_along(Ref_Col)]; temp <- melt(d, meas=unique(d$Ref_Col), value.name="new_col")[Ref_Col==variable,]; setkey(d, id, Ref_Col); setkey(temp, id, Ref_Col); d[temp][ ,`:=`(id = NULL, variable = NULL)][]; }; 
bgoldst <- function(d) d[,new_col:=as.matrix(d[,unique(d[,Ref_Col]),with=F])[matrix(c(seq_len(nrow(d)),match(Ref_Col,unique(Ref_Col))),nrow(d))]]; 
symbolix <- function(d) { refs <- unique(d[, Ref_Col]); for(i in refs) d[ Ref_Col == i, eval(parse(text = paste0("new_col := ", i)))][ ]; d; }; 
arun <- function(d) d[,new_col:=get(Ref_Col),Ref_Col]; 

N <- 100L; d <- data.table(A=seq(1L,N%/%2),B=seq(N%/%2+1L,N),Ref_Col=rep(c('A','B'),N%/%2L)); 
identical(bgoldst(copy(d)),chinsoon(copy(d))); 
## [1] TRUE 
identical(bgoldst(copy(d)),{ x <- symbolix(copy(d)); attr(x,'index') <- NULL; x; }); ## irrelevant index attribute difference 
## [1] TRUE 
identical(bgoldst(copy(d)),arun(copy(d))); 
## [1] TRUE 

N <- 100L; d <- data.table(A=seq(1L,N%/%2),B=seq(N%/%2+1L,N),Ref_Col=rep(c('A','B'),N%/%2L)); 
microbenchmark(chinsoon(copy(d)),bgoldst(copy(d)),symbolix(copy(d)),arun(copy(d))); 
## Unit: microseconds 
##    expr  min  lq  mean median  uq  max neval 
## chinsoon(copy(d)) 2444.896 2516.955 2941.2385 2597.1400 3501.8410 6343.812 100 
## bgoldst(copy(d)) 1713.608 1790.799 2137.4168 1837.4135 2472.6930 4599.841 100 
## symbolix(copy(d)) 2175.901 2275.972 2769.9504 2354.8740 3173.6170 13897.454 100 
##  arun(copy(d)) 635.921 685.743 862.7615 722.7345 951.5295 4414.667 100 

N <- 1e4L; d <- data.table(A=seq(1L,N%/%2),B=seq(N%/%2+1L,N),Ref_Col=rep(c('A','B'),N%/%2L)); 
microbenchmark(chinsoon(copy(d)),bgoldst(copy(d)),symbolix(copy(d)),arun(copy(d))); 
## Unit: microseconds 
##    expr  min  lq  mean median  uq  max neval 
## chinsoon(copy(d)) 4603.262 4999.6975 7194.594 6277.311 7162.555 49217.352 100 
## bgoldst(copy(d)) 2511.609 2600.5610 3371.723 2682.029 3979.529 6738.964 100 
## symbolix(copy(d)) 2645.893 2761.1450 3588.282 2959.789 4190.149 15062.810 100 
##  arun(copy(d)) 770.204 849.5345 1048.795 880.753 1126.653 2831.495 100 

N <- 1e5L; d <- data.table(A=seq(1L,N%/%2),B=seq(N%/%2+1L,N),Ref_Col=rep(c('A','B'),N%/%2L)); 
microbenchmark(chinsoon(copy(d)),bgoldst(copy(d)),symbolix(copy(d)),arun(copy(d))); 
## Unit: milliseconds 
##    expr  min  lq  mean median  uq  max neval 
## chinsoon(copy(d)) 27.114512 32.982772 59.00385 70.976359 78.864641 131.06167 100 
## bgoldst(copy(d)) 9.732538 11.673015 19.02450 13.396672 16.624600 66.72976 100 
## symbolix(copy(d)) 6.787716 8.509448 11.07309 9.057487 10.523269 55.60692 100 
##  arun(copy(d)) 2.127149 2.380748 3.32179 2.813746 3.930136 6.83604 100 

所以得出的结论是,我的解决方案是略快于小数据,但由于数据渐进地更大,Symbolix的解决方案变得更快。我们可以高度自信地猜测,这是因为我的解决方案招致了复制指示列的惩罚,以便用索引矩阵对它们进行索引,而Symbolix使用更简单的循环遍历指示列并将它们索引为一个一次。这是R中的一种情况,其中循环比矢量化要好。 +1给Symbolix。

更新: Whoooooaaaaa!在加入Arun的解决方案之后,除了比其他人更短,更优雅外,我惊讶地发现它速度更快。游戏,设置,并与阿伦匹配。

我想起了这条线愤怒的活动不能代替理解。

+2

+10为解释,努力和基准! – SymbolixAU

+1

upvoted为benckmarks! – chinsoon12

+0

我想我们今天都在这里学到了一些东西。谢谢@arun – SymbolixAU

2

如何融化原始data.table然后过滤?

melt(d, meas=unique(d$Ref_Col), value.name="new_col")[Ref_Col==variable,] 

以上产生OP输出列的子集。


编辑:重现相同data.table

d[,id:=seq_along(Ref_Col)] 
temp <- melt(d, meas=unique(d$Ref_Col), value.name="new_col")[Ref_Col==variable,] 
setkey(d, id, Ref_Col) 
setkey(temp, id, Ref_Col) 
d[temp][ ,`:=`(id = NULL, variable = NULL)][] 
+0

不错的做法。并且,为了避免设置键的开销:'d [,id:= seq_along(Ref_Col)] [melt(d,meas = unique(d $ Ref_Col),value.name =“new_col”)[Ref_Col == variable ,],on = c(“id”,“Ref_Col”)]' – SymbolixAU

2

使用循环...

library(data.table) 
d<-data.table(A=1:10,B=11:20,Ref_Col=rep(c("A","B"),5)) 

refs <- unique(d[, Ref_Col]) 

for(i in refs) d[ Ref_Col == i, eval(parse(text = paste0("new_col := ", i)))][ ] 
d 
#  A B Ref_Col new_col 
# 1: 1 11  A  1 
# 2: 2 12  B  12 
# 3: 3 13  A  3 
# 4: 4 14  B  14 
# 5: 5 15  A  5 
# 6: 6 16  B  16 
# 7: 7 17  A  7 
# 8: 8 18  B  18 
# 9: 9 19  A  9 
# 10: 10 20  B  20