# Fastest way to generate {{a,a},{a,b},{a,c},{b,b},{b,c},{c,c}} from {a,b,c}

What is the fastest way to generate {{a,a},{a,b},{a,c},{b,b},{b,c},{c,c}} from l={a,b,c}? I've tried

Flatten[Table[{l[[i]],l[[j]]},{i,Length@l},{j,i,Length@l}],1]

but is there a faster and perhaps more elegant way (maybe with Tuples)?

• l // ({#, #} & /* Tuples /* DeleteDuplicatesBy[Intersection]) should work. Commented May 24, 2022 at 14:40
• This is about 2.5 times as slow as my original attempt with Flatten. Commented May 24, 2022 at 15:11
• there is the "hey, that's not what I meant!" way: {{a,a},{a,b},{a,c},{b,b},{b,c},{c,c}}&[l]. seems blazingly fast. ;) Commented May 25, 2022 at 7:52
• Just wondering: what does speed have to do with such a trivial and blindingly fast calculation? Why would anyone care? Commented May 25, 2022 at 18:38
• It's a minimal example with three elements. Actually, I do such calculations/generations with about 10^5 elements. Commented May 26, 2022 at 21:19

GroupTheoryToolsMultisets[{a, b, c}, 2]


{{a,a},{a,b},{a,c},{b,b},{b,c},{c,c}}

• So far the fastest method for my purposes and also very elegant! Commented May 26, 2022 at 22:08
Select[Tuples[{a,b,c},2],OrderedQ]

• This is about twice as fast as my original attempt with Flatten, wonderful! Commented May 24, 2022 at 15:14

Another possibility is to use Pick:

Pick[
Tuples[{a,b,c}, 2],
Flatten @ UpperTriangularize @ ConstantArray[1, {3, 3}],
1
]


{{a, a}, {a, b}, {a, c}, {b, b}, {b, c}, {c, c}}

https://mathematica.stackexchange.com/a/235768/72111

