Delete redundant {x,y} pairs

Question

Working through the problems from Hazrat's Mathematica book and there's a simple exercise to find all the square numbers where $n^2+m^2=h^2$ yields $h$ as an integer (I think they're also called Pythagorean triples?) for $n$ and $m$ 1-100.

Anyway, I'm still learning so I did a brute force attack on every {n,m} pair:

squareNumberQ[{n_Integer,m_Integer}]:= IntegerQ[Sqrt[n^2+m^2]] ;
allPossiblePairs = Flatten[Table[{n,m},{n,1,10},{m,1,10}],1] ;
squareNumbers = Select[allPossiblePairs, squareNumberQ]
(* {{3,4},{4,3},{6,8},{8,6}} *)

I understand I could wrap all that into one line but I'm at the stage where I'm still wrestling with #& syntax so doing it piece by piece helps me debug the individual steps.

My question is how do I delete one of the pairs as {3,4} is the same as {4,3} for this exercise. I can do it by changing the Table command and re-running:

Flatten[Table[{n,m},{n,1,10},{m,n,10}],1]

and there are already a few comments on alternate ways to eliminate duplicates from the candidate {x,y} pairs but I'm wondering how you would delete them if this wasn't an option.

There should be a way to DeleteCases based on a pattern {x_,y_} == {y_,x_} in the results? but my attempt is failing miserably ie:

DeleteCases[squareNumbers,#1[[_,1]]==#2[[_,2]]&]

I've hunted for variations of 'delete duplicate pairs' but most DeleteCases examples I've found are simple T/F statements on a single element of the list.

Trivial example but I'm still wrapping my head around this pattern matching business.

Answer 1

DeleteDuplicatesBy[Sort][squareNumbers]
DeleteDuplicatesBy[ReverseSort][squareNumbers] (* thanks: @Sascha *)
DeleteDuplicatesBy[squareNumbers, Sort]
DeleteCases[squareNumbers, {x_, y_} /; x > y]
DeleteCases[squareNumbers, _?(Not[OrderedQ@#] &)]
Select[squareNumbers, OrderedQ]
Select[allPossiblePairs, OrderedQ @ # && squareNumberQ @ # &]
Cases[allPossiblePairs, _?(OrderedQ@# && squareNumberQ@# &)]
Cases[allPossiblePairs, x : {_, _} /; OrderedQ@x && squareNumberQ@x]

all give

{{3, 4}, {6, 8}}

Answer 2

You might consider not generating the extraneous pairs, rather than removing them. It only requires a very small change to your code.

pairs = Flatten[Table[{n, m}, {n, 1, 10}, {m, 1, n}], 1];
Select[pairs, squareNumberQ]

{{4, 3}, {8, 6}}

Answer 3

DeleteDuplicates[Sort /@ allPossiblePairs]

Answer 4

Using pattern matching i.e. ReplaceAll(/.), Rule(->) and Condition(/;)

squareNumbers /. {a_, b_} /; a > b -> Nothing

I read this (and any such) line of code to myself as

Replace any list of two elements $(a,b)$ where $a$ is larger than $b$ by $Nothing$

Answer 5

Since any {n, n} for integer n is not a Pythagorean triple, I suggest

allPossiblePairs = Subsets[Range[10], {2}]

as probably the shortest way to generate them.

Answer 6

Just for something different Pick (and imho nice usecase for Order):

Pick[#, Order @@@ #, 1] & @ squareNumbers

PS. Order also would work in @Kuba's reference case.

Answer 7

Is

DeleteDuplicates[list,Sort@#==Sort@#2&]

what you are after?

Answer 8

You can also feed all the conditions to Solve from the start:

sol = Solve[
  n^2 + m^2 == h^2 && 0 < n < 10 && 0 < m < 10 && h > 0 && n <= m,
    {n,m, h}, Integers]

{{n -> 3, m -> 4, h -> 5}, {n -> 6, m -> 8, h -> 10}}

{n, m} /. sol

{{3, 4}, {6, 8}}

Answer 9

You could also do

{} ⋃ Sort /@ allPossiblePairs

Answer 10

Why so much work for something that's done with 1 line of code? You're deleting symmetric duplicates. Use LowerTriangularize (or UpperTriangularize) to delete everything above or below the diagonal, then select those indexes, where True indicates valid answer:

Position[LowerTriangularize@Parallelize@Array[IntegerQ@Sqrt[#1^2+#2^2]&,{1000,1000}],True]

1000x1000 search takes approx. 3.5 seconds on my machine.

UPDATE:

On the other hand... Forget LowerTriangularize... Just don't compute the lower half, and use optimization inspired by @UnchartedWorks:

Flatten[
  ParallelTable[If[IntegerQ@Abs@Complex[m,n],{n,m},Nothing],{m,1000},{n,m,1000}]
,1]

1.38 seconds for 1000x1000 search.

ListPlot[%,AspectRatio->1]

Answer 11

If you want to make it more efficient, you can do it like this.

allPossiblePairs // DeleteDuplicates // Map[Sort] // DeleteDuplicates

In:

xss = RandomInteger[1000, {10^7, 2}];
AbsoluteTiming[xss // Map[Sort] // DeleteDuplicates]
AbsoluteTiming[ 
 xss // DeleteDuplicates // Map[Sort] // DeleteDuplicates]

Out:

Actually you don't have to delete duplicates, because you can list all of unique pairs directly.

In:

squareNumberQ[{n_Integer, m_Integer}] := IntegerQ[Sqrt[n^2 + m^2]];
allPossiblePairs = Flatten[Table[{n, m}, {n, 1, 10}, {m, 1, n}], 1]
squareNumbers = Select[allPossiblePairs, squareNumberQ]

Out:

{{1, 1}, {2, 1}, {2, 2}, {3, 1}, {3, 2}, {3, 3}, {4, 1}, {4, 2}, {4, 
  3}, {4, 4}, {5, 1}, {5, 2}, {5, 3}, {5, 4}, {5, 5}, {6, 1}, {6, 
  2}, {6, 3}, {6, 4}, {6, 5}, {6, 6}, {7, 1}, {7, 2}, {7, 3}, {7, 
  4}, {7, 5}, {7, 6}, {7, 7}, {8, 1}, {8, 2}, {8, 3}, {8, 4}, {8, 
  5}, {8, 6}, {8, 7}, {8, 8}, {9, 1}, {9, 2}, {9, 3}, {9, 4}, {9, 
  5}, {9, 6}, {9, 7}, {9, 8}, {9, 9}, {10, 1}, {10, 2}, {10, 3}, {10, 
  4}, {10, 5}, {10, 6}, {10, 7}, {10, 8}, {10, 9}, {10, 10}}

{{4, 3}, {8, 6}}