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

How to check condition based on a variable match

假设我有这些数据:

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 告诉这个人是否能够购买他们喜欢的宠物。

此外,在某些情况下,不会有 pet_ 列匹配 personpet。在这些情况下,match 应该是 0

请注意,对于一个人来说,比如 Jill,其他人的价值观完全不相关,pet_ 列与 Jill 的 [=18] 不对应=]值。

这是想要的结果:

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

我该怎么做?

请注意,我认为这将涉及使用 getassignpaste0 之类的东西将此人的 pet 值放入变量中,然后转到此列并提取相关值并将其放入 match.

选项 tidyverse

  1. 使用 pivot_longer
  2. 重塑为长格式
  3. 子集 value 为 1 的行
  4. 通过将 'pet' 中的子字符串与 'name' 列匹配来创建一个逻辑列 - str_detect
  5. 按'pet'分组,检查'match'中是否有any TRUE,强制转为二进制(+)
  6. 加入原始数据集 - right_join
  7. 如果我们想保持原始数据的顺序,请创建一个序列列 (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. 的列名进行子集化
  5. 删除子字符串 'pet_' - str_remove
  6. 通过连接它们创建一个字符串 - str_c
  7. 删除组属性 (ungroup) 并使用 str_detect 检测 'pet' 列值是否与创建的正则表达式模式匹配
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. Select 包含 'pet_' (nm1)
  2. 的列名
  3. 根据行的顺序创建一个row/column索引,并match使用'pet'列
  4. 对列名的子字符串进行排序
  5. 用2作为一个matrix
  6. 从选中的数据列中获取对应的元素
  7. 将 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