折叠和交叉数据框

Question

我有两个data.frame，它们都有3列：

1. id - 一个唯一的键

2. target - 分号分隔的唯一值

3. source - 两个data.frame中的每个都相似但不同。

这是模拟数据:

set.seed(1)
df.1 <- data.frame(id=LETTERS[sample(length(LETTERS),10,replace=F)],
                   target=sapply(1:10,function(x) paste(LETTERS[sample(length(LETTERS),5,replace=F)],collapse=";")),
                   source="A",stringsAsFactors=F)

df.2 <- data.frame(id=LETTERS[sample(length(LETTERS),5,replace=F)],
                   target=sapply(1:5,function(x) paste(LETTERS[sample(length(LETTERS),5,replace=F)],collapse=";")),
                   source="B",stringsAsFactors=F)

我正在寻找一个能够将两个data.frame合并，并创建3列的函数：

1. intersected.targets - 这是两个data.frame之间唯一的交集，用分号隔开。

2. source1.targets - 这是第一个data.frame独有的目标值。

3. source2.targets - 这是第二个data.frame独有的目标值。

因此对于以上示例，生成的data.frame将会是：

> res.df
   id intersected.targets sourceA.targets sourceB.targets
1   G                  NA       F;E;Q;I;X            <NA>
2   J                  NA       M;R;X;I;Y            <NA>
3   N                  NA       Y;F;P;C;Z            <NA>
4   U                  NA       K;A;J;U;H            <NA>
5   E                  NA       M;O;L;E;S            <NA>
6   S                  NA       R;T;C;Q;J            <NA>
7   W                  NA       V;Q;S;M;L            <NA>
8   M                  NA       U;A;L;Q;P            <NA>
9   B                  NA       C;H;M;P;I            <NA>
10  X                  NA            <NA>       G;L;S;B;T
11  H                  NA            <NA>       I;U;Z;H;K
12  Y                  NA            <NA>       L;R;J;H;Q
13  O                  NA            <NA>       F;R;C;Z;D
14  L                  V       M;K;F;B       X;J;R;Y

- dan

---

你可以从 library(data.table) ; dcast(rbind(setDT(df.1), setDT(df.2)), id ~ source, value.var = "target") 开始。不确定你在 intersected.targets 列中想要什么，因为你没有在所需的输出中指定它。 - David Arenburg

你不需要进行这个修改（更不用说你的代码没有起作用）因为你已经有一个常见的“V”在那里了。 - David Arenburg

好的，对此表示抱歉。已做出相应修改。 - dan

我猜 @DavidArenburg 只是暂时删除了他的回复并正在编辑，如果是这种情况，我建议他继续使用datatable方法，将源列转换为列表列，然后运行 setdiff，by=id。 - IRTFM

@42- 不好意思，我现在没时间，如果你有解决方案可以发一下。 - David Arenburg

Answer 1

这种数据清洗方式的烦恼就像 @42- 所提到的那样，是将列表的数据帧取消列表。

library(dplyr)
library(stringr)
df <- full_join(df.1, df.2) %>% 
  spread(source, target)  %>%
  mutate(intersect_targets = str_c(A,B,sep = ";"))

df[,4][!is.na(df[,4])] <- names(do.call("c",lapply(df$intersect_targets, function(x) 
which(table(str_split(x, ";"))>1))))

a <- sapply(seq(nrow(df)), function(x) {
str_split(df[x,2:3],";")
})

sa <-  do.call("c",lapply(mapply(setdiff,a[1,], a[2,]),paste0, collapse = ","))
sb <- do.call("c",lapply(mapply(setdiff,a[2,], a[1,]), paste0, collapse = ","))

df[,2:3] <-cbind(sa,sb)

 head(df)
  id         A         B intersect_targets
1  B C,H,M,P,I        NA              <NA>
2  E M,O,L,E,S        NA              <NA>
3  G F,E,Q,I,X        NA              <NA>
4  H        NA I,U,Z,H,K              <NA>
5  J M,R,X,I,Y        NA              <NA>
6  L   M,K,F,B   X,J,R,Y                 V

