определить группы связанных эпизодов, которые соединяются вместе

Возьмите этот простой фрейм данных связанных идентификаторов:

test <- data.frame(id1=c(10,10,1,1,24,8),id2=c(1,36,24,45,300,11))

> test
  id1 id2
1  10   1
2  10  36
3   1  24
4   1  45
5  24 300
6   8  11

Теперь я хочу сгруппировать все идентификаторы, которые ссылаются. Под «ссылкой» я подразумеваю следовать по цепочке ссылок, чтобы все идентификаторы в одной группе были помечены вместе. Своего рода разветвленная структура. то есть:

Group 1
10 --> 1,   1 --> (24,45)
                   24 --> 300
                          300 --> NULL
                   45 --> NULL
10 --> 36, 36 --> NULL,
Final group members: 10,1,24,36,45,300

Group 2
8 --> 11
      11 --> NULL
Final group members: 8,11

Теперь я примерно знаю логику, которую хотел бы, но не знаю, как бы я ее элегантно реализовал. Я думаю о рекурсивном использовании match или %in% для перехода по каждой ветке, но на этот раз я действительно в тупике.

Окончательный результат, за которым я бы гнался:

result <- data.frame(group=c(1,1,1,1,1,1,2,2),id=c(10,1,24,36,45,300,8,11))

> result
  group  id
1     1  10
2     1   1
3     1  24
4     1  36
5     1  45
6     1 300
7     2   8
8     2  11

person thelatemail    schedule 27.08.2012    source источник
comment
Я бы хотел, чтобы ТАК, и этот вопрос был доступен 25 лет назад, когда я бился головой о стену с SAS, пытаясь решить этот вопрос.   -  person IRTFM    schedule 28.03.2015
comment
@bondeddust - случайно этот вопрос возник в результате попытки заменить уродливый и неэффективный фрагмент кода SAS, который делал что-то подобное.   -  person thelatemail    schedule 28.03.2015
comment
А теперь оказывается, что я забыл этот вопрос и ответ, но мне напомнил об этом @Henrik   -  person IRTFM    schedule 10.06.2021


Ответы (4)


Пакет Bioconductor RBGL (интерфейс R к библиотеке графов BOOST) содержит функцию connectedComp(), которая идентифицирует связанные компоненты в графе — именно то, что вам нужно.

(Чтобы использовать эту функцию, сначала необходимо установить пакеты graph и RBGL, доступные здесь и здесь .)

library(RBGL)
test <- data.frame(id1=c(10,10,1,1,24,8),id2=c(1,36,24,45,300,11))

## Convert your 'from-to' data to a 'node and edge-list' representation  
## used by the 'graph' & 'RBGL' packages 
g <- ftM2graphNEL(as.matrix(test))

## Extract the connected components
cc <- connectedComp(g)

## Massage results into the format you're after 
ld <- lapply(seq_along(cc), 
             function(i) data.frame(group = names(cc)[i], id = cc[[i]]))
do.call(rbind, ld)
#   group  id
# 1     1  10
# 2     1   1
# 3     1  24
# 4     1  36
# 5     1  45
# 6     1 300
# 7     2   8
# 8     2  11
person Josh O'Brien    schedule 27.08.2012
comment
Спасибо за ответ. Теперь у меня также есть термин «подключенные компоненты», который можно использовать при поиске дополнительной информации. - person thelatemail; 27.08.2012
comment
Рад, что смог указать вам полезный путь. Здоровья и счастливых вам дорог. - person Josh O'Brien; 27.08.2012
comment
Я только что проверил этот ответ, и ссылки и пакеты действительно успешны, как и девять лет назад. - person IRTFM; 10.06.2021

