PPT Graph.nb
Author
James M Parks
Title
PPT Graph.nb
Description
Supplemental notebook to "On the Curved Patterns Seen in the Graph of PPTs"
Category
Academic Articles & Supplements
Keywords
Primitive Pythagorean Triples, PPTs, parabolic curve, curved pattern
URL
http://www.notebookarchive.org/2021-06-6y23baq/
DOI
https://notebookarchive.org/2021-06-6y23baq
Date Added
2021-06-15
Date Last Modified
2021-06-15
File Size
54.99 kilobytes
Supplements
Rights
Redistribution rights reserved
Download
Open in Wolfram Cloud
This file contains supplementary data for “On the Curved Patterns Seen in the Graph of PPTs” by James M Parks.
Graph the Primitive Pythagorean Triples (PPTs), for 0<a<b<1720, using the Pythagorean/Plato method.
Author James M Parks June 14, 2021
Author James M Parks June 14, 2021
The graph of a Pythagorean triple (a,b,c) is the graph of the pair (a,b) in the xy-plane. We are interested in the graph of primitive Pythagorean triples (PPTs), GDC(a,b,c)=1. Calculations use a generalization of the Pythagorean/Plato method, and the difference triple form (a,b,b+d), where the difference d belongs to the sequence OEIS:A096033, thus b(a) = (a^2-d^2)/2d, and this determines a parabola in the graph of the PPTs.
The Data Tables of PPTs for each d value k in OEIS:A096033 use the code:
dk = Table[With[{max = 1720}, Map[Last,List @@ (Reduce[ x^2 == 2ky+k^2 &&
0 < x < y < max &&GCD[x, y] == 1, {x, y}, Integers, Backsubstitution True] /. And
List), {2}]]] .
The graph of {dk, k=1, 2,...} is ListPlot s1. The reflected data sets, rt[dk], are dk reflected about the line y = x, and satisfy a > b, see ListPlot s2. The graph of the combined Plots is Show[{s1,s2}], and the parabolas are visible in this graph.
Compare this result with the graph by R. Knott, Pythagorean Right Triangles, http://www.maths.surrey.ac.uk/hosted-sites/R.Knott/Pythag/pythag.html#section3.4 , which uses a different Mathematica program.
dk = Table[With[{max = 1720}, Map[Last,List @@ (Reduce[ x^2 == 2ky+k^2 &&
0 < x < y < max &&GCD[x, y] == 1, {x, y}, Integers, Backsubstitution True] /. And
List), {2}]]] .
The graph of {dk, k=1, 2,...} is ListPlot s1. The reflected data sets, rt[dk], are dk reflected about the line y = x, and satisfy a > b, see ListPlot s2. The graph of the combined Plots is Show[{s1,s2}], and the parabolas are visible in this graph.
Compare this result with the graph by R. Knott, Pythagorean Right Triangles, http://www.maths.surrey.ac.uk/hosted-sites/R.Knott/Pythag/pythag.html#section3.4 , which uses a different Mathematica program.
In[]:=
ColorOutputRGBColor
In[]:=
rt=ReflectionTransform[{1,-1}]
In[]:=
d1=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==2y+1&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d1]
In[]:=
d2=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==4y+4&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d2]
In[]:=
d8=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==16y+64&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d8]
In[]:=
d9=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==18y+81&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d9]
In[]:=
d18=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==36y+324&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d18]
In[]:=
d25=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==50y+625&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d25]
In[]:=
d32=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==64y+1024&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d32]
In[]:=
d49=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==98y+2401&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d49]
In[]:=
d50=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==100y+2500&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d50]
In[]:=
d72=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==144y+5184&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d72]
In[]:=
d81=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==162y+6561&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d81]
In[]:=
d98=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==196y+9604&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d98]
In[]:=
d121=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==242y+14641&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d121]
In[]:=
d128=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==256y+16384&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d128]
In[]:=
d162=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==324y+26244&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d162]
In[]:=
d169=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==338y+28561&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d169]
In[]:=
d200=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==400y+40000&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d200]
In[]:=
d225=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==450y+50625&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d225]
In[]:=
d242=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==484y+58564&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d242]
In[]:=
d288=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==576y+82944&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d288]
In[]:=
d289=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==578y+83521&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d289]
In[]:=
d338=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==676y+114244&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d338]
In[]:=
d361=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==722y+130321&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d361]
In[]:=
d392=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==784y+153664&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d392]
In[]:=
d441=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==882y+194481&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d441]
In[]:=
d450=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==900y+202500&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d450]
In[]:=
d512=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==1024y+262144&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d512]
In[]:=
d529=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==1058y+279841&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d529]
In[]:=
d578=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==1156y+334084&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d578]
In[]:=
d625=Table[With[{max=1720},Map[Last,List@@(Reduce[x^2==1250y+390625&&0<x<y<max&&GCD[x,y]==1,{x,y},Integers,BacksubstitutionTrue]/.AndList),{2}]]]rt[d625]
In[]:=
s1=ListPlot[{d1,d2,d8,d9,d18,d25,d32,d49,d50,d72,d81,d98,d121,d128,d162,d169,d200,d225,d242,d288,d289,d338,d361,d392,d441,d450,d512,d529,d578,d625},PlotStyle{RGBColor[1,0,0]},AspectRatioAutomatic]
In[]:=
s2=ListPlot[{rt[d1],rt[d2],rt[d8],rt[d9],rt[d18],rt[d25],rt[d32],rt[d49],rt[d50],rt[d72],rt[d81],rt[d98],rt[d121],rt[d128],rt[d162],rt[d169],rt[d200],rt[d225],rt[d242],rt[d288],rt[d289],rt[d338],rt[d361],rt[d392],rt[d441],rt[d450],rt[d512],rt[d529],rt[d578],rt[d625]},PlotStyle{RGBColor[0,0.1,0.1]},AspectRatioAutomatic]
In[]:=
Show[{s1,s2},PlotRangeAll]
Cite this as: James M Parks, "PPT Graph.nb" from the Notebook Archive (2021), https://notebookarchive.org/2021-06-6y23baq
Download