- shayaa

---

看起来你没有从输入集中删除相交的元素。 - IRTFM

我们可以尝试在非列表版本上使用类似以下的代码：A <- gsub( paste( ";*, intersect_targets), "", A)。在@AM上花费一个小时回答问题，却没有得到任何点赞，这有点令人沮丧，不是吗？ - IRTFM

你已经拥有了。直到现在才有机会从头到尾阅读它。 - shayaa

Answer 2

这是DavidArenberg的已删除答案的延续，教我如何在data.table中创建列表列的概念。我不知道如何逐行正确实现使用setdiff的想法，但最终，在多次搜索后，我找到了Frank的答案来解决这个问题。这是David的（部分）答案：

===== 以下是一个可能的解决方案，使用与其他种子不同的种子，具有多个交集和单个交集中的多个字母。

#Generating Data

set.seed(123)
df.1 <- data.frame(id=LETTERS[sample(length(LETTERS),10,replace=F)],
                   target=sapply(1:10,function(x) paste(LETTERS[sample(length(LETTERS),5,
                                                                replace=F)],collapse=";")),
                   source="A",stringsAsFactors=F)

df.2 <- data.frame(id=LETTERS[sample(length(LETTERS),5, replace=F)],
                   target=sapply(1:5,function(x) paste(LETTERS[sample(length(LETTERS),5, 
                                                               replace=F)],collapse=";")),
                   source="B",stringsAsFactors=F)
#Solution

library(data.table) 
library(stringi)
res <- dcast(rbind(setDT(df.1), setDT(df.2)), id ~ source, value.var = "target")
res[!is.na(A) & !is.na(B), intersected.targets := 
                             stri_extract_all(A, regex = gsub(";", "|", B, fixed = TRUE))]
res

所以我使用了他的列表化代码，将A和B列变成了A2和B2列，它们是A和B的列表版本。

res[ , A2 := stri_extract_all(A, regex = "[[:alpha:]]") ]
 res[ , B2 := stri_extract_all(B, regex = "[[:alpha:]]") ]

接着使用Map()逐行进行差集操作：

res[, SourceA := Map( setdiff, A2, intersected.targets)]
res[, SourceB := Map( setdiff, B, intersected.targets)]
 res
#-------------------------------
    id         A         B intersected.targets        A2        B2   SourceA   SourceB
 1:  A M;S;F;H;X        NA                NULL M,S,F,H,X        NA M,S,F,H,X        NA
 2:  C        NA T;P;R;A;K                NULL        NA T,P,R,A,K        NA T,P,R,A,K
 3:  G        NA G;Q;K;S;C                NULL        NA G,Q,K,S,C        NA G,Q,K,S,C
 4:  H Y;L;Q;N;C        NA                NULL Y,L,Q,N,C        NA Y,L,Q,N,C        NA
 5:  J X;R;P;W;O F;J;O;I;C                   O X,R,P,W,O F,J,O,I,C   X,R,P,W   F,J,I,C
 6:  K D;K;J;I;Z        NA                NULL D,K,J,I,Z        NA D,K,J,I,Z        NA
 7:  Q D;F;L;G;S        NA                NULL D,F,L,G,S        NA D,F,L,G,S        NA
 8:  R        NA L;U;T;S;J                NULL        NA L,U,T,S,J        NA L,U,T,S,J
 9:  T X;G;B;H;U        NA                NULL X,G,B,H,U        NA X,G,B,H,U        NA
10:  U S;N;O;G;D        NA                NULL S,N,O,G,D        NA S,N,O,G,D        NA
11:  W Z;W;Q;S;A        NA                NULL Z,W,Q,S,A        NA Z,W,Q,S,A        NA
12:  X B;L;T;C;M        NA                NULL B,L,T,C,M        NA B,L,T,C,M        NA
13:  Z F;D;S;U;I L;Y;V;U;D                 D,U F,D,S,U,I L,Y,V,U,D     F,S,I     L,Y,V

我会把清理工作留给学生们来完成。

- IRTFM