m = 3;
n = 2;
list = Subsets[Range[2, m + n], {n}];
result = Subtract[#, Range[n]] & /@ list
Alphabet[][[1 ;; m]][[#]] & /@ result

• Test the timming.
(m = 26;
n = 6;
list = Subsets[Range[2, m + n], {n}];
result = Subtract[#, Range[n]] & /@ list;
Alphabet[][[1 ;; m]][[#]] & /@ result) // AbsoluteTiming

• compare with
Select[Tuples[Alphabet[], 6], OrderedQ] // AbsoluteTiming

• This is about 26 times as slow as my original attempt with Flatten. Commented May 24, 2022 at 15:17
• @Thrash Please compare with Select[Tuples[Range[26], 5], OrderedQ] // AbsoluteTiming and (m = 26; n = 5; list = Subsets[Range[2, m + n], {n}]; result = Subtract[#, Range[n]] & /@ list) // AbsoluteTiming Commented May 24, 2022 at 15:23
• I think your code is very fast for large n, but for my current purposes I need only the case n=2. Compare Select[Tuples[Alphabet[], 2], OrderedQ]; // RepeatedTiming with (m = 26; n = 2; list = Subsets[Range[2, m + n], {n}]; result = Subtract[#, Range[n]] & /@ list; Alphabet[][[1 ;; m]][[#]] & /@ result;) // RepeatedTiming. On my computer about 67 times as slow as the Select method. Thanks anyway, it could be useful one day! Commented May 24, 2022 at 15:46

Using Cases:

Cases[Tuples[{a, b, c}, 2], _?OrderedQ] // AbsoluteTiming
(*{0.0000291, {{a, a}, {a, b}, {a, c}, {b, b}, {b, c}, {c, c}}}*)

Outer[List, {a,b,c},{a,b,c}] //
Flatten[#,1]& //
Select[OrderedQ]


{{a, a}, {a, b}, {a, c}, {b, b}, {b, c}, {c, c}}

Using an inverse pairing function:

SetAttributes[toPair, Listable];
toPair[r_Integer?Positive] := With[{c = Quotient[NumberTheoryIntegerSqrt[8 r] + 1, 2]},
{Quotient[c (3 - c), 2] + r - c, c}]


we can do the following:

list = {a, b, c};
list[[#]] & /@ SortBy[toPair[Range[Binomial[Length[list] + 1, 2]]], First]
{{a, a}, {a, b}, {a, c}, {b, b}, {b, c}, {c, c}}


(a) Subsets and Transpose

{Subsets[#,{2}],Transpose[{#,#}]}&@{a,b,c}//Catenate//Sort

(* {{a, a}, {a, b}, {a, c}, {b, b}, {b, c}, {c, c}} *)

{Subsets[#,{2}],Transpose[{#,#}]}&@{a,b,c,d}//Catenate//Sort

(* {{a, a}, {a, b}, {a, c}, {a, d}, {b, b}, {b, c}, {b, d}, {c, c}, {c, d}, {d, d}} *)


(b) Complement, Tuples and Subsets

Complement[Tuples[{a,b,c},2],Subsets[Reverse@{a,b,c},{2}]]

(* {{a, a}, {a, b}, {a, c}, {b, b}, {b, c}, {c, c}} *)

Complement[Tuples[{a,b,c,d},2],Subsets[Reverse@{a,b,c,d},{2}]]

(* {{a, a}, {a, b}, {a, c}, {a, d}, {b, b}, {b, c}, {b, d}, {c, c}, {c, d}, {d, d}} *)

// Complement conveniently sorts


(c) Distribute

Distribute[{l,l}, List,List, Select[{##},OrderedQ]&]

(* {{a, a}, {a, b}, {a, c}, {b, b}, {b, c}, {c, c}} *)


### Just for fun

#### Subsets and Transpose

subsets=Thread[Subsets[Range[20],{2}] -> 1];

ArrayPlot[SparseArray@Join[subsets,transpose],
Mesh-> True,
ColorRules -> {1 -> Purple, 2 -> Green},
ImageSize->200]


#### Tuples/Distribute

ArrayPlot[SparseArray@Thread[Tuples[Range[20],{2}]->1],
Mesh->True,
ColorRules -> {1 -> Blue},
ImageSize->200]


#### Subsets[list] and Subsets[Reverse@list]

subsets=Thread[Subsets[Range[20],{2}] -> 1];

ArrayPlot[SparseArray@Join[subsets,subsetsReversed], Mesh-> True,ColorRules -> {1 -> Purple, 2 -> Violet },ImageSize->200]


n = 2000;
alphabet = Range[n];(*or whatever you like*)
result = Transpose[{
Join @@ MapIndexed[ConstantArray[#1, n + 1 - #2] &, alphabet],
Join @@ Map[alphabet[[# ;;]] &, Range[n]]
}];


Seems to be about twice as fast as Carl Woll's Pick method (which I really like!).

If the performance is important, try this

ClearAll[combinationsWithReplacement];

combinationsWithReplacement[A_?VectorQ, k_Integer] :=
With[{m = Length@A + k - 1},
Partition[Part[A, Flatten@(DeveloperToPackedArray@Subsets[Range@m, {k}] +
ConstantArray[-Range[0, k - 1], Binomial[m, k]])], k]
];

combinationsWithReplacement[{a, b, c}, 2]
combinationsWithReplacement[Range[26], 7] // Dimensions // AbsoluteTiming


{{a, a}, {a, b}, {a, c}, {b, b}, {b, c}, {c, c}}
{0.833452, {3365856, 7}}

A rip off from python's itertools:

ClearAll[combinations$$with$$replacement] ;
combinations$$with$$replacement[sequence_, r_] := Block[
{n, indices, result, range, flag, i, j},
n = Length[sequence] ;
indices = ConstantArray[1, r] ;
result = {sequence[[indices]]} ;
range = Reverse[Range[r]] ;
While[
True,
Do[
j = i ;
flag = True ;
If[
indices[[i]] != n,
flag = False ;
Break[] ;
],
{i, range}
] ;
If[flag, Return[result]] ;
indices[[j;;]] = ConstantArray[indices[[j]] + 1, r - j + 1] ;
result = Join[result, {sequence[[indices]]}]
] ;
] ;
combinations$$with$$replacement[{a, b, c}, 2]
(* {{a,a},{a,b},{a,c},{b,b},{b,c},{c,c}} *)

x = {a, b, c};

Union @ Map[Sort] @ Apply[Join] @ Outer[List, x, x]


{{a, a}, {a, b}, {a, c}, {b, b}, {b, c}, {c, c}}