How to delete mirror symmetric point pair efficiently

Look at following pic There are five points, I can generate the following point pairs

In:= tt=Subsets[{1, 2, 3, 4, 5}, {2}]

Out:= {{1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}, {2, 5}, {3,
4}, {3, 5}, {4, 5}}

But if I define mirror symmetry equivalence between point pairs. For example

{1,2} equals {4,5}
{1,3} equals {3,5}
{1,4} equals {2,5}
{2,3} equals {3,4}
.....etc

Then how to select half of the symmetric point pair from tt and keep only half of the original set. And in this case, I want keep left part, That is keep

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

• The title seems a little misleading: Are you interested in deleting symmetric pairs from an arbitrary list, or just generating a list of all pairs {i, j} with i < j && i+ j <= n + 1 (where n is 5 in the example above)? It seems the latter from the comments. – Michael E2 Nov 21 '13 at 4:17
• @MichaelE2 You're right. But anyway, the answers contain methods tackle both general case and specific case. – matheorem Nov 21 '13 at 10:42

Let's start with standard approaches which have quadratic time complexity, so for larger lists they are not recommended:

Union[ tt, SameTest -> (#1 == {6, 6} - Reverse @ #2 &)]

DeleteDuplicates[ tt, #1 == {6, 6} - Reverse @ #2 &]

they both return:

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

Alternatively let's use another approach (I learnt it from this answer by Leonid Shifrin):

deleteMS[n_?OddQ] /; n > 2 :=
Module[{ lst = Subsets[Range[n], {2}], g},
g[x_] := (g[{n + 1, n + 1} - Reverse@x] = Sequence[]; x);
g /@ lst]

now

deleteMS
{{1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}}

and for example

deleteMS // Length
456300

I would apply deleteMS for larger n since its time complexity is linear unlike in the former approaches. One can test that for n > 100 it works reasonably fast, while DeleteDuplicates or Union with tests are very inefficient.

• In my system: Timing[Length[deleteMS]] gives {5.584836, 456300} and Timing[Length[getMeTheSymms]] gives {1.528810, 456300}. – Hector Nov 20 '13 at 5:51
• why deleteMS didn't give any result on my mathematica? – matheorem Nov 20 '13 at 6:49
• Oh, I know, n must be odd – matheorem Nov 20 '13 at 6:52

For each pair, generate the symmetric pairs, put them in some canonical order and then delete the repeated cases.

getMeTheSymms[n_Integer?Positive] := Map[First, Union[Sort[{#, Sort[n + 1 - #]}] & /@
Subsets[Range[n], {2}]], {1}];
getMeTheSymms
(*{{1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}}*)

If you are constrained by time, you might want to use the following code:

fasterSymms[n_Integer?Positive] := Flatten[
Table[{i, j}, {i, 1, n/2}, {j, i + 1, n - i + 1}], 1]
• clever for getMeTheSymms! Straight and fast for fasterSymms – matheorem Nov 20 '13 at 6:53
• @matheorem: Yep, I think you cannot beat fasterSymm. In my system, Timing[Length[fasterSymms]] gives {0.234002, 456300}. – Hector Nov 20 '13 at 13:51
• what does the n/2 do? – Crisp Sep 22 '14 at 17:25
• It limits the initial cases. Note that the first entry in the elements in the answer is never larger than n/2 (it is either 1 or 2 in the OP example). So, do not generate extra cases at the beginning. – Hector Sep 22 '14 at 18:58

Join@@Table[Thread@{i,Range[i+1,n+1-i]},{i,n/2}] is faster than HectorSymms on my system -- 1.29 sec vs 1.66 sec for n = 3579. Join@@(...) is faster than Flatten[...,1], and adding 1 to the Range limits instead adding it to the whole list also saves a little time.

• And this is what I like about MSE .. I knew that "you cannot beat" will attract more interest. Upvoted your answer. – Hector Nov 21 '13 at 16:38
• @RayKoopman Dankjewel! I will use Join in the future. – KennyColnago Nov 22 '13 at 5:59
• @Kenny These things can be release- and platform-dependent. Try them on your system -- YMMV. – Ray Koopman Nov 22 '13 at 6:47

Hector can beat his own code with: