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.

May be like this: Union[allPossiblePairs, SameTest -> (#1 == Reverse[#2] &)] — Anjan Kumar, Mar 20 '17 at 23:39
@AnjanKumar I think you need "or" #1==#2 . Or you could do Sort@#1 ==Sort@#2 — george2079, Mar 20 '17 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 '17 at 00:05
Better yet... ParallelTable[ ... ,{m,100},{n,m,1000}] - Voila! No need to delete anything. — Gregory Klopper, Apr 29 '17 at 21:57

kglr · Accepted Answer · 2017-03-21T09:44:53.600

17

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

edited Mar 21 '17 at 09:44

answered Mar 20 '17 at 23:56

kglr

394,356
18
477
896

4

You forgot the new (in 11.1) DeleteDuplicatesBy[ReverseSort][squareNumbers] – Sascha Mar 21 '17 at 09:36
@Sascha, indeed:) – kglr Mar 21 '17 at 09:44
2

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. – Gregory Klopper Apr 29 '17 at 19:38
Better yet... ParallelTable[ ... ,{m,100},{n,m,1000}] - Voila! No need to delete anything. – Gregory Klopper Apr 29 '17 at 21:56

score 9 · Answer 2 · answered Mar 21 '17 at 06:01

9

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

answered Mar 21 '17 at 06:01

m_goldberg

107,779
16
103
257

score 8 · Answer 3 · answered Mar 20 '17 at 23:37

8

DeleteDuplicates[Sort /@ allPossiblePairs]

answered Mar 20 '17 at 23:37

David G. Stork

41,180
3
34
96

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

Sascha · Answer 4 · 2017-03-21T08:51:51.077

5

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$

edited Mar 21 '17 at 08:51

answered Mar 21 '17 at 07:33

Sascha

8,459
2
32
66

score 4 · Answer 5 · answered Mar 21 '17 at 11:42

4

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.

answered Mar 21 '17 at 11:42

LLlAMnYP

11,486
26
65

score 4 · Answer 6 · edited Apr 13 '17 at 12:55

4

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.

edited Apr 13 '17 at 12:55

Community

1

answered Mar 21 '17 at 13:20

garej

4,865
2
19
42

score 2 · Answer 7 · answered Mar 21 '17 at 06:40

2

Is

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

what you are after?

answered Mar 21 '17 at 06:40

martin

8,678
4
23
70

score 2 · Answer 8 · answered Mar 21 '17 at 10:20

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

score 1 · Answer 9 · edited Mar 21 '17 at 13:06

1

You could also do

{} ⋃ Sort /@ allPossiblePairs

edited Mar 21 '17 at 13:06

m_goldberg

107,779
16
103
257

answered Mar 21 '17 at 12:09

A Simmons

412
4
9

Gregory Klopper · Answer 10 · 2017-04-29T21:39:33.067

1

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]

edited Apr 29 '17 at 21:39

answered Apr 29 '17 at 19:32

Gregory Klopper

1,370
9
21

1

Position[LowerTriangularize@ Parallelize@Array[IntegerQ@Norm@Complex, {10, 10}], True] – webcpu Apr 29 '17 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 )) – Gregory Klopper Apr 29 '17 at 21:15
@UnchartedWorks ParallelTable to search half the table + your trick of Abs@Complex - less than half the execution time – Gregory Klopper Apr 29 '17 at 21:30
1

Brilliant! It is good to hear it is so fast! – webcpu Apr 29 '17 at 21:39

score 0 · Answer 11 · answered Apr 29 '17 at 19:04

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

Delete redundant {x,y} pairs

11 Answers11

Linked