从数据框中提取带条件的列名

Question

dput(new)
structure(list(ID = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 
13, 14, 15, 16, 17, 18, 19, 20, 21, 22), A1 = c(1, 1, 1, 1, 0, 
0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), A2 = c(1, 
1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), A3 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0), A4 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0), A5 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0), A6 = c(0, 0, 0, 0, 0, 
0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), A7 = c(0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0
), A8 = c(0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 
1, 1, 1, 0, 0), A9 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0)), row.names = c(NA, -22L), class = c("tbl_df", 
"tbl", "data.frame"))

I have the following data frame. I need to extract and print the id's and comma separated column names where 1 is appearing. For example:

1 A1,A2
2 A1,A2
3 A1
4 A1
6 A2,A8
7 A6,A8

and so on...

How to proceed?

This is my attempt:

vec_ID <- c()
vec_JOB <- c()
job <- 0
for(i in 1 : length(ID)){
  for(j in 2:10){
    if(new[i,j]==1){
      vec_ID[i] <- ID[i] 
    }
  }
}
print(vec_ID)
vec_ID <- vec_ID[!is.na(vec_ID)]
#vec_ID <- as.data.frame(vec_ID)
print(vec_ID)

new_df <- new[ID[vec_ID],]
View(new_df)

for (i in 1:nrow(vec_ID)) {

}

Answer 1

You can do:

apply(df[-1], 1, function(x) toString(names(df[-1])[as.logical(x)]))

 [1] "A1, A2" "A1, A2" "A1"     "A1"     ""       "A2, A8" "A6, A8" "A1, A8" "A6, A8" "A8"     "A1, A8" "A6"    
[13] "A5, A8" ""       "A8"     "A8"     "A8"     "A8"     "A8"     "A8"     "A7"     ""

Answer 2

Something like this?

apply(new[,-1],1,function(x){
  paste0(colnames(new)[which(x==1)+1],collapse=",")
})

 [1] "A1,A2" "A1,A2" "A1"    "A1"    ""      "A2,A8" "A6,A8" "A1,A8" "A6,A8" "A8"    "A1,A8" "A6"   
[13] "A5,A8" ""      "A8"    "A8"    "A8"    "A8"    "A8"    "A8"    "A7"    ""

Answer 3

We can get the data in long format, filter rows where value is not 0, group_by ID and create a comma-separated value of each column name.

library(dplyr)

new %>%
  tidyr::pivot_longer(cols = -ID) %>%
  filter(value != 0) %>%
  group_by(ID) %>%
  summarise(name = toString(name))

# A tibble: 19 x 2
#      ID name  
#   <dbl> <chr> 
# 1     1 A1, A2
# 2     2 A1, A2
# 3     3 A1    
# 4     4 A1    
# 5     6 A2, A8
# 6     7 A6, A8
# 7     8 A1, A8
# 8     9 A6, A8
# 9    10 A8    
#10    11 A1, A8
#.....

Answer 4

Here is a one liner via base R using stack and aggregate ,

aggregate(ind ~ ID, 
          subset(cbind(ID = new$ID, stack(replace(new, new == 0, '')[-1])), values == 1), 
          toString)

which gives,

 ID ind 1 1 A1, A2 2 2 A1, A2 3 3 A1 4 4 A1 5 6 A2, A8 6 7 A6, A8 7 8 A1, A8 8 9 A6, A8 9 10 A8 10 11 A1, A8 11 12 A6 12 13 A5, A8 13 15 A8 14 16 A8 15 17 A8 16 18 A8 17 19 A8 18 20 A8 19 21 A7

Answer 5

Here is a purrr solution:

is_one <- function(x) all(x == 1)

df %>% 
   nest(-ID) %>% 
   mutate(eval = purrr::map_chr(data, ~ paste0(.x %>% 
                                             dplyr::select_if(is_one) %>%  
                                             names(.), collapse = ", ")))

# A tibble: 22 x 3
      ID           data eval  
   <dbl> <list<df[,9]>> <chr> 
 1     1        [1 x 9] A1, A2
 2     2        [1 x 9] A1, A2
 3     3        [1 x 9] A1    
 4     4        [1 x 9] A1    
 5     5        [1 x 9] ""    
 6     6        [1 x 9] A2, A8
 7     7        [1 x 9] A6, A8
 8     8        [1 x 9] A1, A8
 9     9        [1 x 9] A6, A8
10    10        [1 x 9] A8 

Answer 6

Here is another solution.

x <- apply(df[-1]!=0, 1, function(x) paste(names(df[-1])[x], collapse=","))
names(x) <- df$ID
cbind(x)               # or cbind(x[x!=""]) if you want to remove empty strings

#    x      
# 1  "A1,A2"
# 2  "A1,A2"
# 3  "A1"   
# 4  "A1"   
# 5  ""     
# 6  "A2,A8"
# 7  "A6,A8"
# 8  "A1,A8"
# 9  "A6,A8"
# 10 "A8"   
# 11 "A1,A8"
# 12 "A6"   
# 13 "A5,A8"
# 14 ""     
# 15 "A8"   
# 16 "A8"   
# 17 "A8"   
# 18 "A8"   
# 19 "A8"   
# 20 "A8"   
# 21 "A7"   
# 22 ""