list a combination of 3 numbers in 6 different ways? - r

Question

From a range of numbers from 001 to 999, I would like to be able to formulate a function where from 001 to 199, the combinations of numbers will be listed in up to 6 different ways. Example 192 as 192, 129, 291, 219, 912, 921. The listing should obviously begin with 001 which will show as: 001, 010, 100.

Answer 1

I'm not sure what format you want the results in.
As commented, these are permutations: combinat::permn is probably the most convenient way to achieve this.
Format a number with zero-padding ("%03d"), split into characters (strsplit(.,"")):
f0 <- function(x) strsplit(sprintf("%03d",x),"")[[1]]
Create all permutations, squash them back into strings (paste/collapse), and select the unique values (e.g. 000 has only one unique value)
f1 <- function(x) unique(sapply(combinat::permn(f0(x)),paste,collapse=""))
Apply to each of the integers
result <- lapply(0:999,f1)
head(result)
[[1]]
[1] "000"
[[2]]
[1] "001" "010" "100"
[[3]]
[1] "002" "020" "200"
[[4]]
[1] "003" "030" "300"
[[5]]
[1] "004" "040" "400"
[[6]]
[1] "005" "050" "500"
Later values do indeed have up to six entries.

Answer 2

You could make vectors of indices with tidyr::crossing or expand.grid:
library(tidyverse)
indices <- crossing(x = 1:3, y = 1:3, z = 1:3) %>%
filter(x != y, x != z, y != z) %>%
pmap(~unname(c(...)))
indices %>% str
#> List of 6
#> $ : int [1:3] 1 2 3
#> $ : int [1:3] 1 3 2
#> $ : int [1:3] 2 1 3
#> $ : int [1:3] 2 3 1
#> $ : int [1:3] 3 1 2
#> $ : int [1:3] 3 2 1
...which you can then use to subset each input vector as you iterate across them:
perms <- pmap(crossing(x = 0:9, y = 0:9, z = 0:9), function(...){
map_chr(indices, function(x) paste(c(...)[x], collapse = "")) %>%
unique()
})
perms[500:510] %>% str(vec.len = 6)
#> List of 11
#> $ : chr [1:3] "499" "949" "994"
#> $ : chr [1:3] "500" "050" "005"
#> $ : chr [1:6] "501" "510" "051" "015" "150" "105"
#> $ : chr [1:6] "502" "520" "052" "025" "250" "205"
#> $ : chr [1:6] "503" "530" "053" "035" "350" "305"
#> $ : chr [1:6] "504" "540" "054" "045" "450" "405"
#> $ : chr [1:3] "505" "550" "055"
#> $ : chr [1:6] "506" "560" "056" "065" "650" "605"
#> $ : chr [1:6] "507" "570" "057" "075" "750" "705"
#> $ : chr [1:6] "508" "580" "058" "085" "850" "805"
#> $ : chr [1:6] "509" "590" "059" "095" "950" "905"
This ultimately is still a lot of iteration, so while it works fast enough for 6000 iterations, a vectorized approach would scale better.

Answer 3

Here is a solution that gives the desired output with no duplication and no additional calls to clean up duplicate results. We take advantage of std::next_permutation from the the algorithm library in C++, which takes a vector as input and generates lexicographical permutations until the first permutation is reached. This means, we only generate 3 permutations for 001, 1 permutation for 999, and 6 permutation for 123.
We start by generating all combinations of as.character(0:9) of length 3 with repetition by utilizing gtools::combinations.
## install.packages("gtools")
myCombs <- gtools::combinations(10, 3, as.character(0:9), repeats.allowed = TRUE)
nrow(myCombs)
[1] 220
Here is an Rcpp version that exposes std::next_permutation to R:
## install.packages("Rcpp")
Rcpp::cppFunction(
"CharacterVector permuteDigits(CharacterVector v) {
std::string myStr;
std::vector<std::string> result;
for (std::size_t i = 0; i < v.size(); ++i)
myStr += v[i];
do {
result.push_back(myStr);
} while(std::next_permutation(myStr.begin(), myStr.end()));
return wrap(result);
}"
)
And finally, we bring it altogether with lapply:
permutedCombs <- lapply(1:nrow(myCombs), function(x) {
permuteDigits(myCombs[x, ])
})
Here is some sample output:
permutedCombs[1:5]
[[1]]
[1] "000"
[[2]]
[1] "001" "010" "100"
[[3]]
[1] "002" "020" "200"
[[4]]
[1] "003" "030" "300"
[[5]]
[1] "004" "040" "400"
permutedCombs[151:155]
[[1]]
[1] "356" "365" "536" "563" "635" "653"
[[2]]
[1] "357" "375" "537" "573" "735" "753"
[[3]]
[1] "358" "385" "538" "583" "835" "853"
[[4]]
[1] "359" "395" "539" "593" "935" "953"
[[5]]
[1] "366" "636" "663"
And here is proof that we have all 1000 results with no duplications:
sum(lengths(permutedCombs))
[1] 1000
identical(sort(as.integer(do.call(c, permutedCombs))), 0:999)
[1] TRUE