data.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在这里会很完美。我已经设计了一个基于这个想法的解决方案，但我必须警告你，它最终比人们希望的要复杂得多

事情是这样的：

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

让我们一次分解一部分：

---

首先，我构造一个向量，它将包含索引矩阵的底层数据。左栏为行下标，右栏为列下标。现在，矩阵的一个限制是它们不能包含异构类型。因此，我们必须在整数索引和字符名之间进行选择。由于data.table没有行名称，我们必须使用整数索引（整数索引可能会更快）。行索引易于构造；它只是从1到

nrow（d）

的序列。列索引必须是

match（）

ed，从

Ref\u Col

值到我们将要索引的对象的列名。要向前跳，我们实际上不会索引

d

，而是从

Ref\u Col

列至少引用一次的列构建一个矩阵。因此，正确的列索引基于列名称在向量

unique（Ref\u Col）

中的位置

---

下一步显然是从底层数据向量中形成一个矩阵

---

遗憾的是，data.table当前不支持使用索引矩阵进行索引。为了解决这个问题，我们必须强制使用支持索引矩阵索引的数据类型。最符合逻辑的两种选择是data.frame或matrix。我使用了一个矩阵，因为新列无论如何都必须包含一个向量类型，所以强制使用矩阵（因此将所有引用列展平为一个类型）不是问题。我简要地考虑过，由于data.table已经是一个有效的data.frame（即，它在R的伪OOP范式下“继承”自data.frame），并且由于R在引擎盖下使用了修改优化时的副本，因此强制使用data.frame并希望避免副本的成本可能会更低，但运行的是

traceem（）

显示，当强制到data.frame时，R实际上复制了整个data.table。（更新：我刚刚发现R在即将被索引矩阵索引之前在内部将data.frame强制转换为矩阵，因此在使用索引矩阵索引之前强制转换为data.frame不会比直接强制转换为矩阵更划算。）因此我只选择了

as.matrix（）

。是的，在这种情况下它仍然会复制数据，但至少它会复制更少的数据，因为我们可以首先用

唯一（d[，Ref\u Col]）

索引出引用列（需要

with=F

）

---

最后，我们可以根据将索引矩阵应用到组合引用矩阵的结果来分配新列

---

演出 我做了一些基准测试：

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

库（data.table）；
图书馆（微基准）；
chinsoon读到你的问题，我的第一印象是安在这里会很完美。我已经设计了一个基于这个想法的解决方案，但我必须警告你，它最终比人们希望的要复杂得多

事情是这样的：

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

让我们一次分解一部分：


首先，我构造一个向量，它将包含索引矩阵的底层数据。左栏为行下标，右栏为列下标。现在，矩阵的一个限制是它们不能包含异构类型。因此，我们必须在整数索引和字符名之间进行选择。由于data.table没有行名称，我们必须使用整数索引（整数索引可能会更快）。行索引易于构造；它只是从1到
nrow（d）
的序列。列索引必须是
match（）
ed，从
Ref\u Col
值到我们将要索引的对象的列名。要向前跳，我们实际上不会索引
d
，而是从
Ref\u Col
列至少引用一次的列构建一个矩阵。因此，正确的列索引基于列名称在向量
unique（Ref\u Col）
中的位置


下一步显然是从底层数据向量中形成一个矩阵


遗憾的是，data.table当前不支持使用索引矩阵进行索引。为了解决这个问题，我们必须强制使用支持索引矩阵索引的数据类型。最符合逻辑的两种选择是data.frame或matrix。我使用了一个矩阵，因为新列无论如何都必须包含一个向量类型，所以强制使用矩阵（因此将所有引用列展平为一个类型）不是问题。我简要地考虑过，由于data.table已经是一个有效的data.frame（即，它在R的伪OOP范式下“继承”自data.frame），并且由于R在引擎盖下使用了修改优化时的副本，因此强制使用data.frame并希望避免副本的成本可能会更低，但运行的是
traceem（）
显示，当强制到data.frame时，R实际上复制了整个data.table。（更新：我刚刚发现，在即将被索引矩阵索引之前，R在内部强制将data.frame转换为矩阵，因此，在使用索引矩阵索引之前强制转换为data.frame不会收买任何东西
matrix(...,nrow(d))

as.matrix(d[,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

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

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

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