15
$\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$
  • 1
    $\begingroup$ May be like this: Union[allPossiblePairs, SameTest -> (#1 == Reverse[#2] &)] $\endgroup$ – Anjan Kumar Mar 20 '17 at 23:39
  • $\begingroup$ before that, make the table {n,2,10},{m,1,n-1} $\endgroup$ – george2079 Mar 20 '17 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 '17 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 '17 at 0:05
  • 1
    $\begingroup$ closely related: 1302 $\endgroup$ – Kuba Mar 21 '17 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$
  • 3
    $\begingroup$ You forgot the new (in 11.1) DeleteDuplicatesBy[ReverseSort][squareNumbers] $\endgroup$ – Sascha Mar 21 '17 at 9:36
  • $\begingroup$ @Sascha, indeed:) $\endgroup$ – kglr Mar 21 '17 at 9:44
  • 1
    $\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$ – Gregory Klopper Apr 29 '17 at 19:38
  • $\begingroup$ Better yet... ParallelTable[ ... ,{m,100},{n,m,1000}] - Voila! No need to delete anything. $\endgroup$ – Gregory Klopper Apr 29 '17 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$
  • $\begingroup$ I'm sure this is the most efficient, computationally speaking (also spares the typing fingers since it is short). $\endgroup$ – Daniel Lichtblau Mar 21 '17 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$
  • 1
    $\begingroup$ Position[LowerTriangularize@ Parallelize@Array[IntegerQ@*Norm@*Complex, {10, 10}], True] $\endgroup$ – UnchartedWorks Apr 29 '17 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$ – Gregory Klopper Apr 29 '17 at 21:15
  • $\begingroup$ @UnchartedWorks ParallelTable to search half the table + your trick of Abs@Complex - less than half the execution time $\endgroup$ – Gregory Klopper Apr 29 '17 at 21:30
  • 1
    $\begingroup$ Brilliant! It is good to hear it is so fast! $\endgroup$ – UnchartedWorks Apr 29 '17 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 acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

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