6

要素のリストがあり、これらの要素を同じサイズの指定された数のグループに分割するすべての可能な方法を提供するオブジェクトが必要です。

たとえば、ここに私のリストがあります：

MyElements <- c(1,2,3,4)

そして、それらを2つのグループに分割する可能なすべての組み合わせが必要です:

nb.groups <- 2

答えは、例えばそのようなものかもしれません:

[[1]]

[1] 1,2

[2] 3,4

[[2]]

[1] 1,3

[2] 2,4

[[3]]

[1] 2,3

[2] 1,4

私はそのような繰り返しを避けたい:

[[1]]

[1] 1,2

[2] 3,4

[[2]]

[1] 3,4

[2] 1,2

どうもありがとう ！

答えてくれてありがとう。私が達成しようとしていることについて、より多くの情報を提供する必要があると思います。

リスト (または MyElements がベクトルであることは明らかなのでベクトル) は、実際には個人の ID 番号です。これらの個人を、すべて同じサイズの希望する数のグループに分割するすべての可能な方法のリストが必要です。

私が間違っていなければ、現時点で実際に機能する唯一の解決策は、Juba のいわゆるブルート フォース アンド ダーティ ソリューションです。しかし、ジュバが言ったように、すぐに（私の目的には速すぎます！）使用できなくなります。

再度、感謝します

4

3 に答える 3

5

再帰的ロジックに従うことで、すべての組み合わせを繰り返しなしで計算でき、最初にすべてを計算する必要もありません。choose(nx-1,ning-1) が整数を返す限り、かなりうまく機能します。そうでない場合、可能性を計算するのは少しばかげています。

これは再帰的なプロセスであるため、時間がかかる可能性があり、ベクトルが特定の制限を超えるとメモリの問題が発生します。しかし、繰り返しますが、14 要素のセットを 7 つのグループに分割すると、すでに 135135 のユニークな可能性が得られます。この種のことでは、物事はすぐに手に負えなくなります。

擬似的なロジック (擬似コードとは呼びません)

nb = number of groups
ning = number of elements in every group
if(nb == 2)
   1. take first element, and add it to every possible 
       combination of ning-1 elements of x[-1] 
   2. make the difference for each group defined in step 1 and x 
       to get the related second group
   3. combine the groups from step 2 with the related groups from step 1

if(nb > 2)
   1. take first element, and add it to every possible 
       combination of ning-1 elements of x[-1] 
   2. to define the other groups belonging to the first groups obtained like this, 
       apply the algorithm on the other elements of x, but for nb-1 groups
   3. combine all possible other groups from step 2 
       with the related first groups from step 1

これを R に翻訳すると、次のようになります。

perm.groups <- function(x,n){
    nx <- length(x)
    ning <- nx/n

    group1 <- 
      rbind(
        matrix(rep(x[1],choose(nx-1,ning-1)),nrow=1),
        combn(x[-1],ning-1)
      )
    ng <- ncol(group1)

    if(n > 2){
      out <- vector('list',ng)

      for(i in seq_len(ng)){
        other <- perm.groups(setdiff(x,group1[,i]),n=n-1)
        out[[i]] <- lapply(seq_along(other),
                       function(j) cbind(group1[,i],other[[j]])
                    )
      }
    out <- unlist(out,recursive=FALSE)
    } else {
      other <- lapply(seq_len(ng),function(i) 
                  matrix(setdiff(x,group1[,i]),ncol=1)
                )
      out <- lapply(seq_len(ng),
                    function(i) cbind(group1[,i],other[[i]])
              )
    }
    out    
}

それが機能することを示すには：

> perm.groups(1:6,3)
[[1]]
     [,1] [,2] [,3]
[1,]    1    3    5
[2,]    2    4    6

[[2]]
     [,1] [,2] [,3]
[1,]    1    3    4
[2,]    2    5    6

[[3]]
     [,1] [,2] [,3]
[1,]    1    3    4
[2,]    2    6    5

[[4]]
     [,1] [,2] [,3]
[1,]    1    2    5
[2,]    3    4    6

[[5]]
     [,1] [,2] [,3]
