Скажем, у меня есть фрейм данных, подобный следующему:
mydf <- data.frame(id=LETTERS, locus=c(rep("alpha",14),rep("beta",12)),
group=c(rep(1,2),rep(2,6),rep(3,6),rep(4,4),rep(5,4),rep(6,4)),
pair=c(1:12,14,15,3,4,6,8,9:16))
который выглядит следующим образом:
> mydf
id locus group pair
1 A alpha 1 1
2 B alpha 1 2
3 C alpha 2 3
4 D alpha 2 4
5 E alpha 2 5
6 F alpha 2 6
7 G alpha 2 7
8 H alpha 2 8
9 I alpha 3 9
10 J alpha 3 10
11 K alpha 3 11
12 L alpha 3 12
13 M alpha 3 14
14 N alpha 3 15
15 O beta 4 3
16 P beta 4 4
17 Q beta 4 6
18 R beta 4 8
19 S beta 5 9
20 T beta 5 10
21 U beta 5 11
22 V beta 5 12
23 W beta 6 13
24 X beta 6 14
25 Y beta 6 15
26 Z beta 6 16
Он имеет столбец id в качестве первичного ключа, а ids разделен на locus альфа и бета. У каждого id в альфа-версии должна быть пара в бета-версии (столбец pair), хотя могут быть случаи отсутствия альфа- или бета-версии ids (из-за предварительной фильтрации).
ids также сгруппированы в разные группы (столбец group), которые были определены для каждого локуса.
Теперь я хочу определить еще одну группирующую переменную new_group, которая отражает информацию о спаривании альфа-бета.
Визуально это кажется очень простым, но я изо всех сил пытаюсь определить правила автоматически, чтобы принять во внимание каждую возможную ситуацию.
Желаемый результат для приведенного выше примера фрейма данных будет следующим (цвета только для справки):
Обратите внимание, что я определяю new_group только тогда, когда pair информация найдена, поэтому ids A и B не принадлежат ни одному new_group.
ids C, D, F и H имеют pair информацию в бета-версии, поэтому все они составляют new_group 1; поскольку ids E и G принадлежат к одной группе, они объединяются (даже если не несут pair информации).
ids информация о парах от I до N в бета-версии сгруппирована в разные группы, поэтому new_group 2 нужно разделить в бета-версии на 2a и 2b.
По сути, правила будут такими:
Вот igraph решение
mbs <- mydf %>%
mutate(sg = str_c("g", group), sp = str_c("p", pair)) %>%
select(sg, sp) %>%
graph_from_data_frame(directed = FALSE) %>%
components() %>%
membership()
mydf %>%
mutate(new_group = mbs[startsWith(names(mbs), "g")][str_c("g", group)]) %>%
mutate(
new_group = ifelse(n_distinct(locus) == 2, new_group - 1, NA),
.by = new_group
) %>%
mutate(
new_group = if (n_distinct(group) == 1) as.character(new_group) else str_c(new_group, "_",match(group, unique(group))),
.by = c(locus, new_group)
)
который дает
id locus group pair new_group
1 A alpha 1 1 <NA>
2 B alpha 1 2 <NA>
3 C alpha 2 3 1
4 D alpha 2 4 1
5 E alpha 2 5 1
6 F alpha 2 6 1
7 G alpha 2 7 1
8 H alpha 2 8 1
9 I alpha 3 9 2
10 J alpha 3 10 2
11 K alpha 3 11 2
12 L alpha 3 12 2
13 M alpha 3 14 2
14 N alpha 3 15 2
15 O beta 4 3 1
16 P beta 4 4 1
17 Q beta 4 6 1
18 R beta 4 8 1
19 S beta 5 9 2_1
20 T beta 5 10 2_1
21 U beta 5 11 2_1
22 V beta 5 12 2_1
23 W beta 6 13 2_2
24 X beta 6 14 2_2
25 Y beta 6 15 2_2
26 Z beta 6 16 2_2
Вы также можете визуализировать кластеры с помощью пакета igraph.
Цвета ребер берутся из локуса (amber="alpha", blue="beta").
Р-код:
mbs <- mydf %>%
mutate(sg = paste0("g", group), sp = paste0("p", pair)) %>%
select(sg, sp, locus) %>%
graph_from_data_frame(directed = FALSE) # Modified slightly from Thomas' answer
ceb <- cluster_edge_betweenness(ig)
plot(ceb, ig,
col = "yellow", # vertex colour
edge.color = as.factor(E(ig)$locus), edge.width=3)