5
$\begingroup$

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

Improve this question
$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – Michael E2
    Nov 21, 2013 at 4:17
  • $\begingroup$ @MichaelE2 You're right. But anyway, the answers contain methods tackle both general case and specific case. $\endgroup$
    – matheorem
    Nov 21, 2013 at 10:42

4 Answers 4

Reset to default
6
$\begingroup$

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.

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

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]
Improve this answer
$\endgroup$
4
  • $\begingroup$ clever for getMeTheSymms! Straight and fast for fasterSymms $\endgroup$
    – matheorem
    Nov 20, 2013 at 6:53
  • $\begingroup$ @matheorem: Yep, I think you cannot beat fasterSymm. In my system, Timing[Length[fasterSymms[1351]]] gives {0.234002, 456300}. $\endgroup$
    – Hector
    Nov 20, 2013 at 13:51
  • $\begingroup$ what does the n/2 do? $\endgroup$
    – Crisp
    Sep 22, 2014 at 17:25
  • $\begingroup$ 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. $\endgroup$
    – Hector
    Sep 22, 2014 at 18:58
4
$\begingroup$

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.

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

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.

Improve this answer
$\endgroup$
1
  • $\begingroup$ I had never seen that usage of Thread to create nested lists. Upvoted. $\endgroup$
    – Hector
    Nov 21, 2013 at 16:40

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.