16
$\begingroup$

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.

$\endgroup$
7
  • 1
    $\begingroup$ May be like this: Union[allPossiblePairs, SameTest -> (#1 == Reverse[#2] &)] $\endgroup$ Mar 20, 2017 at 23:39
  • $\begingroup$ before that, make the table {n,2,10},{m,1,n-1} $\endgroup$
    – george2079
    Mar 20, 2017 at 23:45
  • 2
    $\begingroup$ @AnjanKumar I think you need "or" #1==#2 . Or you could do Sort@#1 ==Sort@#2 $\endgroup$
    – george2079
    Mar 20, 2017 at 23:54
  • $\begingroup$ 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. $\endgroup$
    – Joe
    Mar 21, 2017 at 0:05
  • 1
    $\begingroup$ closely related: 1302 $\endgroup$
    – Kuba
    Mar 21, 2017 at 6:54

11 Answers 11

17
$\begingroup$
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}}

$\endgroup$
4
  • 4
    $\begingroup$ You forgot the new (in 11.1) DeleteDuplicatesBy[ReverseSort][squareNumbers] $\endgroup$
    – Sascha
    Mar 21, 2017 at 9:36
  • $\begingroup$ @Sascha, indeed:) $\endgroup$
    – kglr
    Mar 21, 2017 at 9:44
  • 2
    $\begingroup$ 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. $\endgroup$ Apr 29, 2017 at 19:38
  • $\begingroup$ Better yet... ParallelTable[ ... ,{m,100},{n,m,1000}] - Voila! No need to delete anything. $\endgroup$ Apr 29, 2017 at 21:56
9
$\begingroup$

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

$\endgroup$
8
$\begingroup$
DeleteDuplicates[Sort /@ allPossiblePairs]
$\endgroup$
1
  • $\begingroup$ I'm sure this is the most efficient, computationally speaking (also spares the typing fingers since it is short). $\endgroup$ Mar 21, 2017 at 15:47
5
$\begingroup$

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$

$\endgroup$
4
$\begingroup$

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.

$\endgroup$
4
$\begingroup$

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.

$\endgroup$
2
$\begingroup$

Is

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

what you are after?

$\endgroup$
2
$\begingroup$

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

$\endgroup$
1
$\begingroup$

You could also do

{} ⋃ Sort /@ allPossiblePairs
$\endgroup$
1
$\begingroup$

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]

ListPlot pythagorean thriples

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

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: enter image description here

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}}
$\endgroup$

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.