कुशल संकुचित डमी चर

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 यकीन है/डेटा.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() को केवल "सूची" दिखाने के लिए शामिल किया- यह संरचना कुशल लूपिंग पर सुविधाजनक हो सकती है। उदाहरण के लिए, बाय-पंक्ति लूपिंग के विपरीत, कॉलम लूपिंग का उपयोग करने का एक तरीका डेटा की संरचना को बदलने के लिए समय की आवश्यकता नहीं है।

Answer 2

हम max.col उपयोग कर सकते हैं स्तंभ अनुक्रमणिका प्राप्त करने के लिए, स्तंभ के आधार पर नाम सबसेट और sub का उपयोग उपसर्ग दूर करने के लिए।

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

यहाँ, मैं मान लिया है कि वहाँ एक भी 1 प्रत्येक पंक्ति प्रति। यदि एकाधिक 1s हैं, तो हम 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)])])