перечислить комбинацию из 3 чисел 6 разными способами?

Question

Из диапазона чисел от 001 до 999 я хотел бы иметь возможность сформулировать функцию, в которой от 001 до 199 комбинации чисел будут перечислены до 6 различными способами.Пример 192 как 192, 129, 291, 219, 912, 921. Листинг должен начинаться с 001, который будет отображаться как: 001, 010, 100.

Answer 1

Вы можете создать векторы индексов с помощью tidyr::crossing или 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

..., которые затем можно использовать для подстановки каждого входного вектора при его итерации по ним:

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"

В конечном итоге это все еще много итераций, поэтому, хотя он работает достаточно быстро для 6000 итераций, векторизованный подход будет лучше масштабироваться.

Answer 2

Вот решение, которое дает желаемый результат без дублирования и без дополнительных вызовов для очистки дублированных результатов.Мы используем std::next_permutation из библиотеки алгоритмов в C++, которая принимает вектор в качестве входных данных и генерирует лексикографические перестановки, пока не будет достигнута первая перестановка.Это означает, что мы генерируем только 3 перестановки для 001, 1 перестановку для 999 и 6 перестановок для 123.

Мы начинаем с генерации всех комбинаций as.character(0:9) длины 3 с повторением поиспользование gtools::combinations.

## install.packages("gtools")
myCombs <- gtools::combinations(10, 3, as.character(0:9), repeats.allowed = TRUE)

nrow(myCombs)
[1] 220

Вот версия Rcpp, которая предоставляет std::next_permutation для 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);
    }"
)

И, наконец, мы приводим ее вместе с lapply:

permutedCombs <- lapply(1:nrow(myCombs), function(x) {
    permuteDigits(myCombs[x, ])
})

Вот пример выходных данных:

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"

И вот доказательство того, что у нас есть все 1000 результатов без дублирования:

sum(lengths(permutedCombs))
[1] 1000

identical(sort(as.integer(do.call(c, permutedCombs))), 0:999)
[1] TRUE

Answer 3

Я не уверен, в каком формате вы хотите получить результаты.

Как прокомментировано, это перестановки: combinat::permn, вероятно, самый удобный способ для достижения этого.

Форматирование aчисло с добавлением нуля ("%03d"), разбитое на символы (strsplit(.,"")):

f0 <- function(x) strsplit(sprintf("%03d",x),"")[[1]]

Создайте все перестановки, разбейте их обратно на строки (paste/collapse) и выберите уникальные значения (например, 000 имеет только одно уникальное значение)

f1 <- function(x) unique(sapply(combinat::permn(f0(x)),paste,collapse=""))

Применить к каждому целому числу

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"

Более поздние значения действительно имеют до шести записей.