dplyr +"meta"-columns:当列包含要使用的其他列的名称而不是数据时

Question

我想知道以下问题是否在dplyr中有一个优雅的解决方案.

要提供简单的可重现示例,请考虑以下data.frame:

df <- data.frame( a=1:5, b=2:6, c=3:7,
                  ref=c("a","a","b","b","c"), 
                  stringsAsFactors = FALSE )

这里a,b,c是常规数值变量,同时ref意味着引用其列是该观察"主"的价值.例如:

  a b c ref
1 1 2 3   a
2 2 3 4   a
3 3 4 5   b
4 4 5 6   b
5 5 6 7   c

例如,对于观察3,ref==b因此列b包含主要值.而对于观察1,ref==a因此列a包含主要值.

有了这个data.frame,问题就是main使用dplyr 创建每个观察值的新列.

  a b c ref main
1 1 2 3   a    1
2 2 3 4   a    2
3 3 4 5   b    4
4 4 5 6   b    5
5 5 6 7   c    7

我可能需要使用dplyr,因为这一个操作是较长的dplyr %>%数据转换链的一部分.

Answer 1

这是一个简单,快速的方法,可以让你坚持dplyr链接:

require(data.table)
df %>% setDT %>% .[,main:=get(ref),by=ref]
#    a b c ref main
# 1: 1 2 3   a    1
# 2: 2 3 4   a    2
# 3: 3 4 5   b    4
# 4: 4 5 6   b    5
# 5: 5 6 7   c    7

感谢@akrun以最快的方式和基准测试来展示它(请参阅他的回答).

setDT修改类,df以便data.table在将来的链中不必再次转换.

转换应链中的任何将来的代码工作,但两者dplyr并data.table正在积极发展,所以要在安全方面,人们可以转而使用

df %>% data.table %>% .[,main:=get(ref),by=ref]

Answer 2

我们可以base R使用行/列索引执行此操作.我们得到的列索引用match,cbind以行索引(1:nrow(df))和提取的元素.索引速度非常快.

df$main <- df[-4][cbind(1:nrow(df),match(df$ref,names(df)[-4]))]
df
#    a b c ref main
#1 1 2 3   a    1
#2 2 3 4   a    2
#3 3 4 5   b    4
#4 4 5 6   b    5
#5 5 6 7   c    7

类似的dplyr链是

df %>% 
  `[[<-.data.frame`(.,"main",value=.[-4][
           cbind(1:nrow(.),match(.$ref,names(.)[-4]))])

基准

set.seed(24)
df <- data.frame(a= sample(10, 1e6, replace=TRUE), b= sample(20, 1e6, 
replace=TRUE), c= sample(40,1e6, replace=TRUE), ref= sample(letters[1:3],
 1e6, replace=TRUE), stringsAsFactors=FALSE)
df2 <- copy(df)
df3 <- copy(df)
df4 <- copy(df)

akrun <- function() {df$main <- df[-4][cbind(1:nrow(df),match(df$ref,names(df)[-4]))]}
akrun2 <- function(){setDT(df3)[, main:=get(ref), ref]}
Frank <- function() {df2 %>% data.table %>% .[,main:=.SD[[ref]],by=ref]}
Frank2 <- function() {setDT(df4)[, main:= .SD[[ref]], by =ref]}
MrFlick <- function() {getval <- . %>%
                                  mutate(id=factor(1:n())) %>% 
                                  gather(col, val, a:c) %>% 
                                  group_by(id) %>% 
                                  summarize(val=first(val[col==ref])) %>% 
                                  select(val)
                       df2 %>%
                          cbind(., getval(.))}

akhmed <- function() {df %>%
                        group_by(ref) %>%
                        do({
                        eval(parse(text=sprintf("main <- .$%s",.$ref[1])))
                        data.frame(., main = main, stringsAsFactors=FALSE)
                         }) %>% 
                        ungroup()
         }

 system.time(akrun())
 #user  system elapsed 
 #0.07    0.00    0.07

 system.time(akrun2())
#user  system elapsed 
# 0.018   0.000   0.018 

system.time(Frank())
# user  system elapsed 
# 0.028   0.000   0.028 

system.time(Frank2())
# user  system elapsed 
# 0.018   0.000   0.018 

system.time(MrFlick())
#  user  system elapsed 
#42.725   0.066  42.777 

 system.time(akhmed())
 #user  system elapsed 
 # 1.125   0.004   1.169 


library(microbenchmark)
microbenchmark(akrun(), akrun2(), Frank(), Frank2(), unit='relative', times=20L)
#Unit: relative
# expr      min       lq     mean   median        uq      max neval cld
# akrun() 3.732126 3.822714 3.768758 3.784908 3.7490118 3.448839    20   c
#akrun2() 1.000000 1.000000 1.000000 1.000000 1.0000000 1.000000    20 a  
# Frank() 1.457337 1.455412 1.672008 1.493600 1.6575381 3.697565    20  b 
# Frank2() 1.001986 1.005541 1.003171 1.003474 0.9980418 1.013425    20 a