Sélection de combinaisons dans les colonnes ligne par ligne avec seuil de chevauchement

Je pense que cela pourrait être utile (s'il vous plaît laissez-moi savoir si non!).

La première étape serait de sous-regrouper vos données dans les groupes 1, 3 et 5. Ensuite, en utilisant la transpose de purrr , en divisant par Group , avec cross nous pouvons obtenir toutes les combinaisons en sélectionnant une ligne de chaque groupe.

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)
})

Vérification du premier élément pour voir ce que nous avons:

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

Ensuite, nous pouvons vérifier le chevauchement en comptant les doublons. Dans ce cas, je unlist simplement les trois lignes, utilise le table pour la fréquence et additionne (en soustrayant 1 pour chaque valeur trouvée, car je ne veux que des doublons).

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

Ceux sans chevauchement peuvent être obtenus par:

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

Pour la partie suivante, faites quelque chose de similaire (cela peut être décomposé comme une fonction généralisée), sauf lors de la vérification du chevauchement, combinez les éléments avec le premier no_ovlp de précédemment:

all_combn_246[combn_ovlp_246 < .25]

Il n'est pas tout à fait clair comment vous voulez calculer le chevauchement pour cette pièce et comparer avec 25%. J'ai compté les doublons puis divisé par le nombre de colonnes (8 sans compter le Group ) et multiplié par 6 (lignes). Pour voir quelle combinaison des Group 2, 4 et 6 peut être combinée avec no_ovlp vous pouvez essayer ce qui suit:

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)
})

Dans mon cas, je pense qu'aucune des combinaisons ne répondait à ce critère, même si la première avec un chevauchement de 37,5% était le minimum:

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

Ce qui n'était pas clair, c'est comment compter les doublons. Par exemple, quel est le chevauchement de c(1, 2, 3, 3, 3) ?

Cela peut être deux doublons (deux 3 supplémentaires):

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

Ou vous pouvez compter le nombre de valeurs qui ont des doublons (seul le nombre 3 est dupliqué):

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

Si c'est ce dernier, vous pouvez essayer:

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)

En volant sans vergogne l'utilisation de cross() par Ben, j'ai cette approche que je trouve personnellement plus facile à lire:

# 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

Voici une solution R simple. Ce n'est pas le plus efficace, mais c'est très simple et donc très traitable.

Le code ci-dessous recueille toutes les valeurs du groupe 1 (1,3,5) et du groupe 2 (2,4,6) et échantillonne n isolats de cette liste. Il teste ensuite le chevauchement minimal et rééchantillonne le groupe 2 si nécessaire. Dans le cas de votre demande, il suffit de rééchantillonner une ou deux fois, mais si votre seuil est inférieur (par exemple 0,05), il peut rééchantillonner jusqu'à 50 fois avant de réussir. En fait, si votre seuil est trop bas et votre nombre d'échantillons trop grand (c'est à dire qu'il est impossible de faire cet échantillon), il vous avertira qu'il a échoué.

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 && 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!")
}