R - объединение столбцов по конкретным условиям

Question

Я в настоящее время имеет фрейм данных следующим образом:

groups <- data.frame(name=paste("person",c(1:27),sep=""), 
assignment1 = c("F","A","B","H", "A", "E", "D", "G", "I", "I", "E", "A", "D", "C", "F", "C", "D", "H", "F", "H", "G", "I", "G", "C", "B", "E", "B"), 
assignment2 = c("H", "F", "F", "D", "E", "G", "A", "E", "I", "C", "A", "H", "G", "B", "I", "C", "E", "I", "C", "A", "B", "B", "G", "D", "H", "F", "D"),stringsAsFactors = FALSE) 

Это будет выглядеть следующим образом:

Я хотел бы создать список для каждого человека который содержит только людей, с которыми он уже работал. Например, лицом1 на группы Р и Н для 1-го и 2-го присвоения соответственно и

член групп F на 1-ом назначении являются { «PERSON1», «person15», «person19» }.
Член групп D по второму назначению: {"person1", "person12", "person25"}.

Я хотел бы создать вектор для Person1 как

{ "person15", "person19", "person12", "person25"}.

Любой знает, как это сделать в R?
Любая помощь будет оценена по достоинству. Заранее спасибо.

Answer 1

Вы можете сделать это:

teammates <- lapply(1:nrow(groups), function(i) { 
    assig1 <- subset(groups, assignment1 == groups$assignment1[i])$name 
    assig2 <- subset(groups, assignment2 == groups$assignment2[i])$name 
    unq_set <- unique(c(assig1, assig2)) 
    return(setdiff(unq_set, groups$name[i])) 
}) 

Это переводит вектор индексов строк, и для каждого из них применяет функцию, что а) получающую name х те, где присвоения 1 & 2 соответствуют данной строке, b) получает уникальный надмножество из них, c) возвращает это, за исключением name человека, вокруг которого создана группа

Выходной список, как это:

[[1]] 
[1] "person15" "person19" "person12" "person25" 

[[2]] 
[1] "person5" "person12" "person3" "person26" 

[[3]] 
[1] "person25" "person27" "person2" "person26" 

... и так далее

Для получения дополнительной краткости следующее эквивалентно (хотя порядок внутри элементов списка могут быть разными). То же логика, как @ user5219763 отвечают на подмножества, но setdiff часть важна

teammates <- lapply(1:nrow(groups), function(i) { 
    setdiff(
    with(groups, name[assignment1 == assignment1[i] | 
         assignment2 == assignment2[i] ]), 
    groups$name[i]) 
}) 

Answer 2

Вы можете использовать is.element()

workedWith <- function(index,data=groups){ 
    data[is.element(data[,2],data[index,2]) | is.element(data[,3],data[index,3]),1] 
} 

lapply(X = seq(1:nrow(groups)),FUN = workedWith) 

Answer 3

Вот решение с использованием dplyr и tidyr:

library(dplyr) 
library(tidyr) 
groups %>% 
    gather(var, val, -name) %>% 
    unite(comb, var, val) %>% 
    left_join(.,., by = 'comb') %>% 
    group_by(name.x) %>% 
    summarise(out = list(name.y)) 

Тяжелая атлетика делается с помощью left_join до того, что мы объединяем столбцы, чтобы мы могли объединиться, например, assignment1_f. Результат содержит себя и не исправляется для обмана - это зависит от вас.

Однако, как говорит @akrun, если вы делаете много этого материала, используйте igraph