[R] Fixed size permutations

[Peter Ehlers]

Small modification below.

Peter Ehlers wrote:
> Nick Fankhauser wrote:
>> I'm using functions to return a matrix of all permutations of a
>> specified size from a larger list for predictor selection.
>> For each predictor size I use a seperate function like this:
>>
>> bag2 <- function(n) {
>>     rl <- c()
>>     for (i1 in seq(n)) {
>>         for (i2 in seq(n)) {
>>             if (length(unique(c(i1,i2)))==1) {next}
>>             rl <- cbind(rl,matrix(c(i1,i2)))
>>         }
>>     }
>>     rl
>> }
>>
>> bag3 <- function(n) {
>>     rl <- c()
>>     for (i1 in seq(n)) {
>>         for (i2 in seq(n)) {
>>             for (i3 in seq(n)) {
>>                 if (length(unique(c(i1,i2,i3)))==1) {next}
>>                 rl <- cbind(rl,matrix(c(i1,i2,i3)))
>>             }
>>         }
>>     }
>>     rl
>> }
>>
>> But I think it should be somehow possible in R to use one general
>> function for all sizes. Can someone help?
>> I don't exactly know how this kind of permutation is called, maybe this
>> would help to find a solution.
>>
>> Nick
>>
> Looks to me like you're just doing expand.grid, but without
> the 'all variables equal' cases. If that's correct and if
> n > 1, then this might do it:
> 
> bag <- function(n,K){
>   L <- vector(mode='list', length=K)
>   L <- lapply(L, function(x) {x <- seq_len(n)})
>   d <- expand.grid(L)
>   keeprow <- apply(d, 1, function(x) {var(x)!=0})
>     ## I'm blanking out on a better way to test for equal values
   keeprow <- apply(d, 1, function(x) {length(unique(x)) > 1})

is probably more efficient and certainly more transparent.

  -Peter Ehlers

>   td <- t(as.matrix(d[keeprow,]))
>   dimnames(td) <- c(NULL, NULL)
>   rtd <- td[nrow(td):1,]
>   rtd
> }
> all.equal(bag(5,2), bag2(5))
> #[1] TRUE
> 
> all.equal(bag(9,3), bag3(9))
> #[1] TRUE
> 
>  -Peter Ehlers
> 
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide 
> http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
> 
> 

-- 
Peter Ehlers
University of Calgary
403.202.3921