# Delete redundant {x,y} pairs

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.

• May be like this: Union[allPossiblePairs, SameTest -> (#1 == Reverse[#2] &)] Mar 20, 2017 at 23:39
• before that, make the table {n,2,10},{m,1,n-1} Mar 20, 2017 at 23:45
• @AnjanKumar I think you need "or" #1==#2 . Or you could do Sort@#1 ==Sort@#2  Mar 20, 2017 at 23:54
• Oops - sorry I was unclear in my question although I've learned a bit already. I was wondering how to delete duplicate pairs after I've already generated them. It just seems like it should be straightforward. I will amend original question.
– Joe
Mar 21, 2017 at 0:05
• closely related: 1302
– Kuba
Mar 21, 2017 at 6:54

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

• You forgot the new (in 11.1) DeleteDuplicatesBy[ReverseSort][squareNumbers] Mar 21, 2017 at 9:36
• @Sascha, indeed:)
– kglr
Mar 21, 2017 at 9:44
• Or use LowerTriangularize or UpperTriangularize to delete half the matrix and then pick everything that's True in the table. I added an answer below with exact code. Apr 29, 2017 at 19:38
• Better yet... ParallelTable[ ... ,{m,100},{n,m,1000}] - Voila! No need to delete anything. Apr 29, 2017 at 21:56

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

DeleteDuplicates[Sort /@ allPossiblePairs]

• I'm sure this is the most efficient, computationally speaking (also spares the typing fingers since it is short). Mar 21, 2017 at 15:47

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$

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

allPossiblePairs = Subsets[Range, {2}]


as probably the shortest way to generate them.

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.

Is

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


what you are after?

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

You could also do

{} ⋃ Sort /@ allPossiblePairs


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] • Position[LowerTriangularize@ Parallelize@Array[IntegerQ@*Norm@*Complex, {10, 10}], True] Apr 29, 2017 at 20:29
• Complex[] head is BRILLIANT! )))) Works 10% faster than a List head, while giving the same result. I want to give your comment +100 )) Apr 29, 2017 at 21:15
• @UnchartedWorks ParallelTable to search half the table + your trick of Abs@Complex - less than half the execution time Apr 29, 2017 at 21:30
• Brilliant! It is good to hear it is so fast! Apr 29, 2017 at 21:39

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]


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