高效折叠虚拟变量

Question

什么是一种有效的方法(欢迎包括非基础包的任何解决方案)将虚拟变量折叠回一个因子.

   race.White race.Hispanic race.Black race.Asian
1           1             0          0          0
2           0             0          0          1
3           1             0          0          0
4           0             0          1          0
5           0             0          0          1
6           0             1          0          0
7           1             0          0          0
8           1             0          0          0
9           1             0          0          0
10          0             0          1          0

期望的输出:

       race
1     White
2     Asian
3     White
4     Black
5     Asian
6  Hispanic
7     White
8     White
9     White
10    Black

数据:

dat <- structure(list(race.White = c(1L, 0L, 1L, 0L, 0L, 0L, 1L, 1L, 
1L, 0L), race.Hispanic = c(0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 
0L), race.Black = c(0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 1L), 
    race.Asian = c(0L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L)), .Names = c("race.White", 
"race.Hispanic", "race.Black", "race.Asian"), row.names = c(NA, 
-10L), class = "data.frame")

我尝试了什么:

这是一个可能的解决方案,但我确信有一个更好的索引/ dplyr/data.table/.etc解决方案.

apply(dat, 1, function(x) sub("[^.]+\\.", "", colnames(dat))[x])

Answer 1

我们可以使用max.col来获取列索引，基于它对列名进行子集化，并用于sub删除前缀。

sub('[^.]+\\.', '', names(dat)[max.col(dat)])
#[1] "White"    "Asian"    "White"    "Black"    "Asian"    "Hispanic"
#[7] "White"    "White"    "White"    "Black"  

在这里，我假设1每行有一个。如果有多个 1，我们可以使用选项ties.method='first'或ties.method='last'。

或者另一种选择是%*%对列的序列进行处理，对列名进行子集化，并使用sub.

 sub('[^.]+\\.', '', names(dat)[(as.matrix(dat) %*%seq_along(dat))[,1]])

或者我们可以使用 pmax

sub('[^.]+\\.', '', names(dat)[do.call(pmax,dat*seq_along(dat)[col(dat)])])

Answer 2

另一个想法：

ff = function(x)
{
    ans = integer(nrow(x))
    for(i in seq_along(x)) ans[as.logical(x[[i]])] = i
    names(x)[ans]
}                                    
sub("[^.]+\\.", "", ff(dat))
#[1] "White"    "Asian"    "White"    "Black"    "Asian"    "Hispanic" "White"    "White"    "White"    "Black"

与 akrun 的替代方案进行比较：

akrun1 = function(x) names(x)[max.col(x, "first")]
akrun2 = function(x) names(x)[(as.matrix(x) %*% seq_along(x))[, 1]]
akrun3 = function(x) names(x)[do.call(pmax, x * seq_along(x)[col(x)])]
akrunlike = function(x) names(x)[do.call(pmax, Map("*", x, seq_along(x)))]

DF = setNames(as.data.frame("[<-"(matrix(0L, 1e4, 1e3), 
                                  cbind(seq_len(1e4), sample(1e3, 1e4, TRUE)), 
                                  1L)), 
              paste("fac", 1:1e3, sep = ""))

identical(ff(DF), akrun1(DF))
#[1] TRUE
identical(ff(DF), akrun2(DF))
#[1] TRUE
identical(ff(DF), akrun3(DF))
#[1] TRUE
identical(ff(DF), akrunlike(DF))
#[1] TRUE
microbenchmark::microbenchmark(ff(DF), akrun1(DF), akrun2(DF), 
                               akrun3(DF), akrunlike(DF), 
                               as.matrix(DF), col(DF), times = 30)
#Unit: milliseconds
#          expr        min         lq     median         uq        max neval
#        ff(DF)   61.99124   64.56194   78.62267  102.18424  152.64891    30
#    akrun1(DF)  296.89042  314.28641  327.95059  353.46185  394.46013    30
#    akrun2(DF)  103.76105  114.01497  120.12191  129.86513  166.13266    30
#    akrun3(DF) 1141.46478 1163.96842 1178.92961 1203.83848 1231.70346    30
# akrunlike(DF)  125.47542  130.20826  141.66123  157.92743  203.42331    30
# as.matrix(DF)   19.46940   20.54543   28.22377   35.69575   87.06001    30
#       col(DF)  103.61454  112.75450  116.00120  126.09138  176.97435    30

我加入as.matrix()只是col()为了表明“list”-y 结构可以方便地按原样进行有效循环。例如，与按行循环相比，使用按列循环的方法不需要时间来转换数据的结构。