CODEWITHSUNDEEP
performancermemoryout-of-memory
Remi.b
Remi.b

Reputation: 18219

Optimization of a function which look for combination - out-of-memory trouble + speed

Below is a function that creates all possible combination of splitting the elements of x into n groups (all groups have the same number of elements)

Function:

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    
}

Pseudo-code (explainations)

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

This function (and pseudo-code) was first created by Joris Meys on this previous post: Find all possible ways to split a list of elements into a a given number of group of the same size

Is there a way to create a function that returns a given number of randomly taken possible combinations ? Such a function would take a third argument which is either percentage.possibilities or number.possiblities which fix the number of random different combinations the function returns.

Something like:

new.perm.groups(x=1:12,n=3,number.possiblities=50)

Upvotes: 2

Views: 95

Answers (1)

Ferdinand.kraft
Ferdinand.kraft

Reputation: 12819

Working on @JackManey suggestion, you can sample one permutation group in an equiprobable fashion using

sample.perm.group <- function(ning, ngrp)
{
    if( ngrp==1 ) return(seq_len(ning))

    g1 <- 1+sample(ning*ngrp-1, size=ning-1)

    g1 <- c(1, g1[order(g1)])

    remaining <- seq_len(ning*ngrp)[-g1]

    cbind(g1, matrix(remaining[sample.perm.group(ning, ngrp-1)], nrow=ning), deparse.level=0)
}

where ning is the number of elements per group and ngrp is the number of groups.

It returns indices, so if you have an arbitrary vector you can use it as a permutation:

> ind <- sample.perm.group(3,3)
> ind
     [,1] [,2] [,3]
[1,]    1    2    5
[2,]    3    7    6
[3,]    4    8    9
> LETTERS[1:9][ind]
[1] "A" "C" "D" "B" "G" "H" "E" "F" "I"

To generate a sample of permutations of size N, you have two options: If you allow repetitions, i.e., a sample with replacement, all you have to do is run the preceding function N times. OTOH, if your sample is to be taken without replacent, then you can use a rejection mechanism:

sample.perm.groups <- function(ning, ngrp, N)
{
    result <- list(sample.perm.group(ning, ngrp))

    for( i in seq_len(N-1) )
    {
        repeat
        {
            y <- sample.perm.group(ning, ngrp)

            if( all(vapply(result, function(x)any(x!=y), logical(1))) ) break
        }

        result[[i+1]] <- y
    }

    result
}

This is clearly an equiprobable sampling design, and it is unlikely to be inefficient, since the number of possible combinations is usually much larger than N.

Upvotes: 2

Related Questions