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是用来引用哪一列是"main" 该观察值 。例如：

  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 包含 main 值。而对于观察 1，ref==a 因此列 a 包含主要值。

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

  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

自答：这是我发现的一个解决方案，可能不是最优雅的，但似乎有效：

library(dplyr)

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

df2

这给了我这个：

  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

我仍然想知道是否可以用一些简单的 mutate_ 来代替？

Answer 2

dplyr 突变一次对整个列进行操作，而这种类型的操作并不适合。一个不同的策略可能是使用 tidyr 库以长格式制作 "tidy" 数据，然后进行子集化。以下是您可以执行此操作的方法。

library(tidyr)
library(dplyr)

getval <- . %>% mutate(id=factor(1:n())) %>% 
    gather(col, val, a:c) %>% group_by(id) %>% 
    summarize(val=first(val[col==ref])) %>% select(val)

df %>% cbind(., getval(.))

这确实假设每个 ref 值都对应于一个存在的列。

Answer 3

这里有一个简单、快速的方法，可以让您坚持使用 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 的 class，因此您不必在以后的链中再次转换为 data.table。

转换应该适用于链中的任何未来代码，但 dplyr 和 data.table 都在积极开发中，因此为了安全起见，可以改用

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

Answer 4

我们可以在 base R 中使用 row/column 索引来做到这一点。我们使用 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

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

dplyr + "meta"-columns: when a column contains names of other columns to use instead of the data

r

dplyr

基准