Эффективно объединить несколько двоичных / категориальных столбцов в один категориальный столбец в R

Question

Прежде всего, я в курсе связанных вопросов / ответов, расположенных на следующих страницах.

Преобразовать несколько двоичных столбцов в один категориальный столбец

Для каждой строки вернуть имя столбца наибольшего значения

ОднакоМой вопрос немного отличается, и эти решения выше не будут работать для меня.

Учитывая набор данных с двоичными переменными, которые могут перекрываться, каков наиболее эффективный способ объединить их в один категориальный столбец?

В качестве простого примера рассмотрим следующий набор данных

set.seed(12345)
d1<-data.frame(score=rnorm(10),
               Male=sample(c(rep(1,5), rep(0,5))), 
               White=sample(c(rep(1,5),rep(0,5))), 
               college_ed = rep(c(1,0),5))

head(d1,5)

      score   Male   White college_ed
1  0.5855288    1     0          1
2  0.7094660    1     1          0
3 -0.1093033    0     1          1
4 -0.4534972    0     1          0
5  0.6058875    1     1          1

Цель здесь - создать новый столбец, в котором имена всех столбцов будут равны единице.

Пока что это лучшее решение, которое я придумала, но я волнуюсь, оно немного грубое и может быть неэффективным, если его применять к гораздо большему набору данных.

 grp_name<-function(x){
   if(sum(x)==0){
   z<- "None"
   }else{
   z<-paste(names(x[x==1]),collapse= "-")
   }
   return(z)
   }


d1$demo<-apply(d1,1,grp_name)

     score    Male   White    college_ed        demo
1  0.5855288    1     0          1       Male-college_ed
2  0.7094660    1     1          0            Male-White
3 -0.1093033    0     1          1      White-college_ed
4 -0.4534972    0     1          0                 White
5  0.6058875    1     1          1 Male-White-college_ed

Кто-нибудь знает о некоторых пакетах для этой проблемы или есть предложения по ускорению кода?

Answer 1

Не идеальное решение, но оно должно помочь вам быстрее.Оператор if не векторизован, а ifelse (): см. Ниже .... нет необходимости использовать функцию apply.

set.seed(12345)
d1<-data.frame(score=rnorm(10),
               Male=sample(c(rep(1,5), rep(0,5))), 
               White=sample(c(rep(1,5),rep(0,5))), 
               college_ed = rep(c(1,0),5))

head(d1,5)

makeKey <- function(x,y,z){
  s1 <- ifelse(x == 1,"Male", "")
  s2 <- ifelse(y == 1, "White", "")
  s3 <- ifelse(z == 1, "college_ed", "")
  s4 <- paste(s1,s2,s3, sep = "-" )
  return(s4)
}

d1$key <- makeKey(x=d1$Male, y=d1$White, z=d1$college_ed)