在数据框列中搜索单个字符串的元素以对其进行子集化

Question

我有两个数据框：

set.seed(1)
df1 <- data.frame(k1 = "AFD(1);Acf(2);Vgr7(2);"
                  ,k2 = "ABC(7);BHG(46);TFG(675);")

df2 <- data.frame(site =c("AFD(1);AFD(2);", "Acf(2);", "TFG(677);", 
"XX(275);",  "ABC(7);", "ABC(9);")
                  ,p1 = rnorm(6, mean = 5, sd = 2)
                  ,p2 = rnorm(6, mean = 6.5, sd = 2))

第一个数据帧实际上是一个通常很长的字符串列表，由“元素”组成。每个“元素”由几个字母/数字组成，后跟括号中的数字，再后跟分号。在这个例子中，我只将 3 个“元素”放入每个字符串中，但在我的真实数据框中有数十到数百个。

> df1
                      k1                       k2
1 AFD(1);Acf(2);Vgr7(2); ABC(7);BHG(46);TFG(675);

第二个数据框与df1 共享一些“元素”。它的第一列称为site，包含来自第一个数据帧的一些（不是全部）“元素”，有时“元素”形成整个字符串，有时是更长字符串的一部分：

> df2
            site       p1       p2
1 AFD(1);AFD(2); 4.043700 3.745881
2        Acf(2); 5.835883 5.670011
3      TFG(677); 7.717359 5.711420
4       XX(275); 4.794425 6.381373
5        ABC(7); 5.775343 8.700051
6        ABC(9); 4.892390 8.026351

我想使用df2$site和df1中的每个k列过滤整个df2（有很多K列，并非所有列的名称中都包含k）。

解释这一点的最简单方法是展示所需输出的外观。

> outcome
    k   site            p1          p2
1   k1  AFD(1);AFD(2):  4.043700    3.745881
2   k1  Acf(2);         5.835883    5.670011
3   k2  ABC(7);         5.775343    8.700051

outcome 数据框的第一列对应于df1 中的列名。第二列对应于 df2 的 site 列，并且仅包含来自 df1 列的 sites，这些列在 df2$sites 中找到。其他专栏来自df2。

我很欣赏这个问题是由两个独立的“问题”组成的，一个与 grepping 相关，另一个与遍历 df1 列相关。我决定完整地展示这个任务，以防存在一个同时解决这两个问题的解决方案。

失败的解决方案 1

我可以为 grep 创建一个字符串，但对于每一列分别：

# this replaces the semicolons with "|", but does not escape the brackets.
k1_pattern <- df1 %>% 
  select(k1) %>% 
  deframe() %>% 
  str_replace_all(";","|")

然后我不确定如何使用它。这（下面）没有用，也许是因为我没有转义括号，但我正在努力这样做：

k1_result <- df2 %>% 
  filter(grepl(pattern = k1_pattern, site))

但即使它确实有效，它也只会处理来自df1 的单个列，而我有很多列，并且希望同时对所有df1 列执行此操作。

失败的解决方案 2

我可以创建一个 sites 的列表，以从 df1 的列中搜索 df2：

k1_sites<- df1 %>% 
  select(k1) %>% 
  deframe() %>% 
  strsplit(., "[;]") %>% 
  unlist()

但是分隔符在这里丢失了，不能使用%in%，因为匹配有时会是部分的。

Answer 1

library(dplyr)

df2 %>% 
  mutate(site_list = strsplit(site, ";")) %>% 
  rowwise() %>% 
  filter(length(intersect(site_list,
                              unlist(strsplit(x = paste0(c(t(df1)), collapse=""), 
                                              split = ";")))) != 0) %>% 
  select(-site_list)

#> # A tibble: 3 x 3
#> # Rowwise: 
#>   site              p1    p2
#>   <chr>          <dbl> <dbl>
#> 1 AFD(1);AFD(2);  3.75  7.47
#> 2 Acf(2);         5.37  7.98
#> 3 ABC(7);         5.66  9.52

更新的答案：

library(dplyr)
library(tidyr)

df1 %>% 
  rownames_to_column("id") %>% 
  pivot_longer(-id, names_to = "k", values_to = "site") %>% 
  separate_rows(site, sep = ";") %>% 
  filter(site != "") %>% 
  select(-id) -> df1_k


df2 %>% 
  tibble::rownames_to_column("id") %>% 
  separate_rows(site, sep = ";") %>% 
  full_join(., df1_k, by = c("site")) %>% 
  group_by(id) %>% 
  fill(k, .direction = "downup") %>% 
  filter(!is.na(id) & !is.na(k)) %>% 
  summarise(k = first(k), 
            site = paste0(site, collapse = ";"),
            p1 = first(p1),
            p2 = first(p2), .groups = "drop") %>% 
  select(-id)

#> # A tibble: 3 x 4
#>   k     site              p1    p2
#>   <chr> <chr>          <dbl> <dbl>
#> 1 k1    AFD(1);AFD(2);  3.75  7.47
#> 2 k1    Acf(2);         5.37  7.98
#> 3 k2    ABC(7);         5.66  9.52

Answer 2

这是一种使用长格式进行精确匹配的方法（因此没有正则表达式）：

library(dplyr)
library(tidyr)
df1_long = df1 |> stack() |>
  separate_rows(values, sep = ";") |>
  filter(values != "")

df2 |>
  mutate(id = row_number()) |>
  separate_rows(site, sep = ";") |>
  filter(site != "") |>
  left_join(df1_long, by = c("site" = "values")) %>%
  group_by(id) |>
  filter(any(!is.na(ind))) %>%
  summarize(
    site = paste(site, collapse = ";"),
    across(-site, (x) first(na.omit(x)))
  )
# # A tibble: 3 × 5
#      id site             p1    p2 ind  
#   <int> <chr>         <dbl> <dbl> <fct>
# 1     1 AFD(1);AFD(2)  3.75  7.47 k1   
# 2     2 Acf(2)         5.37  7.98 k1   
# 3     5 ABC(7)         5.66  9.52 k2