Énumérez toutes les combinaisons de 3 chiffres parmi les 6 chiffres.

Question

Disons que j'ai 6 numéros :

a <- c(1,2,3,4,5,6)

Je veux lister toutes les combinaisons possibles de 3 chiffres de ces 6 nombres, y compris les répétitions.

Le résultat souhaité ressemblerait à ceci :

1 1 1
1 2 3
1 2 4
... 

Je ne veux pas inclure les éléments qui ont les mêmes 3 numéros mais dans un ordre différent :

par exemple

1 2 3
3 2 1

devrait exclure l'un d'entre eux

Answer 1

Le site combinations de la fonction gtools peut le faire :

library(gtools)
combinations(n=6, r=3, v=a, repeats.allowed=TRUE)

      [,1] [,2] [,3]
 [1,]    1    1    1
 [2,]    1    1    2
 [3,]    1    1    3
 ...
[54,]    5    5    6
[55,]    5    6    6
[56,]    6    6    6

Answer 2

expand.grid renvoie un data.frame de combinaisons, en choisissant une de chaque ensemble que vous lui fournissez. Si vous 1 2 3 n'est pas la même chose que 3 2 1 et le sous-ensemble pour obtenir les lignes que vous voulez.

df <- expand.grid(1:6, 1:6, 1:6)
df[df$Var1 <= df$Var2 & df$Var2 <= df$Var3,]
# 
#     Var1 Var2 Var3
# 1      1    1    1
# 37     1    1    2
# 43     1    2    2
# 44     2    2    2
# 73     1    1    3
# 79     1    2    3
# 80     2    2    3
# 85     1    3    3
# 86     2    3    3
# 87     3    3    3
# 109    1    1    4
# 115    1    2    4
# 116    2    2    4
# 121    1    3    4
# 122    2    3    4
# 123    3    3    4
# 127    1    4    4
# 128    2    4    4
# 129    3    4    4
# 130    4    4    4
# 145    1    1    5
# 151    1    2    5
# 152    2    2    5
# 157    1    3    5
# 158    2    3    5
# 159    3    3    5
# 163    1    4    5
# 164    2    4    5
# 165    3    4    5
# 166    4    4    5
# 169    1    5    5
# 170    2    5    5
# 171    3    5    5
# 172    4    5    5
# 173    5    5    5
# 181    1    1    6
# 187    1    2    6
# 188    2    2    6
# 193    1    3    6
# 194    2    3    6
# 195    3    3    6
# 199    1    4    6
# 200    2    4    6
# 201    3    4    6
# 202    4    4    6
# 205    1    5    6
# 206    2    5    6
# 207    3    5    6
# 208    4    5    6
# 209    5    5    6
# 211    1    6    6
# 212    2    6    6
# 213    3    6    6
# 214    4    6    6
# 215    5    6    6
# 216    6    6    6

Answer 3

Vous trouverez ci-dessous une fonction générale qui vous permet de spécifier des contraintes sur la sortie. Par exemple, j'ai eu de nombreuses situations dans lesquelles j'avais besoin de tous les n-tuples d'un ensemble donné de sorte que leur produit soit inférieur à une limite donnée. Avant d'écrire cette fonction, j'étais obligé d'utiliser combinations et rechercher les rangées qui répondent à ma condition. Cela prenait beaucoup de temps et beaucoup de mémoire.

Combo  <- function(n,r,v=1:n,li=10^8,fun1="prod",fun2="<",repeats.allowed=FALSE) {
    ## where fun1 is a general function such as "prod", "sum", "sd", etc.
    ## and fun2 is a comparison operator such as "<", "<=", ">", "==",  etc.

    myfun <- match.fun(FUN = fun1)
    operator1 <- match.fun(FUN = fun2)
    operator2 <- match.fun(FUN = fun2)
    myv <- sort(v)

    if (fun2 %in% c(">",">=")) {
        myv <- rev(myv)
        TheLim <- min(v)
    } else {
        TheLim <- max(v)
        if (fun2 == "==") {
            operator1 <- match.fun(FUN = "<=")
        }
    }

    if (!repeats.allowed) {
        m <- matrix(numeric(0),combinat::nCm(n,r),r)
        v1 <- myv; n1 <- length(v); t <- TRUE; count <- 0L

        while (t) {
            t <- operator1(myfun(v1[1:r]),li)
            while (t && length(v1)>=r) {
                t_1 <- operator2(myfun(v1[1:r]),li)
                if (t_1) {count <- count+1L; m[count,] <- v1[1:r]}
                v1 <- v1[-r]
                t <- operator1(myfun(v1[1:r],na.rm=TRUE),li)
            }
            if (t) {
                s <- 1:length(v1)
                mymax <- myv[n1-(r-s)]
                t1 <- which(!v1==mymax)
                if (length(t1)>0) {
                    e <- max(t1)
                    v1[e] <- myv[which(myv==v1[e])+1L]
                    v1 <- c(v1[1:e],myv[(which(myv==v1[e])+1L):n1])
                } else {
                    return(m[!is.na(m[,1]),])
                }
            } else {
                r1 <- r-1L
                while (r1>=1L && !t) {
                    v1[r1] <- myv[which(myv==v1[r1])+1L]
                    if (v1[r1]==TheLim) {r1 <- r1-1L; next}
                    v1 <- c(v1[1:r1],myv[(which(myv==v1[r1])+1L):n1])
                    t <- operator1(myfun(v1[1:r],na.rm=TRUE),li) && length(v1)>=r
                    r1 <- r1-1L
                }
                if (!t) {return(m[!is.na(m[,1]),])}
            }
        }
    } else {
        MySet <- 1:n 
        for (i in 1:(r-1L)) {MySet <- sapply(1:n, function(x) sum(MySet[1:x]))}
        m <- matrix(numeric(0),nrow=MySet[n],ncol=r)
        v1 <- c(rep(myv[1], r),myv[2:n]); n1 <- length(v); t <- TRUE; count <- 0L

        while (t) {
            t <- operator1(myfun(v1[1:r]),li)
            while (t && length(v1)>=r) {
                t_1 <- operator2(myfun(v1[1:r]),li)
                if (t_1) {count <- count+1L; m[count,] <- v1[1:r]}
                v1 <- v1[-r]
                t <- operator1(myfun(v1[1:r],na.rm=TRUE),li)
            }
            if (t) {
                s <- 1:length(v1)
                t1 <- which(!v1==TheLim)
                if (length(t1)>0) {
                    e <- max(t1)
                    v1[e] <- myv[which(myv==v1[e])+1L]
                    tSize <- r - length(myv[1:e])
                    if (!v1[e]==TheLim) {
                        v1 <- c(v1[1:e],rep(v1[e],tSize),myv[(which(myv==v1[e])+1L):n1])
                    } else {
                        v1 <- c(v1[1:e],rep(v1[e],tSize))
                    }
                } else {
                    return(m[!is.na(m[,1]),])
                }
            } else {
                r1 <- r-1L
                while (r1>=1L && !t) {
                    if (v1[r1]==TheLim) {r1 <- r1-1L; next}
                    v1[r1] <- myv[which(myv==v1[r1])+1L]
                    tSize <- r - length(myv[1:r1])
                    v1 <- c(v1[1:r1],rep(v1[r1],tSize),myv[(which(myv==v1[r1])+1L):n1])
                    t <- operator1(myfun(v1[1:r],na.rm=TRUE),li) && length(v1)>=r
                    r1 <- r1-1L
                }
                if (!t) {return(m[!is.na(m[,1]),])}
            }
        }
    }
}

