MODERATOR NOTE: In response to the Brad Klee comment here: https://community.wolfram.com/groups/-/m/t/2934118
“Do you have an opinion how much more development needs to be done before ChatGPT can rigorously compute all terms of A187781? “ — yes, I do.
Getting rigorously computed valued for the number of congruent polygon classes is not easy, but also not impossible.
One should not realistically expect ChatGPT to implement nontrivial symbolic or numeric algorithms (say Risch’s algorithm for integration of elementary functions in closed form or a fast multipole expansions for astro-dynamics applications), this is not what a LLM was designed to do.
For certain numeric and symbolic task a LLM has to call tools for specialized work, like calling the Wolfram plugin for computations and data.
For certain numeric and symbolic task a LLM has to call tools for specialized work, like calling the Wolfram plugin for computations and data.
Now I think there is actually just a single new Wolfram Language function needed to solve the problem you stated: A geometry function that takes a polygon and a line as argument and cuts the polygon into multiple polygon according to the line. (Some weeks ago I talked to one of the main Region[]-functionality developers and he indicated that such a cutting function is on the roadmap. It would be useful for pure geometry solid state physics applications (think Brillouin zones) and more.) And this function would have to (as any good Wolfram Language function) work for exact symbolic point coordinates, machine precision point coordinates, and arbitrary-precision point coordinates.
Such a polygon-cutting function would be a convenient generalization and addition to current functionalities provided by RegionIntersection[] with a HalfPlane[].
The arbitrary-precision point coordinates are important for the problem at hand. While one could compute all polygon vertices as exact algebraic expressions, these would be large and the computation would be slow. Machine-arithmetic will not be able to properly identify the highly degenerate diagonal crossing. But say with 100 digits we should be on safe ground getting all intersections properly identified.
If such a cutting function would be available, then with some minor coaching ChatGPT could solve the counting of congruent polygon classes along the line of such a chat: https://chat.openai.com/share/3b340fb9-959e-4a42-b865-f7bfdf7c0c46
For the problem at hand there are two substantial simplifications:
a) the lines are the polygon diagonals, meaning all are straight lines rather than zig-zag line
b) the polygons before and after cutting are always convex polygons
These two facts simplify the implementation of such a cutting function dramatically.
a) the lines are the polygon diagonals, meaning all are straight lines rather than zig-zag line
b) the polygons before and after cutting are always convex polygons
These two facts simplify the implementation of such a cutting function dramatically.
Here is a quick-and-dirty implementation for a function
cutConvexPolygon[Polygon[l_], lines:{_Line ..}, opts___]
that cuts a convex polygon by a straight line. As a proof-of-concept for the imagined ChatGPT workflow, we only implement an arbitrary-precision version, not also an exact arithmetic or machine-arithmetic version).
(As for the context of ChatGPT we assume cutConvexPolygon is a future built-in functions, we just use it without discussing the code and hide the code in this iconized input).
cutConvexPolygon[Polygon[l_], lines:{_Line ..}, opts___]
that cuts a convex polygon by a straight line. As a proof-of-concept for the imagined ChatGPT workflow, we only implement an arbitrary-precision version, not also an exact arithmetic or machine-arithmetic version).
(As for the context of ChatGPT we assume cutConvexPolygon is a future built-in functions, we just use it without discussing the code and hide the code in this iconized input).
In[]:=
Lets apply it to a pentagon:
In[]:=
pentagon=Polygon[CirclePoints[{1,Pi/2},5]]
Out[]=
Polygon
In[]:=
pentagonDiagonals=Line[pentagon[[1,#]]]&/@Select[Subsets[Range[5],{2}],Mod[Abs[Differences[#][[1]]],5-1]>1&];Length[pentagonDiagonals]
Out[]=
5
In[]:=
cutPentagonPolygons=cutConvexPolygon[pentagon,pentagonDiagonals,WorkingPrecision->100];Length[cutPentagonPolygons]
Out[]=
11
These are the 11 polygons:
In[]:=
Graphics[#,ImageSize->32]&/@cutPentagonPolygons
Out[]=
,
,
,
,
,
,
,
,
,
,
Now we have to group identical polygons. We could use RegionCongruent[], but let’s implement our own grouping based on edge length and angles (we could also use say multipole moments).
In[]:=
edgeLengthAngles[Polygon[l_]]:={Sort@N[EuclideanDistance@@@Partition[Append[l,l[[1]]],2,1]],Sort@N[PlanarAngle/@Partition[Prepend[Append[l,l[[1]]],l[[-1]]],3,1]]}
In[]:=
groupCongruentPolygons[polys_:{_Polygon..}]:=GroupBy[polys,edgeLengthAngles]
The 11 polygons form 3 groups, as visually expected.
In[]:=
congruentCutPentagonPolygonGroups=groupCongruentPolygons[cutPentagonPolygons];Length[congruentCutPentagonPolygonGroups]
Out[]=
3
Coloring the identical groups of polygons:
In[]:=
congruentPolygonGroupGraphics[congruentPolygonGroups_]:=Graphics[{EdgeForm[White],{RandomColor[],#}&/@Values[congruentPolygonGroups]}]
In[]:=
congruentPolygonGroupGraphics[congruentCutPentagonPolygonGroups]
Out[]=
Now lets do the same for the n=12 case:
In[]:=
diagonalsCutRegularNgonPolygonsGroups[n_]:=Module[{ngon,diagonals,cutNgonPolygons,congruentPolygonGroups},ngon=Polygon[CirclePoints[{1,Pi/2},n]];diagonals=Line[ngon[[1,#]]]&/@Select[Subsets[Range[n],{2}],Mod[Abs[Differences[#][[1]]],n-1]>1&];cutNgonPolygons=cutConvexPolygon[ngon,diagonals];congruentPolygonGroups=groupCongruentPolygons[cutNgonPolygons]]
In[]:=
(dodecagonPolygonGroups=diagonalsCutRegularNgonPolygonsGroups[12];)//Timing
Out[]=
{2.8581,Null}
In[]:=
congruentPolygonGroupGraphics[dodecagonPolygonGroups]
Out[]=
And here are counts of the congruent polygons groups up to that can be easily computed in a few minutes. Hopefully a result that can be obtained with ChatGPT and the Wolfram plugin in the not-too-distant future.
n=20
In[]:=
TextGrid[Prepend[Monitor[Table[{n,Length[diagonalsCutRegularNgonPolygonsGroups[n]]},{n,3,20}],n],Style[#,Gray,Italic]&/@{"n","polygon\ngroup\ncount"}],Dividers->All,Alignment->Right]
Out[]=
n | polygongroupcount |
3 | 1 |
4 | 1 |
5 | 3 |
6 | 3 |
7 | 7 |
8 | 7 |
9 | 14 |
10 | 14 |
11 | 25 |
12 | 21 |
13 | 41 |
14 | 40 |
15 | 63 |
16 | 60 |
17 | 92 |
18 | 72 |
19 | 129 |
20 | 121 |
Just for one, let’s animate the cutting process with a polygon area dependent color scheme (so that congruent polygons get the same color):
In[]:=
With[{n=16},ngon=Polygon[CirclePoints[{1,Pi/2},n]];diagonals=Line[ngon[[1,#]]]&/@Select[Subsets[Range[n],{2}],Mod[Abs[Differences[#][[1]]],n-1]>1&];cutStepList=cutConvexPolygonList[ngon,diagonals]/.x_Real:>N[x]];
In[]:=
Clear[polygonColor];polygonColor[p_Polygon]:=polygonColor[p]=With[{A=Area[p]},RGBColor@@FractionalPart[100{Sqrt[71],Sqrt[88],Sqrt[43]}A]]
ListAnimate[Graphics[{polygonColor[#],#}&/@#]&/@cutStepList,DefaultDuration->20,AnimationRepetitions->1]