Эффективные переменные Dummy Collapse

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

Другая идея:

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(), чтобы показать, что структуры «списка» -y могут быть удобны при эффективном цикле, как есть. Например, в отличие от циклического цикла, способ использования циклического цикла не требует времени для преобразования структуры данных.

Answer 2

Мы можем использовать 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)])])