# [R] Permutations

Jordi Altirriba Gutiérrez altirriba at hotmail.com
Thu Jul 15 01:35:49 CEST 2004

```  Dear R users,
First of all, I want to thank the algorithms , time and suggestions to
Rolf, Robert, Marc, Gabor, Adaikalavan, Cliff, Robin, Erich and Fernando.
I want to sum up a little bit all the e-mails, the algorithms and the
results of a test for 1000 permutations (in my last e-mail is explained (+
or -) what kind of permutations I wanted).

1.- Gabor Grothendieck
ordered.perm <- function(N) {
samp <- function() c(apply(matrix(sample(12,12),3),2,sort))
z <- vector(length=N, mode="character")
for(i in 1:N)
while( (z[i]<-paste(samp(),collapse=" ")) %in% z[seq(len=i-1)] ) {}
matrix(as.numeric(unlist(strsplit(z, split = " "))), nc = 12, byrow =
TRUE)
}
ordered.perm(1000)
##It's the correct algorithm, there isn't any repetition and there aren't
"intra-block" permutations.

2.- Rolf Turner (1)
restr.perm <- function ()
{
S <- 4:12
G <- NULL
A <- list(1:3,4:6,7:9,10:12)
for(k in 1:4) {
for(i in A[[k]]) {
tmp <- union(i,S)
tmp <- setdiff(tmp,G)
if(length(tmp)==0) return(Recall())
x <- if(length(tmp)==1) tmp else sample(tmp,1)
G <- c(G,x)
S <- setdiff(S,G)
}
S <- union(S,A[[k]])
R <- if(k < 4) A[[k+1]] else NULL
R <- union(R,G)
S <- setdiff(S,R)
}
G
}

a<-matrix(1,1000,12)
for (i in 1:1000)
{
a[i,]<-restr.perm()
}
##With 1000 permutations I have found 3 "intra-block" permutations.

3.- Rolf Turner (2)
restr.perm2 <- function () {
#
okay <- function (x) {
m1 <- cbind(1:12,rep(1:4,rep(3,4)))
m2 <- m1[x,]
all((m2[,1] == m1[,1]) | (m2[,2] != m1[,2]))
}
#
repeat{
x <- sample(12,12)
if(okay(x)) return(x)
}
}

a<-matrix(1,1000,12)
for (i in 1:1000)
{
a[i,]<-restr.perm2()
}
##With 1000 permutations I have found 4 "intra-block" permutations.

4.- Marc Schwartz
library(gregmisc)
# Create non-allowable 'intra-block' permutations
# Need a generalizable way to do this, but
# good enough for now
a <- permutations(3, 3, 1:3)
b <- permutations(3, 3, 4:6)
c <- permutations(3, 3, 7:9)
d <- permutations(3, 3, 10:12)
intra <- rbind(a[-1, ], b[-1, ], c[-1, ], d[-1, ])

restr.perm3 <- function(runs)
{
results <- matrix(numeric(runs * 12), ncol = 12)

# use Gabor's function to check for row matches
# between 'x' and 'intra' to filter out in okay()
f1a <- function(a,b,sep=":")
{
f <- function(...) paste(..., sep=sep)
a2 <- do.call("f", as.data.frame(a))
b2 <- do.call("f", as.data.frame(b))
c(table(c(b2,unique(a2)))[a2] - 1)
}

okay <- function (x)
{
x.match <- matrix(x, ncol = 3, byrow = TRUE)
all(f1a(x.match, intra) == 0)
}

for (i in 1:runs)
{
x <- sample(12,12)
if (okay(x))
results[i, ] <- x
else
results[i, ] <- rep(NA, 12)
}

unique(results[complete.cases(results), ])
}

a<-matrix(1,1000,12)
for (i in 1:1000)
{
a[i,]<-restr.perm3()
}
restr.perm3(1000)
##With 1000 permutations, the function has taken 960 and I have found 4
"intra-block" permutations there.

5.- Fernando Tusell
permutations<-function(elements,blocks) {
n <- length(elements)
el.per.block <- n / blocks
for (i in 1:n) {                    # For each element in turn,
b <- floor(i/(el.per.block+.1))+1 # find which block it belongs to.
if (b==blocks)                    # If in the last block, we are done.
break
allow.pos <- b*el.per.block + 1   # Find first position it could
migrate to...
for (j in (allow.pos:n)) {        # and create permutations with all
allowable
perm <- elements                # interchanges.
perm[i] <- elements[j]
perm[j] <- elements[i]
print(perm)
}
}    }

permutations(1:12,3)
##There are only 48 permutations

6.- Cliff Lunneborg
swap<-function(data,blocks)
{
dd<- data
cc<- 1:length(data)
bb<- unique(blocks)
aa<- sample(bb,2,replace=FALSE)
a1<- sample(cc[blocks==aa],1)
a2<- sample(cc[blocks==aa],1)
dd[a1]<- data[a2]
dd[a2]<- data[a1]
dd
}

x.d<- c(1,2,3,4,5,6,7,8,9,10,11,12)
x.b<- c(1,1,1,2,2,2,3,3,3,4,4,4)

a<-matrix(1,1000,12)
for (i in 1:1000)
{
if (i==1)
{a[i,]<-swap(x.d,x.b)
f<-swap(x.d,x.b)}
else
{a[i,]<-swap(f,x.b)
f<-swap(f,x.b)}
}

##There are 2 repetitions a 2 "intra-block" permutations

7.- Robin Hankin
a<-matrix(1,200,12)
for (i in 1:200)
{
x <- c(1,2,3,4,5,6,7,8,9,10,11,12)
dim(x) <- c(3,4)
jj <- t(apply(x,1,sample))
a[i,]<-as.vector(jj)
}
##In 200 permutations, there are 5 repetitions.

Thanks to all and sorryfor the confusion that have generated the
"intra-block" permutation.

Jordi Altirriba
PhD student
Hospital Clinic - Barcelona - Spain

P.S. I think that I don't have forgot to anybody...(sorry if I have done it)

```