Voici quelques exemples :

## return all 3-tuple combinations of 1 through 6 such 
## that the PRODUCT is less than 10
> Combo(n=6, r=3, v=1:6, li=10, fun1="prod", fun2="<", repeats.allowed=TRUE)
       [,1] [,2] [,3]
 [1,]    1    1    1
 [2,]    1    1    2
         .    .    .
[10,]    1    3    3
[11,]    2    2    2

## return all 3-tuple combinations of 1 through 6 such 
## that the SUM is less than 10
> Combo(n=6, r=3, v=1:6, li=10, fun1="sum", fun2="<", repeats.allowed=TRUE)
       [,1] [,2] [,3]
 [1,]    1    1    1
 [2,]    1    1    2
 [3,]    1    1    3
         .    .    .
[20,]    2    3    3
[21,]    2    3    4
[22,]    3    3    3

Voici quelques exemples sympas impliquant des nombres premiers :

> library(numbers)
> myps <- Primes(1000)
> system.time(t1 <- Combo(n=length(myps), r=3, v=myps, li=10^5, fun1="prod",  fun2="<", repeats.allowed=TRUE))
user  system elapsed 
0.18    0.00    0.18 
> nrow(t1)
[1] 13465

> set.seed(42)
> t1[sample(nrow(t1),5),]
     [,1] [,2] [,3]
[1,]   13   31  197
[2,]   17   19  167
[3,]    2  131  227
[4,]   11   11  751
[5,]    5   31  151

> object.size(t1)
323360 bytes

> system.time(t2 <- combinations(n=length(myps), r=3, v=myps, repeats.allowed=TRUE))
user  system elapsed 
3.63    0.00    3.68
> nrow(t2)
[1] 804440

> system.time(t3 <- t2[which(sapply(1:nrow(t2), function(x) prod(t2[x,]) < 10^5)),])
user  system elapsed 
1.55    0.00    1.54 

> nrow(t3)
[1] 13465

> object.size(t2)
19306760 bytes

Comme vous pouvez le voir, le Combo est beaucoup plus rapide et s'effectue en une seule étape, alors que la fonction combinations/sapply Le duo est lent (plus de 5 secondes) et comporte deux étapes maladroites. Le site Combo renvoie également un objet qui est presque 60 fois plus petit.

Voici un autre exemple cool. Disons que vous voulez trouver tous les 3-tuples des 168 premiers nombres premiers (c'est-à-dire les nombres premiers < 1000) tels que l'écart-type est inférieur à 50. Aucun problème (avec la même configuration que ci-dessus) :

> system.time(t1 <- Combo(n=length(myps), r=3, v=myps, li=50, fun1="sd",  fun2="<", repeats.allowed=TRUE))
user  system elapsed 
1.49    0.00    1.48

> system.time(t3 <- t2[which(sapply(1:nrow(t2), function(x) sd(t2[x,]) < 50)),])
user  system elapsed 
19.89    0.00   19.89 

> nrow(t1)
[1] 22906

> nrow(t3)
[1] 22906

> all(t3==t1)
[1] TRUE

Il convient de noter que toutes les combinaisons de fonctions ne fonctionnent pas. Par exemple, si vous laissez fun1="sd" y fun2=">" le code ci-dessus renverra 0 résultat. A la vôtre !

Answer 4

Une façon simple de le faire est d'utiliser trois boucles for. Ce résultat correspond-il à ce que vous voulez ?

for (x in 1:6) { 
    for (y in x:6) {
        for (z in y:6) {
            print(paste(x,y,z))
        }
    }
}