Извлечение общих элементов между двумя списками, иерархически организованными - PullRequest
Новая
       8

Извлечение общих элементов между двумя списками, иерархически организованными

0 голосов
/ 07 декабря 2018

Это вариант вопроса, ранее размещенного здесь. R - Цикл, сравнивающий общие элементы между двумя иерархическими списками Я подумал, что эта проблема может привести к существенным изменениям в форме ее решения, и, следовательно, к новому сообщению.

Я хотел бы получить списокобщие элементы при сравнении двух списков, иерархически структурированные (сайты содержат группы, содержащие элементы)

Вот некоторые фиктивные данные: 

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 голосов
/ 07 декабря 2018

Предпосылка вашего кода (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 работает, так как он по умолчанию развернут с понятными для человека именами.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"
...