如何根据变量匹配检查条件

Question

假设我有这些数据：

data <- tibble(person=c("Jack", "Jill", "Bill"), pet=c("dog", "cat", "zebra"), pet_cat=c(0,1,0), pet_dog=c(0,1,1), pet_llama=c(1,1,1))

  person pet   pet_cat pet_dog pet_llama
  <chr>  <chr>   <dbl>   <dbl>     <dbl>
1 Jack   dog         0       0         1
2 Jill   cat         1       1         1
3 Bill   zebra       0       1         1

我想做的是，对于每个人，首先找出他们拥有的宠物（Jack 有一只狗），然后转到包含此宠物的列（对于 Jack，这是 pet_dog 列） .然后创建一个新列match，它复制pet_ 列中的值（对于Jack，这是0，因为pet_dog 的Jack 值是0）。不确定这是否有必要，但考虑这一点的一种方法是，pet 指的是person 对宠物的偏好，pet_ 列指的是宠物商店中宠物的可用性，并且match 告诉该人是否能够购买他们喜欢的宠物。

此外，在某些情况下，不会有与person 的pet 匹配的pet_ 列。在这些情况下，match 应该是 0。

请注意，对于一个人，比如Jill，其他人的值是完全不相关的，与Jill 的pet 值不对应的pet_ 列也是如此。

这是想要的结果：

data_want <- tibble(person=c("Jack", "Jill", "Bill"), pet=c("dog", "cat", "zebra"), pet_cat=c(0,1,0), pet_dog=c(0,1,1), pet_llama=c(1,1,1), match=c(0, 1, 0))

  person pet   pet_cat pet_dog pet_llama match
  <chr>  <chr>   <dbl>   <dbl>     <dbl> <dbl>
1 Jack   dog         0       0         1     0
2 Jill   cat         1       1         1     1
3 Bill   zebra       0       1         1     0

我该怎么做？

请注意，我认为这将涉及使用get 或assign 与paste0 结合将人的pet 值放入变量中，然后转到此列并提取相关值并将其放入match.

Answer 1

tidyverse 的选项

1. 使用pivot_longer 重塑为长格式
2. 子集value 为 1 的行
3. 通过将 'pet' 中的子字符串与 'name' 列匹配来创建一个逻辑列 - str_detect
4. 按'pet'分组，检查'match'中是否有anyTRUE，强制转换为二进制（+）
5. 加入原始数据集 - right_join
6. 如果我们想保留原始数据的顺序，请创建一个序列列 (row_number()) 并对行进行排序 (arrange)

library(dplyr)
library(tidyr)
library(stringr)
data %>%
     pivot_longer(cols = contains('_')) %>% 
     filter(value == 1) %>% 
     mutate(match = str_detect(name, pet)) %>%
     group_by(pet) %>%
     summarise(match = +(any(match))) %>% 
     right_join(data %>% 
                   mutate(rn = row_number())) %>% 
     arrange(rn) %>% 
     select(names(data), match)

-输出

# A tibble: 3 x 6
  person pet   pet_cat pet_dog pet_llama match
  <chr>  <chr>   <dbl>   <dbl>     <dbl> <int>
1 Jack   dog         0       0         1     0
2 Jill   cat         1       1         1     1
3 Bill   zebra       0       1         1     0

---

或者可以使用rowwise

1. 创建rowwise 属性 - 按行分组
2. 使用c_across 创建一个逻辑向量，即值为1
3. 使用逻辑索引对starts_with'pet_'`的列名进行子集化，
4. 删除子字符串 'pet_' - str_remove
5. 通过连接它们创建单个字符串 - str_c
6. 删除组属性 (ungroup) 并使用 str_detect 检测“宠物”列值是否与创建的正则表达式模式匹配

data %>%
   rowwise %>% 
   mutate(match =  str_c(str_remove(names(select(cur_data(), 
      contains('_')))[c_across(contains("_")) == 1], ".*_"), 
          collapse="|")) %>%
   ungroup %>% 
   mutate(match = +(str_detect(pet, match)))
# A tibble: 3 x 6
  person pet   pet_cat pet_dog pet_llama match
  <chr>  <chr>   <dbl>   <dbl>     <dbl> <int>
1 Jack   dog         0       0         1     0
2 Jill   cat         1       1         1     1
3 Bill   zebra       0       1         1     0

---

或使用base R

1. 选择包含 'pet_' (nm1) 的列名
2. 根据行序列和match将列名的子字符串与“pet”列创建行/列索引
3. 使用2作为matrix，从选定的数据列中获取对应的元素
4. 将 NA（即不匹配）的元素替换为 0

nm1 <- names(data)[startsWith(names(data), "pet_")]
data$match <- as.data.frame(data[nm1])[cbind(seq_len(nrow(data)), 
       match(data$pet, sub("pet_", "", nm1)))]
data$match[is.na(data$match)] <- 0

-输出

data
# A tibble: 3 x 6
  person pet   pet_cat pet_dog pet_llama match
  <chr>  <chr>   <dbl>   <dbl>     <dbl> <dbl>
1 Jack   dog         0       0         1     0
2 Jill   cat         1       1         1     1
3 Bill   zebra       0       1         1     0