Get vector of column names depending on logicals of same dataframe - r

Question

I have a named dataframe containig logicals with missings and I want to get a vector with the column names where values are TRUE (going down the rows and, if multiple TRUEs in one row, going from left to right). Here an example:
df <- data.frame(a= c(FALSE, NA, TRUE, TRUE),
b= c(TRUE, FALSE, FALSE, NA),
c= c(TRUE, TRUE, NA, NA))
df
# a b c
# 1 FALSE TRUE TRUE
# 2 NA FALSE TRUE
# 3 TRUE FALSE NA
# 4 TRUE NA NA
expected <- c("b", "c", "c", "a", "a")
Going from first to last row we see TRUE in the first row. Here are multiple TRUEs, thus we go from left to right and get "b" and "c". In second tow we get "c", and so on.
How to do this (in an elegant way)?

Answer 1

You can do in base R:
pos <- which(t(df) == TRUE, arr.ind = TRUE)
names(df)[pos[, "row"]]
[1] "b" "c" "c" "a" "a"

Answer 2

You can also try using apply
unlist(apply(df, 1, function(x){na.omit(names(df)[x])}))
[1] "b" "c" "c" "a" "a"

Answer 3

Here is a tidyverse way:
library(dplyr)
library(tidyr)
vector <- df %>%
mutate(across(, ~case_when(.==TRUE ~ cur_column()), .names = 'new_{col}')) %>%
unite(New_Col, starts_with('new'), na.rm = TRUE, sep = ', ') %>%
separate_rows(New_Col) %>%
pull(New_Col)
Or:
library(dplyr)
library(tidyr)
df %>%
mutate(across(, ~case_when(.==TRUE ~ cur_column()))) %>%
pivot_longer(everything()) %>%
na.omit() %>%
pull(value)
[1] "b" "c" "c" "a" "a"

Answer 4

Another possible solution, based on purrr::pmap:
library(tidyverse)
pmap(df, ~ names(df)[c(...)] %>% na.omit) %>% unlist
#> [1] "b" "c" "c" "a" "a"

Answer 5

You can use %%(modulo) to identify the column indices.
names(df)[(which(t(df)) - 1) %% ncol(df) + 1]
# [1] "b" "c" "c" "a" "a"
Benchmark
df <- as.data.frame(matrix(sample(c(TRUE, FALSE, NA), 1e7, TRUE), 1e5, 1e2))
# A data.frame: 100,000 × 100
# V1 V2 V3 V4 V5 ...
# 1 TRUE TRUE NA FALSE FALSE ...
# 2 NA TRUE TRUE TRUE NA ...
# 3 NA FALSE FALSE FALSE TRUE ...
# 4 NA FALSE FALSE TRUE FALSE ...
# 5 NA FALSE FALSE FALSE TRUE ...
library(microbenchmark)
bm <- microbenchmark(
Darren = {
x1 <- names(df)[(which(t(df)) - 1) %% ncol(df) + 1]
}, Clemsang = {
x2 <- names(df)[which(t(df) == TRUE, arr.ind = TRUE)[, "row"]]
})
all(x1 == x2)
# [1] TRUE
bm
# Unit: milliseconds
# expr min lq mean median uq max neval
# Darren 140.5595 153.3333 163.7934 159.4783 167.5418 284.4146 100
# Clemsang 219.7802 242.6169 254.9226 250.8673 264.0462 356.9299 100