Reputation: 2609
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 (e.g. 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.
Upvotes: 2
Views: 224
Reputation: 1253
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
Upvotes: 5
Reputation: 76402
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
Upvotes: 2
Reputation: 16121
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
.
Upvotes: 2