5

Look at following pic

enter image description here

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}}

matheorem
  • 17,132
  • 8
  • 45
  • 115
  • 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 04: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

4 Answers4

6

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[5]

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

and for example

deleteMS[1351] // 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.

Community
  • 1
Artes
  • 57,212
  • 12
  • 157
  • 245
4

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[5]
(*{{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]
Hector
  • 6,428
  • 15
  • 34
  • clever for getMeTheSymms! Straight and fast for fasterSymms – matheorem Nov 20 '13 at 06:53
  • @matheorem: Yep, I think you cannot beat fasterSymm. In my system, Timing[Length[fasterSymms[1351]]] 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
4

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.

Ray Koopman
  • 3,306
  • 14
  • 13
3

Hector can beat his own code with:

HectorSymms[n_Integer?Positive]:=Flatten[Table[Thread[{i,Range[i,n-i]+1}],{i,1,n/2}],1]

On my system, the timing forfasterSymms[1351]is 0.233s, whileHectorSymms[1351]takes only 0.098s.

KennyColnago
  • 15,209
  • 26
  • 62