[1,]    1    2    4
[2,]    3    5    6

[[6]]
     [,1] [,2] [,3]
[1,]    1    2    4
[2,]    3    6    5

[[7]]
     [,1] [,2] [,3]
[1,]    1    2    5
[2,]    4    3    6

[[8]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    4    5    6

[[9]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    4    6    5

[[10]]
     [,1] [,2] [,3]
[1,]    1    2    4
[2,]    5    3    6

[[11]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    5    4    6

[[12]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    5    6    4

[[13]]
     [,1] [,2] [,3]
[1,]    1    2    4
[2,]    6    3    5

[[14]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    6    4    5

[[15]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    6    5    4
于 2013-02-07T18:11:49.367 に答える
1

ここでは、スプリッター カラムの構造に基づくソリューションを示します。

x <- 1:4
a <- as.data.frame(t(combn(x,length(x)/2))
a$sum <- abs(rowSums(a)-mean(rowSums(a)))
lapply(split(a,a$sum),function(x) if(dim(x)[1]>2) 
                                      split(x,1:(dim(x)[1]/2)) 
                                   else 
                                      x)



$`0`
  V1 V2 sum
3  1  4   0
4  2  3   0

$`1`
  V1 V2 sum
2  1  3   1
5  2  4   1

$`2`
  V1 V2 sum
1  1  2   2
6  3  4   2
于 2013-02-07T15:41:55.227 に答える
0

これはブルートフォースアンドダーティソリューションであり、さまざまな数のグループで機能する可能性がありますが、実際には使用前にテストする必要があります。さらに、を使用するpermnため、ベクトルのサイズによっては非常に高速に使用できなくなります。

library(combinat)
split.groups <- function(x, nb.groups) {
  length.groups <- length(x)/nb.groups
  perm <- permn(x)
  perm <- lapply(perm, function(v) {
    m <- as.data.frame(matrix(v, length.groups, nb.groups))
    m <- apply(m,2,sort)
    m <- t(m)
    m <- m[order(m[,1]),]
    rownames(m) <- NULL
    m})
  unique(perm)
}

たとえば、次のようになります。

R> split.groups(1:4, 2)
[[1]]
     [,1] [,2]
[1,]    1    2
[2,]    3    4

[[2]]
     [,1] [,2]
[1,]    1    4
[2,]    2    3

[[3]]
     [,1] [,2]
[1,]    1    3
[2,]    2    4

または ：

R> split.groups(1:6, 3)
[[1]]
     [,1] [,2]
[1,]    1    2
[2,]    3    4
[3,]    5    6

[[2]]
     [,1] [,2]
[1,]    1    2
[2,]    3    6
[3,]    4    5

[[3]]
     [,1] [,2]
[1,]    1    6
[2,]    2    3
[3,]    4    5

[[4]]
     [,1] [,2]
[1,]    1    2
[2,]    3    5
[3,]    4    6

[[5]]
     [,1] [,2]
[1,]    1    6
[2,]    2    5
[3,]    3    4

[[6]]
     [,1] [,2]
[1,]    1    5
[2,]    2    6
[3,]    3    4

[[7]]
     [,1] [,2]
[1,]    1    5
[2,]    2    3
[3,]    4    6

[[8]]
     [,1] [,2]
[1,]    1    5
[2,]    2    4
[3,]    3    6

[[9]]
     [,1] [,2]
[1,]    1    6
[2,]    2    4
[3,]    3    5

[[10]]
     [,1] [,2]
[1,]    1    4
[2,]    2    3
[3,]    5    6

[[11]]
     [,1] [,2]
[1,]    1    4
[2,]    2    6
[3,]    3    5

[[12]]
     [,1] [,2]
[1,]    1    4
[2,]    2    5
[3,]    3    6

[[13]]
     [,1] [,2]
[1,]    1    3
[2,]    2    5
[3,]    4    6

[[14]]
     [,1] [,2]
[1,]    1    3
[2,]    2    6
[3,]    4    5

[[15]]
     [,1] [,2]
[1,]    1    3
[2,]    2    4
[3,]    5    6
于 2013-02-07T14:54:13.293 に答える