holic - 8 months ago 35

R Question

My problem is as follows:

Imagine we have a vector

`(1,1,1,...,0,0)`

`n`

`k`

`L1`

`Ln`

`sum over all unique permutations of (1,1,1,...,0,0) of Function(L1,...,Ln)`

I have searched for solutions of my problem and yes, there are some, which work as long as

`n`

As long as

`n`

1) creating a data.frame of all unique permutations with a help of following code (found it here)

`uniqueperm2 <- function(d) {`

dat <- factor(d)

N <- length(dat)

n <- tabulate(dat)

ng <- length(n)

if(ng==1) return(d)

a <- N-c(0,cumsum(n))[-(ng+1)]

foo <- lapply(1:ng, function(i) matrix(combn(a[i],n[i]),nrow=n[i]))

out <- matrix(NA, nrow=N, ncol=prod(sapply(foo, ncol)))

xxx <- c(0,cumsum(sapply(foo, nrow)))

xxx <- cbind(xxx[-length(xxx)]+1, xxx[-1])

miss <- matrix(1:N,ncol=1)

for(i in seq_len(length(foo)-1)) {

l1 <- foo[[i]]

nn <- ncol(miss)

miss <- matrix(rep(miss, ncol(l1)), nrow=nrow(miss))

k <- (rep(0:(ncol(miss)-1), each=nrow(l1)))*nrow(miss) +

l1[,rep(1:ncol(l1), each=nn)]

out[xxx[i,1]:xxx[i,2],] <- matrix(miss[k], ncol=ncol(miss))

miss <- matrix(miss[-k], ncol=ncol(miss))

}

k <- length(foo)

out[xxx[k,1]:xxx[k,2],] <- miss

out <- out[rank(as.numeric(dat), ties="first"),]

foo <- cbind(as.vector(out), as.vector(col(out)))

out[foo] <- d

t(out)

}

2) sum over components of this data.frame

Sadly in my problems

`n`

`Funktion(L1,...,Ln)`

Hack-R asked for an example, here what i get

`> d <- c()`

> d[1:25]=0

> d[25:50]=1

> d

[1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1

> uniqueperm2(d)

Error: cannot allocate vector of size 905608.1 Gb

In addition: Warning messages:

1: In vector("list", count) :

Reached total allocation of 8109Mb: see help(memory.size)

2: In vector("list", count) :

Reached total allocation of 8109Mb: see help(memory.size)

3: In vector("list", count) :

Reached total allocation of 8109Mb: see help(memory.size)

4: In vector("list", count) :

Reached total allocation of 8109Mb: see help(memory.size)

Answer

Here's one way to walk the permutations. I still think there is a better way but haven't figured it out yet.

This function looks at an array of 1's an 0's and tries to move the right most 1 to the left if possible. (Basically thinking of the vector as a binary number and trying to find the next largest number with exactly `n`

bits)

```
next_x <- function(x) {
i <- tail(which(diff(x)==1),1)
if (length(i)>0) {
x[c(i, i+1)]<-c(1,0)
x[(i+1):length(x)] <- sort(x[(i+1):length(x)])
} else {
stop("no more moves")
}
x
}
```

You start out with `x`

all to the right and you can iterate with

```
x <- c(0,0,0,0,1,1,1)
while(!all(x==c(1,1,1,0,0,0,0))) {
x <- next_x(x)
print(x)
}
```