[英]data.table r create new column referring to column
如果這是重復的話,請提前道歉,但是我花了很多時間搜索並且沒有發現任何與我的問題有關的東西。
我在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
任何幫助深表感謝。
在閱讀您的問題時,我的第一印象是索引矩陣在這里是完美的。 我已經設計了一種基於該想法的解決方案,但是我必須警告您,它最終比人們希望的要復雜得多。
整個過程如下:
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)
的序列。 列索引必須從Ref_Col
值match()
到將要建立索引的對象的列名。 為了向前邁進,我們實際上將不索引d
,而是僅由Ref_Col
列至少引用一次的列構建的矩陣。 因此,正確的列索引基於列名稱在向量unique(Ref_Col)
。
matrix(...,nrow(d))
顯然,下一步是從基礎數據向量中形成矩陣。
as.matrix(d[,unique(d[,Ref_Col]),with=F])[...]
不幸的是,data.table當前不支持使用索引矩陣進行索引。 要解決此問題,我們必須強制使用不支持使用索引矩陣進行索引的數據類型。 兩個最合乎邏輯的選擇是data.frame或矩陣。 我使用了矩陣,因為new_col
列都必須包含單個向量類型,因此強制轉換為矩陣(並因此將所有引用列展平為單個類型)不是問題。 我簡要地考慮了一下,因為data.table已經是有效的data.frame(即,它是從R.的偽OOP范例中的data.frame繼承而來的),並且因為R在后台使用了修改時復制優化,強制轉換為data.frame並避免復制的開銷可能較小,但是運行tracemem()
發現R實際上在強制轉換為data.frame時確實復制了整個data.table。 (更新:而且我剛剛發現R即將在即將由索引矩陣索引之前在內部將data.frame強制轉換為矩陣,因此在使用索引矩陣進行索引之前將其強制轉換為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。
更新:哇! 添加了Arun的解決方案后,我驚訝的是它的速度要快得多,而且比其他解決方案更短,更優雅。 游戲,設置並匹配Arun。
我想起了這一行: 狂熱活動不能替代理解。
融化原始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)][]
正在使用循環...
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.