如何根據字符串模式將 dataframe 的所有列拆分為不同的組，並將 function 應用於每組列？

Question

library(glue)
library(tidyverse)

data = crossing(id = c(1:4),q = letters[1:5], nums = c(1:10))
set.seed(25)
data$val = sample(c(NA,"foo", "bar"), nrow(data), prob = c(0.95,0.02,0.03), replace = T)
data = data %>% mutate(q = glue("{q}{nums}")) %>% 
  select(-nums) %>% 
  pivot_wider(id_cols = id, names_from = q, values_from = val)

#Output Im looking for
data %>% 
  select(id,starts_with("a")) %>% 
  mutate(
    a_none = apply(.[,grep("a", names(.))],  1, function(x) all(is.na(x)))
  )

我想創建與 b_none、c_none 等類似的列。 在發布問題時，我想到了運行循環並得到答案。 我也會補充一下。

Answer 1

您可以使用split.default根據相似的命名列拆分 dataframe 並使用purrr中的imap來獲取每個組的邏輯值。

library(dplyr)
library(purrr)

result <- split.default(data[-1], sub('\\d+', '', names(data)[-1])) %>%
  imap_dfc(~.x %>% transmute(!!paste0(.y, '_none') := rowSums(!is.na(.)) == 0))
result

#  a_none b_none c_none d_none e_none
#  <lgl>  <lgl>  <lgl>  <lgl>  <lgl> 
#1 FALSE  FALSE  TRUE   TRUE   FALSE 
#2 TRUE   TRUE   TRUE   TRUE   TRUE  
#3 FALSE  TRUE   TRUE   TRUE   FALSE 
#4 FALSE  TRUE   TRUE   FALSE  FALSE 

如果您想將此作為新列添加到原始數據中，您可以執行以下操作：

data <- bind_cols(data, result)

---

要將其保留在基礎 R 中，您可以使用sapply代替imap ：

sapply(split.default(data[-1], sub('\\d+', '', names(data)[-1])), 
       function(x) rowSums(!is.na(x)) == 0)

Answer 2

for (pattern in letters[1:5]) {
  varname = glue("{pattern}_none")
  data[[varname]] = apply(data[,grep(pattern, names(data))],  1, function(x) all(is.na(x)))
}

這個 for 循環為我完成了這項工作。 有更好的想法嗎？

我嘗試使用dput()插入 output 但失敗了。