Find all possible ways to split a list of elements into a a given number of group of the same size

后端 未结 3 672
臣服心动
臣服心动 2021-01-18 08:49

I have a list of elements and I want an object that gives me all possible ways of splitting these elements into a given number of groups of the same size.

For exampl

3条回答
  •  攒了一身酷
    2021-01-18 09:14

    Following recursive logic allows you to calculate all combinations without repetitions and without the need to calculate all of them first. It works pretty nice, as long as choose(nx-1,ning-1) returns an integer. If it doesn't, calculating the possibilities is a bit ridiculous.

    It's a recursive process, so it might take long and it will cause memory trouble when your vectors exceed a certain limit. But then again, dividing a set of 14 elements in 7 groups gives already 135135 unique possibilities. Things get out of hand pretty quick in these kind of things.

    The logic in pseudo-something (wouldn't call it pseudocode)

    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
    

    Translating this to R gives us :

    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    
    }
    

    To show it works :

    > 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
    

提交回复
热议问题