R: Restricted permutations more efficient way than using for loops

Question

I am trying to permute a char vector a of variable length picking 3 elements every time, without repetition. Ordering counts only for the first element but doesn't for second and third (eg abc != bac != cab, but abc = acb and bca = bac). Each set of 3 permuted elements should be a row in a dataframe b .

A vector with letters a , b , c , d , e would result in this expected output:

abc
abd
abe
acd
ace
ade

bac
bad
bae
bcd
bce
bde

cab 
cad
cae
cbd
cbe
cde

dab
dac
dae
dbc
dbe
dce

eab
eac
ead
ebc
ebd
ecd

Using 3 for loops I think I was able to achieve this output, but it is slow if the vector is long.

a = letters[1:5]
aL = length(a)
b <- data.frame(var1 = character(),
                var2 = character(), 
                var3 = character(), 
                stringsAsFactors = FALSE) 


# restricted permutations for moderation
pracma::tic()
for(i in 1:aL){
  for(j in 1:(aL-1)){
    for(k in (j+1):aL){
      if(j != i & k != i) { 
        b <- rbind(b, data.frame(a[i], a[j], a[k])) }
    }
  }
}
pracma::toc()
#> elapsed time is 0.070000 seconds
b
#>    a.i. a.j. a.k.
#> 1     a    b    c
#> 2     a    b    d
#> 3     a    b    e
#> 4     a    c    d
#> 5     a    c    e
#> 6     a    d    e
#> 7     b    a    c
#> 8     b    a    d
#> 9     b    a    e
#> 10    b    c    d
#> 11    b    c    e
#> 12    b    d    e
#> 13    c    a    b
#> 14    c    a    d
#> 15    c    a    e
#> 16    c    b    d
#> 17    c    b    e
#> 18    c    d    e
#> 19    d    a    b
#> 20    d    a    c
#> 21    d    a    e
#> 22    d    b    c
#> 23    d    b    e
#> 24    d    c    e
#> 25    e    a    b
#> 26    e    a    c
#> 27    e    a    d
#> 28    e    b    c
#> 29    e    b    d
#> 30    e    c    d

^{Created on 2019-07-17 by the reprex package (v0.2.1)}

How can I achieve the same outcome in less time. Is recursion faster?

Any help is greatly appreciated. Thank you.

Answer 1

I propose the following solution:

a = letters[1:5]
A = t(combn(a,3)) # create all possible three-letter combinations, 
                  # disregarding the order 
Full = rbind(A, A[,3:1], A[,c(2,3,1)]) # put every of the elements of the 
                                       # differing combinations in first place once

Answer 2

Here's one option for your specific example:

library(gtools)
library(dplyr)

# example vector
vec = letters[1:5]

# vectorised function to rearrange elements (based on your restriction)
f = function(x1,x2,x3) paste0(c(x1, sort(c(x2,x3))), collapse = " ")
f = Vectorize(f)

permutations(length(vec), 3, vec) %>%      # get permutations
  data.frame(., stringsAsFactors = F) %>%  # save as data frame
  mutate(vec = f(X1,X2,X3)) %>%            # apply function to each row
  distinct(vec, .keep_all = T)             # keep distinct vec values

#    X1 X2 X3   vec
# 1   a  b  c a b c
# 2   a  b  d a b d
# 3   a  b  e a b e
# 4   a  c  d a c d
# 5   a  c  e a c e
# 6   a  d  e a d e
# 7   b  a  c b a c
# ...

Not clear if you want your output to be 3 separate columns with 1 element each, or one column with the vector, so I'm keeping both for you to choose from. You can keep columns {X1, X2, X3} or just vec .

Answer 3

The following is a straightforward rewrite of the triple for loop as a triple lapply loop.

t1 <- system.time({
for(i in 1:aL){
  for(j in 1:(aL-1)){
    for(k in (j+1):aL){
      if(j != i & k != i) { 
        b <- rbind(b, data.frame(a[i], a[j], a[k])) }
    }
  }
}
})

t2 <- system.time({
d <- lapply(1:aL, function(i){
  tmp <- lapply(1:(aL-1), function(j){
    tmp <- lapply((j+1):aL, function(k){
      if(j != i & k != i) c(a[i], a[j], a[k])
    })
    do.call(rbind, tmp)
  })
  do.call(rbind, tmp)
})
d <- do.call(rbind.data.frame, d)
names(d) <- paste("a", 1:3, sep = ".")
})

all.equal(b, d)
#[1] "Names: 3 string mismatches"

rbind(t1, t2)
#   user.self sys.self elapsed user.child sys.child
#t1     0.051        0   0.051          0         0
#t2     0.017        0   0.018          0         0