Вот альтернативный ответ, который я нашел для себя после того, как Джош подтолкнул меня в правильном направлении. В этом ответе используется пакет igraph. Для тех, кто ищет и находит этот ответ, мой набор данных test называется списком ребер или списком смежности в теории графов (http://en.wikipedia.org/wiki/Graph_theory)

library(igraph)
test <- data.frame(id1=c(10,10,1,1,24,8 ),id2=c(1,36,24,45,300,11))
gr.test <- graph_from_data_frame(test)
links <- data.frame(id=unique(unlist(test)),group=components(gr.test)$membership)
links[order(links$group),]

#   id group
#1  10     1
#2   1     1
#3  24     1
#5  36     1
#6  45     1
#7 300     1
#4   8     2
#8  11     2
person thelatemail    schedule 29.08.2012
comment
Привет @thelatemail! Я думаю, что graph.data.frame заменено на graph_from_data_frame, а clusters на components. По крайней мере, меня перенаправляют на эти функции, когда я их ? использую. Аналогично в другом вашем ответе Ура! - person Henrik; 14.08.2020

Без использования пакетов:

# 2 sets of test data
mytest <- data.frame(id1=c(10,10,3,1,1,24,8,11,32,11,45),id2=c(1,36,50,24,45,300,11,8,32,12,49))
test <- data.frame(id1=c(10,10,1,1,24,8),id2=c(1,36,24,45,300,11))

grouppairs <- function(df){

  # from wide to long format; assumes df is 2 columns of related id's
  test <- data.frame(group = 1:nrow(df),val = unlist(df))

  # keep moving to next pair until all same values have same group
  i <- 0
  while(any(duplicated(unique(test)$val))){
    i <- i+1

    # get group of matching values
    matches <- test[test$val == test$val[i],'group']

    # change all groups with matching values to same group
    test[test$group %in% matches,'group'] <- test$group[i]
  }

  # renumber starting from 1 and show only unique values in group order
  test$group <- match(test$group, sort(unique(test$group)))
  unique(test)[order(unique(test)$group), ]
}

# test
grouppairs(test)
grouppairs(mytest)
person ARobertson    schedule 10.11.2014

Вы сказали рекурсивный... и я подумал, что буду очень краток, пока буду говорить об этом.

Тестовые данные

mytest <- data.frame(id1=c(10,10,3,1,1,24,8,11,32,11,45),id2=c(1,36,50,24,45,300,11,8,32,12,49))
test <- data.frame(id1=c(10,10,1,1,24,8),id2=c(1,36,24,45,300,11))

Рекурсивная функция для получения группировок

aveminrec <- function(v1,v2){
  v2 <- ave(v1,by = v2,FUN = min)
  if(identical(v1,v2)){
    as.numeric(as.factor(v2))
  }else{
    aveminrec(v2,v1)
  }
}

Подготовьте данные и упростите после

groupvalues <- function(valuepairs){
  val <- unlist(valuepairs)
  grp <- aveminrec(val,1:nrow(valuepairs))
  unique(data.frame(grp,val)[order(grp,val), ])
}

Получить результаты

groupvalues(test)
groupvalues(mytest)

aveminrec(), вероятно, соответствует тому, о чем вы думали, хотя я уверен, что есть способ более прямолинейно идти по каждой ветке вместо повторения ave(), который по сути является split() и lapply(). Может быть, рекурсивно разделить и приземлиться? Как бы то ни было, это похоже на повторное частичное ветвление или поочередное небольшое упрощение 2 векторов без потери групповой информации.

Возможно, части этого можно было бы использовать для решения реальной проблемы, но groupvalues() слишком сложна, чтобы ее можно было читать хотя бы без комментариев. Я также не проверял, как производительность сравнивается с циклом for с ave и переворачиванием групп таким образом.

person ARobertson    schedule 16.08.2020
comment
В R есть функция под названием Recall, которая предположительно улучшает код, основанный на рекурсии. И ave можно рассматривать как упрощенную связку lapply и split, но на самом деле она не способна обрабатывать операции по нескольким столбцам в группах. - person IRTFM; 10.06.2021
comment
@IRTFM Recall, вероятно, следует использовать там, действительно полезно знать! - person ARobertson; 12.07.2021