2016-04-14 11 views
2

はのは、私が6つの数字を持っているとしましょう:一覧すべて3桁の組み合わせを

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

私は繰り返しを含め、これらの6つの数字、すべての可能な3桁の組み合わせを一覧表示します。

所望の結果は次のようになります。

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

私は同じ3つの数字を持っているが、異なる順序で要素を含めたくない:

例えば

1 2 3 
3 2 1 

はそれらの1つを除外する必要があります

+2

'expand。グリッド(1:6,1:6,1:6) ' – alistaire

+0

これは質問[ここ]に似ています(http://stackoverflow.com/questions/11095992/generating-all-distinct-permutations-of-a- list-in-r)。 –

+0

申し訳ありませんが、私は一つの細部を省いた。私の更新を参照してください – user6193945

答えて

2

expand.gridは、あなたがそれを供給し、各セットから1を選ぶ、組み合わせのdata.frameを返します。 1 2 33 2 1と同じでない場合は、それをサブセット化して、必要な行だけを取得します。

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 
1

これを行う簡単な方法は、 ree forループ。これはあなたが望むものになりますか?

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

文字列よりも整数を返すほうが便利かもしれませんし、文字列を格納する方が良いでしょう。 – alistaire

+0

コンソールへの数字の印刷はどうして便利ですか? –

+0

文字列をコンソールに印刷するのではなく、目的に合うように印刷機能を他の機能に変更することができます。 – Wolfson

5

gtoolsからcombinations機能は、これを行うことができます:

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 
2

以下は、出力に制約を指定できる一般的な機能です。例えば、私は、与えられた集合のすべてのn個組を必要とすることによって、生成物が所与の境界よりも小さくなるように、多くの状況が生じた。この関数を書く前に、私はcombinationsを使用し、自分の条件を満たす行を検索しなければなりませんでした。これには多くの時間と多くのメモリが必要でした。以下は

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

いくつかの例を示します。ここでは

## 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 

は素数を含むいくつかのクールな例です:

> 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 

あなたが見ることができるように、Combo機能がはるかに高速であり、1で行われます一方、combinations/sapplyデュオは遅い(5秒以上)と2つの厄介なステップです。 Combo関数は、ほぼ60倍小さいオブジェクトも返します。

もう1つのすばらしい例です。のは、標準偏差が(上記と同じ設定で)50未満も問題ありませんよう(すなわち< 1000素数)あなたが最初の168個の素数のすべての3つのタプルを見つけたいとしましょう:

> 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 

それは、すべての機能の組み合わせが機能しないことに注意してください。たとえば、fun1="sd"fun2=">"とすると、上記のコードは0の一致を返します。乾杯!

関連する問題