Verimli Daralt Kukla Değişkenler

Question

Kukla değişkenleri bir faktöre geri döndürmek için verimli bir yol (temel olmayan paketler dahil herhangi bir çözüm) nedir?

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 

İstenilen çıktı:

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

veri:

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") 

Denedim Ne:

Bu olası çözüm ama daha iyi bir indeksleme/dplyr var eminim/data.table/.etc çözümü.

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

Answer 1

Başka fikri kullanabilirsiniz:

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" 

Ve akrun en alternatifleri ile karşılaştırmak için:

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 

Sadece "liste" -y yapılarının olduğu gibi verimli döngüde kullanışlı olabileceğini göstermek için as.matrix() ve col() dahil ettim. Örneğin, bir satır-içi döngüden farklı olarak, sütun-içi döngüyü kullanmanın bir yolu, veri yapısını dönüştürmek için zamana ihtiyaç duymaz.

Answer 2

Biz, sütun indeksi almak için max.col kullandığını göre sütun adlarını alt küme ve öneki kaldırmak için sub kullanabilirsiniz.

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

İşte, her satır başına tek 1 olduğunu varsaydık. Birden çok 1 varsa, ties.method='first' veya ties.method='last' seçeneğini kullanabiliriz.

---

Veya başka bir seçenek sütun dizisi ile %*% yapıyor, sütun adları alt küme ve sub ile önek çıkarın.

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

---

Ya da pmax

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