使用 `case_when` 和 %in% 汇总 R 中的多个列

Question

我有数据记录列名中的特征（在下面的示例中是动物）和单元格值中的频率。我想将这两个重新编码为更少的类别，以便将几个列分组为类别（在示例中它们是“狗”和“鸟”），并且频率被重新编码如下：

• 如果任何原始列包含“每日”或“每周”或“每月”→“定期”

• else if ≥one column is "Rarely" → "Rarely"

• else if ≥one column is "Never" → "Never"

事实证明，计算起来很棘手，因为它不是简单地对列值进行平均或取最大值。

到目前为止我已经尝试过什么

library(tidyverse)

data <- tibble::tribble(
  ~labrador,  ~beagle,    ~corgi,  ~pigeon, ~sparrow,   ~robin,
   "Weekly", "Rarely",   "Never", "Rarely",  "Never", "Rarely",
    "Never",  "Never", "Monthly",  "Never",  "Never",  "Never",
   "Rarely",  "Never",   "Never", "Weekly",  "Never",  "Daily"
  )

data %>% 
  mutate(dogs = case_when(
    c(labrador, beagle,  corgi) %in% 
      c("Daily", "Weekly", "Monthly") ~ "Regularly",
    c(labrador, beagle,  corgi) %in% 
      "Rarely" ~ "Rarely",
    c(labrador, beagle,  corgi) %in% 
      "Never" ~ "Never"
  )) %>% 
  mutate(birds = case_when(
    c(pigeon, sparrow, robin) %in% 
      c("Daily", "Weekly", "Monthly") ~ "Regularly",
    c(pigeon, sparrow, robin) %in% 
      "Rarely" ~ "Rarely",
    c(pigeon, sparrow, robin) %in% 
      "Never" ~ "Never"
  ))

#> Error: Problem with `mutate()` column `dogs`.
#> ℹ `dogs = case_when(...)`.
#> ℹ `dogs` must be size 3 or 1, not 9.

^{由reprex package (v2.0.0) 于 2021-08-13 创建}

我猜这个错误意味着我对case_when() 做错了，因此它试图将 9 个值传递给dogs。目前我正在尝试检查任何输入列是否具有特定值（首先是“每日”、“每周”、“每月”），并分配所需的分组列值（“定期”）这三个频率，如果没有，请检查任何输入列是否为“很少”等。

我想要达到的目标

输入数据：

labrador	beagle	corgi	pigeon	sparrow	robin
Weekly	Rarely	Never	Rarely	Never	Rarely
Never	Never	Monthly	Never	Never	Never
Rarely	Never	Never	Weekly	Never	Daily

期望的输出df：

labrador	beagle	corgi	pigeon	sparrow	robin	dogs	birds
Weekly	Rarely	Never	Rarely	Never	Rarely	Regularly	Rarely
Never	Never	Monthly	Never	Never	Never	Regularly	Never
Rarely	Never	Never	Weekly	Never	Daily	Rarely	Regularly

我想保持行的完整性（真实数据的列包含示例中未包含的更多信息），因此频率统计不会真正有帮助。在真实数据中还有更多的列和组，但如果我可以通过示例解决它，我应该能够将其扩展到那个。

Answer 1

试试这个：

func <- function(..., values) {
  mtx <- do.call(cbind, list(...))
  mtx <- array(mtx %in% values, dim = dim(mtx))
  rowSums(mtx) > 0
}

data %>%
  mutate(dogs = case_when(
    func(labrador, beagle, corgi, values = c("Daily", "Weekly", "Monthly")) ~ "Regularly", 
    func(labrador, beagle, corgi, values = c("Rarely")) ~ "Rarely", 
    func(labrador, beagle, corgi, values = c("Never")) ~ "Never" ),
  birds = case_when(
    func(pigeon, sparrow, robin, values = c("Daily", "Weekly", "Monthly")) ~ "Regularly", 
    func(pigeon, sparrow, robin, values = c("Rarely")) ~ "Rarely", 
    func(pigeon, sparrow, robin, values = c("Never")) ~ "Never" )
  )
# # A tibble: 3 x 8
#   labrador beagle corgi   pigeon sparrow robin  dogs      birds    
#   <chr>    <chr>  <chr>   <chr>  <chr>   <chr>  <chr>     <chr>    
# 1 Weekly   Rarely Never   Rarely Never   Rarely Regularly Rarely   
# 2 Never    Never  Monthly Never  Never   Never  Regularly Never    
# 3 Rarely   Never  Never   Weekly Never   Daily  Rarely    Regularly

---

不需要func 的替代方案，而是双pivoting。

library(tidyr) # pivot_*
data <- mutate(data, rn = row_number())
data %>%
  pivot_longer(-rn) %>%
  mutate(species = case_when(name %in% c("labrador", "beagle", "corgi") ~ "dogs", name %in% c("pigeon", "sparrow", "robin") ~ "birds", TRUE ~ "other")) %>%
  group_by(rn, species) %>%
  summarize(total = case_when(any(value %in% c("Daily", "Weekly", "Monthly")) ~ "Regularly", any(value %in% c("Rarely")) ~ "Rarely", any(value %in% c("Never")) ~ "Never", TRUE ~ "unk")) %>%
  ungroup() %>%
  pivot_wider(rn, names_from = species, values_from = total) %>%
  left_join(data, ., by = "rn")
# # A tibble: 3 x 9
#   labrador beagle corgi   pigeon sparrow robin     rn birds     dogs     
#   <chr>    <chr>  <chr>   <chr>  <chr>   <chr>  <int> <chr>     <chr>    
# 1 Weekly   Rarely Never   Rarely Never   Rarely     1 Rarely    Regularly
# 2 Never    Never  Monthly Never  Never   Never      2 Never     Regularly
# 3 Rarely   Never  Never   Weekly Never   Daily      3 Regularly Rarely