检索两个按层次结构组织的列表之间共有的元素

时间:2018-12-07 00:35:40

标签: r list sapply intersect

这是先前在此处发布的一个问题的变体。 R - A loop comparing elements in common between two hierarchical lists 我认为这个问题可能会在其解决方案形式上进行足够的改动,因此发布了一篇新文章。

在比较两个具有层次结构的列表(站点包含组,其中包含元素)时,我想检索共同的元素列表

以下是一些虚拟数据:

site<-c('A','A','A','A','A','A','A','A','A','B','B','B','B','B','B')
group<-c('A1','A1','A2','A2','A2','A3','A3','A3','A3', 
'B1','B1','B2','B2','B2','B2')
element<-c("red","orange","blue","black","white", "black","cream","yellow","purple","red","orange","blue","white","gray","salmon")
d<-cbind(site,group,element)

不同之处在于,我不想在组之间进行所有可能的比较,而只希望在站点之间进行比较。因此,我以这种方式组织了数据。

#first level list - by site
sitelist<-split(d, list(d$site),drop = TRUE)
#list by group 
nestedlist <- lapply(sitelist, function(x) split(x, x[['group']], drop = TRUE))

我的意图是创建一个列表,其中包含来自两个站点的组之间相同的元素(我的原始数据具有其他站点)。因此,如果数据是这样构成的:

    A1  A2  A3
B1  2   0   0
B2  0   2   0

我需要出现在A1 / B1和A2 / B2相交处的元素列表。 因此,结果是:

output
$A1-B1
[1] "red"     "orange"

$A2-B2
[2] "blue"    "white"

我的尝试类似于上一个相关问题中发布的内容,只是对我理解为可行的内容进行了调整。

t <- outer(1:length(d$A),
         1:length(d$B),
         FUN=function(i,j){
           sapply(1:length(i),
                  FUN=function(x) 
                    intersect(d$A[[i]]$element, d$B[[j]]$element) )
         })

再次感谢您的帮助,如果这与问题太相似,我们深表歉意。我调整所有建议的尝试均以失败告终。

1 个答案:

答案 0 :(得分:2)

您的代码(outer)的前提是合理的。这里有一些想法。 (请注意,我已将您的数据更改为使用cbind.data.frame(..., stringsAsFactors=FALSE)。)

首先,进行一些重组对我有帮助:

dl <- list(
  A = with(subset(d, site=="A"), split(element, group)),
  B = with(subset(d, site=="B"), split(element, group))
)
str(dl)
# List of 2
#  $ A:List of 3
#   ..$ A1: chr [1:2] "red" "orange"
#   ..$ A2: chr [1:3] "blue" "black" "white"
#   ..$ A3: chr [1:4] "black" "cream" "yellow" "purple"
#  $ B:List of 2
#   ..$ B1: chr [1:2] "red" "orange"
#   ..$ B2: chr [1:4] "blue" "white" "gray" "salmon"

您更喜欢哪个选项取决于您打算如何检索结果。如果您以编程方式进行操作,那么我认为我更喜欢选项1,因为它是对配对的完全明确的随机访问;使用选项2进行随机访问配对,您需要将所需的索引组合到一个新字符串中,并假定它在列表中。

如果您期望的结果主要用于报告,那么选项2可能会起作用,因为默认情况下,选项2会以人类可读的名称展开。 YMMV。

选项1:

func <- function(a,b) Map(intersect, a, b)
o1 <- outer(dl[[1]], dl[[2]], func)
o1
#    B1          B2         
# A1 Character,2 Character,0
# A2 Character,0 Character,2
# A3 Character,0 Character,0

这看起来像是胡言乱语,但每个单元格都是list

o1["A1","B1"]
# [[1]]
# [1] "red"    "orange"
o1[["A2","B2"]] # only difference: double-bracket, returns vector not list
# [1] "blue"  "white"
apply(o1, 1, lengths)
#    A1 A2 A3
# B1  2  0  0
# B2  0  2  0

选项2:

eg2 <- do.call(expand.grid, dl)
o2 <- setNames(Map(intersect, eg2$A, eg2$B),
               apply(sapply(eg2, names), 1, paste, collapse = "-"))
o2
# $`A1-B1`
# [1] "red"    "orange"
# $`A2-B1`
# character(0)
# $`A3-B1`
# character(0)
# $`A1-B2`
# character(0)
# $`A2-B2`
# [1] "blue"  "white"
# $`A3-B2`
# character(0)

如果空元素有问题,您可以

Filter(length, o2)
# $`A1-B1`
# [1] "red"    "orange"
# $`A2-B2`
# [1] "blue"  "white"