今天在使用连接操作时发现:虽然都是合并操作函数,dplyr 包里的 *_join()
和基础包里面的 merge()
存在差异,不同的数据结构,结果也会存在偏差。
下面是一个可重复的例子,构造两个数据集,一个是基于 data.frame
的列表,另一个是就要 data.table
的列表:
x <- list(
a = data.frame(r1 = c("S1", "S2"), r3 = c("S2", "S1")),
b = data.frame(r1 = c("S1", "S2"), r5 = c("S2", "S1")),
c = data.frame(r2 = c("S1", "S2"), r4 = c("S2", "S1")),
d = data.frame(r4 = c("S1", "S2"), r5 = c("S2", "S1"))
)
str(x)
#> List of 4
#> $ a:'data.frame': 2 obs. of 2 variables:
#> ..$ r1: chr [1:2] "S1" "S2"
#> ..$ r3: chr [1:2] "S2" "S1"
#> $ b:'data.frame': 2 obs. of 2 variables:
#> ..$ r1: chr [1:2] "S1" "S2"
#> ..$ r5: chr [1:2] "S2" "S1"
#> $ c:'data.frame': 2 obs. of 2 variables:
#> ..$ r2: chr [1:2] "S1" "S2"
#> ..$ r4: chr [1:2] "S2" "S1"
#> $ d:'data.frame': 2 obs. of 2 variables:
#> ..$ r4: chr [1:2] "S1" "S2"
#> ..$ r5: chr [1:2] "S2" "S1"
x2 <- list(
a = data.table::data.table(r1 = c("S1", "S2"), r3 = c("S2", "S1")),
b = data.table::data.table(r1 = c("S1", "S2"), r5 = c("S2", "S1")),
c = data.table::data.table(r2 = c("S1", "S2"), r4 = c("S2", "S1")),
d = data.table::data.table(r4 = c("S1", "S2"), r5 = c("S2", "S1"))
)
str(x2)
#> List of 4
#> $ a:Classes 'data.table' and 'data.frame': 2 obs. of 2 variables:
#> ..$ r1: chr [1:2] "S1" "S2"
#> ..$ r3: chr [1:2] "S2" "S1"
#> ..- attr(*, ".internal.selfref")=<externalptr>
#> $ b:Classes 'data.table' and 'data.frame': 2 obs. of 2 variables:
#> ..$ r1: chr [1:2] "S1" "S2"
#> ..$ r5: chr [1:2] "S2" "S1"
#> ..- attr(*, ".internal.selfref")=<externalptr>
#> $ c:Classes 'data.table' and 'data.frame': 2 obs. of 2 variables:
#> ..$ r2: chr [1:2] "S1" "S2"
#> ..$ r4: chr [1:2] "S2" "S1"
#> ..- attr(*, ".internal.selfref")=<externalptr>
#> $ d:Classes 'data.table' and 'data.frame': 2 obs. of 2 variables:
#> ..$ r4: chr [1:2] "S1" "S2"
#> ..$ r5: chr [1:2] "S2" "S1"
#> ..- attr(*, ".internal.selfref")=<externalptr>
从存储的信息来看,这两个列表是没有任何差异的。
在进行连接操作时,我们会发现 dplyr
的结果会报错!
purrr::reduce(x, dplyr::full_join)
#> Joining, by = "r1"
#> Error: `by` must be supplied when `x` and `y` have no common variables.
#> ℹ use by = character()` to perform a cross-join.
purrr::reduce(x, merge)
#> r5 r4 r1 r3 r2
#> 1 S1 S2 S2 S1 S1
#> 2 S2 S1 S1 S2 S2
看起来似乎有点不可理喻,但实际上上面我构造的数据集是有点特别的:前 2 个子集和第 3 个子集是没有可以连接的列的,第 4 个子集起到桥梁作用。所以使用 dplyr
提供的连接函数报错是正常的,但有意思的是,基础包提供的 merge()
函数可以完成连接操作,真是优秀(感兴趣的朋友可以看下测试下 merge
函数源代码)!
x
#> $a
#> r1 r3
#> 1 S1 S2
#> 2 S2 S1
#>
#> $b
#> r1 r5
#> 1 S1 S2
#> 2 S2 S1
#>
#> $c
#> r2 r4
#> 1 S1 S2
#> 2 S2 S1
#>
#> $d
#> r4 r5
#> 1 S1 S2
#> 2 S2 S1
我们可以再看下基于 data.table
构造的数据集结果:
purrr::reduce(x2, dplyr::full_join)
#> Joining, by = "r1"
#> Error: `by` must be supplied when `x` and `y` have no common variables.
#> ℹ use by = character()` to perform a cross-join.
purrr::reduce(x2, merge)
#> Error in merge.data.table(out, elt, ...): Elements listed in `by` must be valid column names in x and y
两个函数操作都报错了,说明对 data.table
是不适用的。本质上是 data.table
体格的泛型函数不支持类似基础包中的操作。
一般工作情况下,不同的数据子集都存在可以连接的列,所以无论上述哪种方法都可以胜任工作。但特殊情况下,即类似我上述构造的数据集:数据子集不是所有但两两之间都存在共有的列,但按照一定的顺序确实能够将其合并。
下面给出探索后的解决代码:
to_join <- x2[[1]]
be_join <- x2[-1]
# https://stackoverflow.com/questions/30542128/circular-shift-of-vector-by-distance-n
shifter <- function(x, n = 1) {
if (n == 0) x else c(tail(x, -n), head(x, n))
}
while (length(be_join) > 0) {
col_exist <- colnames(be_join[[1]]) %in% colnames(to_join)
if (any(col_exist)) {
to_join <- merge(to_join, be_join[[1]], by = colnames(be_join[[1]])[col_exist])
be_join[[1]] <- NULL
} else {
be_join <- shifter(be_join)
}
}
上述代码中执行下面的操作:
to_join
和 be_join
,to_join
初始化为数据集的第一个子集,而 be_join
为其他子集。be_join
不为空,进行如下的循环:to_join
按共同列合并be_join
的第 2 个子集移动为 第 1 个。be_join
第一个子集的列与 to_join
存在共同列我们可以查看结果:
to_join[, c("r1", "r2", "r3", "r4", "r5")]
#> r1 r2 r3 r4 r5
#> 1: S1 S2 S2 S1 S2
#> 2: S2 S1 S1 S2 S1
对比下面结果是相同的(虽然顺序颠倒了)。
purrr::reduce(x, merge)[, c("r1", "r2", "r3", "r4", "r5")]
#> r1 r2 r3 r4 r5
#> 1 S2 S1 S1 S2 S1
#> 2 S1 S2 S2 S1 S2
在后面的一些使用过程中发现基础包的 merge()
函数在进行连接操作时会输出有问题的结果,所以建议使用的小伙伴仔细检查结果。下面更新了一个用于合并的函数:
reduceG <- function(G) {
# Reduce elements of G if at least two elements
# contain common column names
# G >= 2 elements here
if (length(G) < 2) {
return(G)
}
cnames <- purrr::map(G, colnames)
check_list <- combn(seq_along(cnames), 2, simplify = FALSE)
common <- purrr::map(check_list, ~ intersect(cnames[[.[1]]], cnames[[.[2]]]))
# Index to reduce
ri <- purrr::map_lgl(common, ~ length(.) != 0)
if (any(ri)) {
purrr::map2(check_list[ri], common[ri], .f = function(x, y) {
if (!is.na(G[x[1]]) & !is.na(G[x[2]])) {
# Update global G in reduceG
G[[min(x)]] <<- merge(G[[x[1]]], G[[x[2]]], by = y)
# to make sure the data is removed and the index
# is kept to avoid "subscript out of bounds" error
G[[max(x)]] <<- NA
}
})
# Remove elements set to NA
G <- G[!is.na(G)]
return(reduceG(G))
} else {
return(G)
}
}
测试结果:
reduceG(x)[[1]]
#> r5 r1 r3 r4 r2
#> 1 S1 S2 S1 S2 S1
#> 2 S2 S1 S2 S1 S2
reduceG(x2)[[1]]
#> r5 r1 r3 r4 r2
#> 1: S1 S2 S1 S2 S1
#> 2: S2 S1 S2 S1 S2