Variabili fittizie Collapse efficiente

Question

Che cosa è un modo efficiente (qualsiasi soluzione che include pacchetti non di base accolti) per riportare le variabili dummy in un fattore.

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 

output desiderato:

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

dati:

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

Quello che ho cercato:

Questa è una possibile soluzione, ma sono sicuro che ci sia una migliore indicizzazione/dplyr/soluzione data.table/.etc.

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

Answer 1

Un'altra idea:

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" 

E da confrontare con le alternative di 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 

Ho incluso as.matrix() e col() solo per mostrare che le "liste" -y strutture possono essere convenienti su un loop efficiente così com'è. Ad esempio, in contrasto con un loop by-row, un modo per utilizzare il ciclo per colonna non ha bisogno di tempo per trasformare la struttura dei dati.

Answer 2

Possiamo usare max.col per ottenere l'indice di colonna, sottoinsieme i nomi delle colonne basati su tale e utilizzare sub per rimuovere il prefisso.

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

Qui, ho pensato che ci sia una sola 1 per ogni riga. Se sono presenti più 1, è possibile utilizzare l'opzione ties.method='first' o ties.method='last'.

---

o un'altra opzione sta facendo la %*% con la sequenza delle colonne, sottoinsieme i nomi delle colonne, e rimuovere il prefisso con sub.

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

---

Oppure possiamo usare pmax

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