Group Abstract Group Abstract

Message Boards Message Boards

Graphing a large set of Pythagorean triples

James Parks, SUNY POTSDAM
Posted 5 years ago

Sorry, I need to give more info on my problem.

I have a large set of primitive Pythagorean triples, generated by the code in the PrimitivePythagoreanTriple.nb:

prim=With[{max=100},\[IndentingNewLine]Map[Last,List@@(Reduce[x^2+y^2\[Equal]z^2 && 0< x < y <max&&0<z<max &&GCD[x,y,z]\[Equal]1,{x,y,z},Integers,Backsubstitution->True]/.And:>List),{2}]]

I wish to graph this discrete set in the xy-plane using ListPlot (after I add Table[ ... ] to the resulting set of pairs).

This requires changing the triples {x,y,z} to pairs {x,y}, same first and second coordinates.
I can do it on a single triple, obviously, but how do I write a code to make the new list of pairs from the list of triples?

Here's a sample of what the outcome should look like (see attached).

I've tried everything I can find and/or think of.
Any suggestions will be appreciated.

Thanks,
JP

Attachment

Attachments:
Screen Shot 2021...png
POSTED BY: James Parks
12 Replies
Sort By:
Rohit Namjoshi
Rohit Namjoshi
Posted 5 years ago

Missed that. Easy to modify

coprimePT = genPTunder[10000] // Map[Most] // Select[CoprimeQ @@ # &];
coprimePT // 
 ListPlot[{#, Map[Reverse, #]}, AspectRatio -> 1, ImageSize -> 600, 
   PlotStyle -> {Red, Black}] &

enter image description here
POSTED BY: Rohit Namjoshi
Rohit Namjoshi
Rohit Namjoshi
Posted 5 years ago

Hi James,

The code you provided formatted correctly.

prim = With[{max = 100}, 
  Map[Last, 
   List @@ (Reduce[
       x^2 + y^2 == z^2 && 0 < x < y < max && 0 < z < max && 
        GCD[x, y, z] == 1, {x, y, z}, Integers, 
       Backsubstitution -> True] /. And :> List), {2}]]

It is hundreds of times slower than genPTunder that I referred to in my previous reply.

It looks like the triples were filtered in some way to generate the image you provided. So this does not generate an identical image. It does match the image on Wikipedia.

genPTunder[6000] // Map[Most] // Join[#, Map[Reverse, #]] & //
  ListPlot[#, AspectRatio -> 1, ImageSize -> 600, PlotStyle -> Blue] &

enter image description here
POSTED BY: Rohit Namjoshi
Rohit Namjoshi
Rohit Namjoshi
Posted 5 years ago

Just guessing at what you are trying to do. Using genPTunder from this answer on MSE.

genPTunder[25] // Map[Most]
(* {{3, 4}, {5, 12}, {6, 8}, {7, 24}, {8, 15}, {9, 12}, {12, 16}, {15, 20}} *)

genPTunder[25] // GroupBy[Most -> Last]
(* <|{3, 4} -> {5}, {5, 12} -> {13}, {6, 8} -> {10}, {7, 24} -> {25}, 
     {8, 15} -> {17}, {9, 12} -> {15}, {12, 16} -> {20}, {15, 20} -> {25}|> *)

genPTunder[25] /. {a_, b_, c_} :> {a, b} -> c
(* {{3, 4} -> 5, {5, 12} -> 13, {6, 8} -> 10, {7, 24} -> 25, {8, 15} -> 17,
    {9, 12} -> 15, {12, 16} -> 20, {15, 20} -> 25} *)

genPTunder[25] // Map[Most /* Callout] // ListLinePlot[#, Mesh -> All] &

enter image description here

genPTunder[500] // Map[Most] // ListLinePlot

enter image description here
POSTED BY: Rohit Namjoshi

Thanks, JP
POSTED BY: James Parks
Paul Cleary
Paul Cleary
Posted 5 years ago

James, Thanks for the link, it does run now. Hope you don't mind but I have taken the liberty of amending my previous code slightly that when run, 'a few ms' does what I think is essentially what your program is doing.

pyths[x_Integer, max_Integer] := (t = Select[Divisors[x^2], # <= x &];
   m = Sort[
    Select[(x^2 - t^2)/(2 t), 
     IntegerQ[#] && # > x && # <= max && GCD[x, #] == 1 &]]; 
  Table[{x, m[[i]], Sqrt[x^2 + m[[i]]^2]}, {i, 1, Length[m]}]); t1 = 
 Flatten[Table[pyths[i, 1720], {i, 3, 1720}], 1]; 
t1 // Map[Most] // 
 ListPlot[{#, Map[Reverse, #]}, AspectRatio -> 1, ImageSize -> 600, 
   PlotStyle -> {Red, Black}] &

and to see the individual plots as in your notebook.

s1 = t1 // Map[Most] // 
  ListPlot[#, AspectRatio -> 1, ImageSize -> 600, PlotStyle -> Red] &

s2 = t1 // Map[Most] // 
  ListPlot[Map[Reverse, #], AspectRatio -> 1, ImageSize -> 600, 
    PlotStyle -> Black] &

Show[{s1, s2}, PlotRange -> All]

PC.
POSTED BY: Paul Cleary

Paul, I forgot to mention, I've already done the hard work on this notebook, just run this one, the long version, it only takes a few minutes at most: https://www.notebookarchive.org/ppt-graph-nb--2021-06-6y23baq/

JP
POSTED BY: James Parks

Paul, You have to insert the k value you wish to compute from the OEIS A096033 sequence. That's why I have all of those d- values listed in the s1 and s2 ListPlots. It's a very tedious technique, but I was trying to explain where all of the curves came from in the final graph, see my graph above. See also: On the Curved Patterns Seen in the Graph of PPTs, arXiv 2104.09449v5.
POSTED BY: James Parks
Paul Cleary
Paul Cleary
Posted 5 years ago

James, Thank you for the link, however I can't seem to get it to run, there seems to be some information missing so I can't see the end result. I did notice that you were using Reduce to get the triples which in my view is very slow, so I have taken the liberty of amending my method of producing PPTs to produce what I think was the desired output of your notebook.

pyths[x_Integer, max_Integer] := (t = Select[Divisors[x^2], # <= x &];
   m = Sort[
    Select[(x^2 - t^2)/(2 t), 
     IntegerQ[#] && # > x && Sqrt[x^2 + #^2] <= max && 
       GCD[x, #] == 1 &]]; 
  Table[{x, m[[i]], Sqrt[x^2 + m[[i]]^2]}, {i, 1, Length[m]}])

t1 = Flatten[Table[pyths[i, 1720], {i, 3, 1720}], 1];

t1 // Map[Most] // 
 ListPlot[{#, Map[Reverse, #]}, AspectRatio -> 1, ImageSize -> 600, 
   PlotStyle -> {Red, Black}] &

On my pc if they were all computed together runs in 270ms. Maybe this helps you.
POSTED BY: Paul Cleary

Paul, I think I used this a variation on this method to construct a previous notebook: https://www.notebookarchive.org/ppt-graphbrief-nb--2021-06-6y24ve8/
POSTED BY: James Parks
Paul Cleary
Paul Cleary
Posted 5 years ago
POSTED BY: Paul Cleary

Great! Very interesting! I was aware of this approach to generating PPTs, but I was not aware of the difference in time and memory it would determine. Thanks again, JP
POSTED BY: James Parks
Updating Name
Updating Name
Posted 5 years ago

Thanks, I'm not familiar with genPTunder. I'll look into it. Your graph looks like you have all Pythagorean triples, not just the primitive ones.
POSTED BY: Updating Name
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard