Блог

У меня есть фрейм данных, в котором есть строки, представляющие сообщества. Для столбцов первый столбец — это группа, в которую входит сообщество (всего 6 групп), а остальные 8 — идентификаторы каждого члена сообщества.

Что я хотел бы сделать, так это выбрать сообщество (строку) в группах 1, 3 и 5, где между ними нет перекрытия. Затем, как только я это получу, я хотел бы выбрать сообщество из групп 2, 4 и 6, где перекрытие между выбранными 6 сообществами не превышает 25%.

Вот пример набора данных:

 Group = c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6)
Isol_1 = c(125, 25, 1, 126, 25, 128, 3, 128, 29, 15, 11, 18, 125, 6, 37, 4, 5, 19, 11, 4, 34, 32, 19, 1)
Isol_2 = c(8, 6, 56, 40, 37, 40, 125, 52, 4, 34, 25, 15, 15, 15, 23, 18, 63, 18, 22, 125, 23, 22, 11, 4)
Isol_3 = c(40, 34, 125, 63, 8, 25, 126, 48, 3, 125, 126, 37, 29, 126, 56, 29, 18, 40, 23, 25, 33, 43, 1, 11)
Isol_4 = c(127, 128, 8, 6, 38, 22, 25, 1, 63, 43, 22, 34, 4, 38, 22, 125, 48, 22, 126, 23, 32, 23, 23, 5)
Isol_5 = c(19, 4, 43, 125, 40, 37, 128, 125, 125, 23, 56, 43, 48, 48, 11, 33, 37, 63, 32, 63, 63, 48, 43, 52)
Isol_6 = c(33, 1, 128, 52, 124, 34, 15, 8, 40, 63, 4, 38, 5, 37, 8, 43, 32, 1, 19, 38, 22, 18, 56, 23)
Isol_7 = c(29, 63, 126, 128, 32, 63, 32, 11, 32, 33, 6, 6, 128, 19, 6, 15, 43, 33, 40, 11, 19, 56, 32, 18)
Isol_8 = c(3, 40, 34, 4, 56, 43, 52, 37, 38, 38, 52, 32, 11, 18, 33, 11, 1, 128, 37, 15, 56, 19, 5, 40)
df = cbind(Group, Isol_1, Isol_2, Isol_3, Isol_4, Isol_5, Isol_6, Isol_7, Isol_8)
  

На основе критериев, которые я упомянул выше, можно было бы извлечь следующее:

Группа 1: 125, 8, 40, 127, 19, 33, 29, 3

Группа 3: 11, 25, 126, 22, 56, 4, 6, 52

Группа 5: 5, 63, 18, 48, 37, 32, 43, 1

Группа 2: 25, 37, 8, 38, 40, 124, 32, 56

Группа 4: 125, 15, 29, 4, 48, 5, 128, 11

Группа 6: 34, 23, 33, 32, 63, 22, 19, 56

Я считаю, что это может быть полезно (пожалуйста, дайте мне знать, если нет!).

Первым шагом будет разделение ваших данных на группы 1, 3 и 5. Затем, используя transpose from purrr , splitting by Group , with cross , мы можем получить все комбинации, выбрав одну строку из каждой группы.

 library(purrr)

grp_135 <- df[df$Group %in% c(1, 3, 5), ]
all_combn_135 <- lapply(cross(split(transpose(grp_135), grp_135$Group)), bind_rows)
  

Проверяем первый элемент, чтобы увидеть, что у нас есть:

 R> all_combn_135[[1]]
# A tibble: 3 x 9
  Group Isol_1 Isol_2 Isol_3 Isol_4 Isol_5 Isol_6 Isol_7 Isol_8
  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
1     1    125      8     40    127     19     33     29      3
2     3     29      4      3     63    125     40     32     38
3     5      5     63     18     48     37     32     43      1
  

Далее мы можем проверить перекрытие путем подсчета дубликатов. В этом случае я использую только unlist три строки, использую table для частоты и суммирую (вычитая 1 для каждого найденного значения, поскольку нужны только дубликаты).

 combn_ovlp_135 <- lapply(all_combn_135, function(x) {
  sum(table(unlist(x[-1])) - 1)
})
  

Комбинации без перекрытия могут быть получены с помощью:

 no_ovlp <- all_combn_135[combn_ovlp_135 == 0]
no_ovlp

  Group Isol_1 Isol_2 Isol_3 Isol_4 Isol_5 Isol_6 Isol_7 Isol_8
  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
1     1    125      8     40    127     19     33     29      3
2     3     11     25    126     22     56      4      6     52
3     5      5     63     18     48     37     32     43      1
  

Для следующей части сделайте что-то подобное (это можно представить в виде обобщенной функции), за исключением проверки на перекрытие, объедините элементы с первым no_ovlp из ранее:

 grp_246 <- df[df$Group %in% c(2, 4, 6), ]
all_combn_246 <- lapply(cross(split(transpose(grp_246), grp_246$Group)), bind_rows)

combn_ovlp_246 <- lapply(all_combn_246, function(x) {
  sum(table(c(unlist(x[-1]), unlist(no_ovlp[[1]][-1]))) - 1) / ((ncol(df) - 1) * 6)
})
  

Не совсем понятно, как вы хотите рассчитать перекрытие для этой части и сравнить с 25%. Я подсчитал дубликаты, а затем разделил на количество столбцов (8 не считая Group ) и умножил на 6 (строки). Чтобы узнать, с какой комбинацией из Group 2, 4 и 6 можно комбинировать, no_ovlp вы можете попробовать следующее:

 all_combn_246[combn_ovlp_246 < .25]
  

В моем случае, я считаю, что ни одна из комбинаций не соответствовала этому критерию, хотя первая с перекрытием 37,5% была минимальной:

 R> all_combn_246[[1]]
# A tibble: 3 x 9
  Group Isol_1 Isol_2 Isol_3 Isol_4 Isol_5 Isol_6 Isol_7 Isol_8
  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
1     2     25     37      8     38     40    124     32     56
2     4    125     15     29      4     48      5    128     11
3     6     34     23     33     32     63     22     19     56
  

Что было неясно, так это как подсчитывать дубликаты. Например, насколько велико перекрытие c(1, 2, 3, 3, 3) ?

Это может быть два дубликата (два дополнительных 3-х):

 R> sum(table(x) - 1)
[1] 2
  

Или вы можете подсчитать количество значений, которые имеют какие-либо дубликаты (дублируется только число 3):

 R> sum(table(x) > 1)
[1] 1
  

Если это последнее, вы могли бы попробовать:

 combn_ovlp_246 <- lapply(all_combn_246, function(x) {
  sum(table(c(unlist(x[-1]), unlist(no_ovlp[[1]][-1]))) > 1) / ((ncol(df) - 1) * 6)
})
  

Бесстыдно крадя использование Бена cross() , у меня есть такой подход, который мне лично легче читать:

 # Returns the number of overlapping elements
overlap <- function(xx){
  length(unlist(xx)) - length(unique(unlist(xx)))
}

df_135 <- df %>%
  as_tibble() %>%
  filter(Group %in% c(1,3,5)) %>%
  group_by(Group) %>%
  mutate(Community = row_number()) %>%
  nest(Members = starts_with("Isol_")) %>%
  mutate(Members = map(Members, as.integer))

df_135
# A tibble: 12 x 3
# Groups:   Group [3]
#   Group Community Members  
#   <dbl> <chr>     <list>   
# 1     1 g1_1      <int [8]>
# 2     1 g1_2      <int [8]>
# 3     1 g1_3      <int [8]>
# 4     1 g1_4      <int [8]>
# 5     3 g3_1      <int [8]>
# 6     3 g3_2      <int [8]>
# 7     3 g3_3      <int [8]>
# 8     3 g3_4      <int [8]>
# 9     5 g5_1      <int [8]>
#10     5 g5_2      <int [8]>
#11     5 g5_3      <int [8]>
#12     5 g5_4      <int [8]>

# Compute all combinations across groups
all_combns <- cross(split(df_135$Members, df_135$Group))

# select the combinations with the desired overlap
all_combns[map_int(all_combns, overlap) == 0]
# [[1]]
# [[1]]$`1`
# [1] 125   8  40 127  19  33  29   3
# 
# [[1]]$`3`
# [1]  11  25 126  22  56   4   6  52
# 
# [[1]]$`5`
# [1]  5 63 18 48 37 32 43  1
  

Вот простое R-решение. Это не самый эффективный способ, но он очень прост и поэтому очень удобен.

Приведенный ниже код собирает все значения в группе 1 (1,3,5) и группе 2 (2,4,6), и выборки n выделяются из этого списка. Затем выполняется проверка на минимальное перекрытие и при необходимости выполняется повторная выборка группы 2. В случае вашего запроса требуется только выполнить повторную выборку один или два раза, но если ваш порог ниже (например, 0,05), он может выполнить повторную выборку до 50 раз, прежде чем получит правильное значение. На самом деле, если ваш порог слишком низок, а количество выборок слишком велико (т. Е. Невозможно создать эту выборку), он предупредит вас, что это не удалось.

 Group = c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6)
Isol_1 = c(125, 25, 1, 126, 25, 128, 3, 128, 29, 15, 11, 18, 125, 6, 37, 4, 5, 19, 11, 4, 34, 32, 19, 1)
Isol_2 = c(8, 6, 56, 40, 37, 40, 125, 52, 4, 34, 25, 15, 15, 15, 23, 18, 63, 18, 22, 125, 23, 22, 11, 4)
Isol_3 = c(40, 34, 125, 63, 8, 25, 126, 48, 3, 125, 126, 37, 29, 126, 56, 29, 18, 40, 23, 25, 33, 43, 1, 11)
Isol_4 = c(127, 128, 8, 6, 38, 22, 25, 1, 63, 43, 22, 34, 4, 38, 22, 125, 48, 22, 126, 23, 32, 23, 23, 5)
Isol_5 = c(19, 4, 43, 125, 40, 37, 128, 125, 125, 23, 56, 43, 48, 48, 11, 33, 37, 63, 32, 63, 63, 48, 43, 52)
Isol_6 = c(33, 1, 128, 52, 124, 34, 15, 8, 40, 63, 4, 38, 5, 37, 8, 43, 32, 1, 19, 38, 22, 18, 56, 23)
Isol_7 = c(29, 63, 126, 128, 32, 63, 32, 11, 32, 33, 6, 6, 128, 19, 6, 15, 43, 33, 40, 11, 19, 56, 32, 18)
Isol_8 = c(3, 40, 34, 4, 56, 43, 52, 37, 38, 38, 52, 32, 11, 18, 33, 11, 1, 128, 37, 15, 56, 19, 5, 40)
df = cbind(Group, Isol_1, Isol_2, Isol_3, Isol_4, Isol_5, Isol_6, Isol_7, Isol_8)

df = as.data.frame(df)
subset1 <- df[df$Group %in% c(1,3,5),]
subset2 <- df[df$Group %in% c(2,4,6),]

values_in_subset1 <- subset1[2:ncol(subset1)]        # Drop group column
values_in_subset1 <- as.vector(t(values_in_subset1)) # Convert to single vector

values_in_subset2 <- subset2[2:ncol(subset2)]        # Drop group column
values_in_subset2 <- as.vector(t(values_in_subset2)) # Convert to single vector

n_sampled <- 8

sample1 <- sample(values_in_subset1, n_sampled, replace=F)  #Replace=F is default, added here for readability
sample2 <- sample(values_in_subset2, n_sampled, replace=F)  #Replace=F is default, added here for readability
percentage_overlap <- sum(sample1 %in% sample2)/n_sampled

min_percentage_overlap <- 0.25
retries <- 1

# Retry until it gets it right
while(percentage_overlap > min_percentage_overlap amp;amp; retries < 1000)
{
    retries <- retries   1
    sample2 <- sample(values_in_subset2, n_sampled, replace=F)  #Replace=F is default, added here for readability
    percentage_overlap <- sum(sample1 %in% sample2)/n_sampled
}

# Report on number of attempts
cat(paste("Sampled", retries, "times to make sure there was less than", min_percentage_overlap*100,"% overlap."))

# Finally, check if it worked.
if(percentage_overlap <= min_percentage_overlap){ 
        cat("It's super effective! (not really though)")
} else {
    cat("But it failed!")
}