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

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

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
Источник

3 ответа

Решение

Пакет 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
Источник

Вот альтернативный ответ, который я обнаружил сам после подталкивания Джоша в правильном направлении. Этот ответ использует 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.data.frame(test)
links <- data.frame(id=unique(unlist(test)),group=clusters(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
Источник

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

# 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)
Источник

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

Данные испытаний

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(). Может быть, рекурсивно расколото и приторно? Как бы то ни было, это похоже на повторное частичное ветвление или поочередное небольшое упрощение двух векторов без потери групповой информации.

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

Источник
Другие вопросы по тегам