Сочетания с повторением

Question

Я использую Mathematica 7 и с помощью функции пакета combinatorica я могу получить все комбинации определенного числа из списка элементов, где порядок не имеет значения и нет повторений. Например:

in: KSubsets[{a, b, c, d}, 3]
out: {{a, b, c}, {a, b, d}, {a, c, d}, {b, c, d}}

Я не могу найти функцию, которая выдаст мне все комбинации определенного числа из списка элементов, где порядок не имеет значения и равно повторению. то есть приведенный выше пример будет включать в вывод такие элементы, как {a, a, b}, {a, a, a}, {b, b, b} ... и т. д.

Может потребоваться пользовательская функция. Если я смогу найти такой вариант, я опубликую ответ, но пока я не вижу очевидного решения.

Edit: В идеале выходные данные не будут содержать дублирование комбинации, например Кортежи [{a, b, c, d}, 3] вернет список, который содержит два элемента, таких как {a, a, b} и {b, a, a} которые с точки зрения комбинаций одинаковы.

Answer 1

Вы можете закодировать каждую комбинацию как {na,nb,nc,nd}, где na указывает количество раз, которое появляется a.Задача состоит в том, чтобы найти все возможные комбинации из 4 неотрицательных целых чисел, которые складываются до 3. IntegerPartition дает быстрый способ генерировать все такие такие комбинации, где порядок не имеет значения, и вы следуете с Permutations дляучет различных заказов

vars = {a, b, c, d};
len = 3;
coef2vars[lst_] := 
 Join @@ (MapIndexed[Table[vars[[#2[[1]]]], {#1}] &, lst])
coefs = Permutations /@ 
   IntegerPartitions[len, {Length[vars]}, Range[0, len]];
coef2vars /@ Flatten[coefs, 1]

Просто для удовольствия, вот временное сравнение между IntegerPartitions и Tuples для этой задачи, в log-секундах

approach1[numTypes_, len_] := 
  Union[Sort /@ Tuples[Range[numTypes], len]];
approach2[numTypes_, len_] := 
  Flatten[Permutations /@ 
    IntegerPartitions[len, {numTypes}, Range[0, len]], 1];

plot1 = ListLinePlot[(AbsoluteTiming[approach1[3, #];] // First // 
       Log) & /@ Range[13], PlotStyle -> Red];
plot2 = ListLinePlot[(AbsoluteTiming[approach2[3, #];] // First // 
       Log) & /@ Range[13]];
Show[plot1, plot2]

http://yaroslavvb.com/upload/save/tuples-vs-partitions.png

Answer 2

DeleteDuplicates[Map[Sort, Tuples[{a, b, c, d}, 3]]]

Answer 3

Вот простое решение, которое использует преимущества встроенных функций Mathetmatica Subsets и, таким образом, представляет собой хороший баланс между простотой и производительностью. Существует простая биекция между k-подмножествами [n + k-1] и k-комбинациями [n] с повторением. Эта функция изменяет подмножества в комбинации с повторением.

CombWithRep[n_, k_] := #-(Range[k]-1)&/@Subsets[Range[n+k-1],{k}]

So

CombWithRep[4,2]

выходы

{{1,1},{1,2},{1,3},{1,4},{2,2},{2,3},{2,4},{3,3},{3,4},{4,4}}

Answer 4

Небольшой вариант элегантного метода от High Performance Mark:

Select[Tuples[{a, b, c, d}, 3], OrderedQ]

Перестановки немного более универсальны (но не то, что вы ищете?)

Например:

Select[Permutations[
  Sort@Flatten@ConstantArray[{a, b, c, d}, {3}], {2, 3}], OrderedQ]

дает следующее

Edit:

Select[Tuples[Sort@{a, b, d, c}, 3], OrderedQ]

вероятно, лучше

Edit-2

Конечно, также можно использовать чехлы. Например

Cases[Permutations[
  Sort@Flatten@ConstantArray[{a, b, d, c}, {3}], {2, 3}], _?OrderedQ]

Edit-3.

Два подхода будут отличаться, если список содержит повторяющийся элемент. Выход из следующее (подход 2), например, будет содержать дубликаты (которые могут быть или не быть желательными):

Select[Tuples[{a, b, c, d, a}, 3], OrderedQ]

От них легко избавиться:

Union@Select[Tuples[{a, b, c, d, a}, 3], OrderedQ]

Следующее оценивается как «True» (удалить дубликаты элементов из списка, представленного для подхода 2, и отсортировать список, созданный в подходе 1 (метод High Performance Mark):

lst = RandomInteger[9, 50]; 
Select[Union@Sort@Tuples[lst, 3], OrderedQ] == 
 Sort@DeleteDuplicates[Map[Sort, Tuples[lst, 3]]]

как и следующее (удалить дубликаты из вывода подхода 2, сортировать выходные данные подхода 1):

lst = RandomInteger[9, 50]; 
Union@Select[Sort@Tuples[lst, 3], OrderedQ] == 
 Sort@DeleteDuplicates[Map[Sort, Tuples[lst, 3]]]

Извините за это!