Скажем, у меня есть фрейм данных, подобный следующему:
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
@Эдвард, ха-ха, это интересная ситуация :) Думаю, цифровой суффикс для подгрупп должен быть лучшим вариантом в этом случае.
Это именно то, что я искал! Отличный ответ. В любом случае я не ожидаю более 3 подгрупп, поэтому буквенного суффикса для моего случая более чем достаточно. Большое спасибо!!
Вы также можете визуализировать кластеры с помощью пакета 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)
Визуализация выглядит великолепно, +1!
Спасибо @ThomasIsCoding. Увы, я не мог понять, почему p14 и p15 сгруппированы с g6 (пурпурный, или бета-локус), а не с g3 (голубой, или альфа-локус). Если да, то я думаю, что это был бы хороший способ определить нужные группы «new_group».
Обнаружение сообщества основано на показателе границы между, я понятия не имею, почему p14 и p15 не принадлежат к группе g3. До сих пор я не могу найти очевидных доказательств того, насколько сильный запрос ФП имеет отношение к границам между границами, но, возможно, под капотом есть что-то интересное.
Это действительно очень помогает, спасибо!
Отличный ответ! Но что произойдет, когда у вас закончится
letters
?