Recently on [seqfan] Chris Scussel said that the terms of A187781 don’t exactly match the definition, with the first mistake occurring at n=12. The terms of this sequence count “Number of noncongruent polygonal regions in a regular n-gon with all diagonals drawn”, so let’s start by drawing a dodecagon:
In[]:=
Graphics[{Opacity[0],EdgeForm[Black],Polygon/@Subsets[CirclePoints[12],{3}]}]
Out[]=
The claim is that, in a diagram such as this, it’s possible to have congruent triangles unrelated by dihedral automorphisms, and accounting for these congruences leads to decreased counts. The purpose of this memo is to check the assertion for the n=12 case.
First we list all possible line segments, and identify pairs of line segments not falling parallel:
In[]:=
endPoints=Union[Catenate[Partition[#,2,1,1]&/@Subsets[CirclePoints[12],{3}]]];vectors=MapApply[#2-#1&,endPoints];keys=Subsets[Range[Length@endPoints],{2}];nonParallel=keys[[Catenate[Position[MapApply[Expand[Dot[#1,{{0,-1},{1,0}},#2]^2]>0&,vectors[[#]]&/@keys],True]]]];
For edge segments that could possibly intersect, we compute intersection parameters with expected values between [0,1]:
In[]:=
AbsoluteTiming[stPairs=Map[Function[keypair,Together[Dot[Inverse[Transpose[Times[vectors[[keypair]],{-1,1}]]],Apply[Subtract,endPoints[[keypair,1]]]]]],nonParallel];]
Out[]=
{8.51465,Null}
Then we check the deciding criteria and calculate points of intersection for all True positives:
In[]:=
intersecting=Catenate[Position[MapApply[Function[And[1>#1>0,1>#2>0]],stPairs],True]];
In[]:=
cross=Map[Function[int,Together[Plus[Times[stPairs[[int]],vectors[[nonParallel[[int]]]]],endPoints[[nonParallel[[int]],1]]]]],intersecting];
In[]:=
Union[MapApply[Equal,cross]]
Out[]=
{True}
The algebra system has some trouble obtaining canonical vertices, so we introduce a tiny radius for determining zeros, and accept weak canonicalization through DeleteDuplicates:
In[]:=
uniqueCross=DeleteDuplicates[cross[[All,1]],Chop[Norm[N[#1-#2]],2^6$MachineEpsilon]==0&];
In[]:=
Length@uniqueCross
Out[]=
301
In[]:=
Graphics[{Opacity[0],EdgeForm[Black],Polygon/@Subsets[CirclePoints[12],{3}],Red,Opacity[1],Disk[#,0.01]&/@uniqueCross}]
Out[]=
Next we need to sort each point on each line and add end points to each line:
In[]:=
edgeOrderings=KeySort[Association[DeleteDuplicates[#,Equal[First[#1],First[#2]]&]],NumericalOrder]&/@GroupBy[Catenate[Function[ind,MapThread[#1->#2->First[cross[[ind]]]&,{nonParallel[[intersecting[[ind]]]],stPairs[[intersecting[[ind]]]]}]]/@Range[Length[cross]]],First->Last];edgeOrderings=KeyValueMap[{endPoints[[#1,1]],Splice[Values[#2]],endPoints[[#1,2]]}&,edgeOrderings];
Finally we can construct a graph-representation of the intersection diagram:
In[]:=
Module[{graph,rep},graph=Graph[Union[Sort/@MapApply[UndirectedEdge,Catenate[Map[Partition[#,2,1]&,edgeOrderings]]],MapApply[UndirectedEdge,Partition[Simplify/@CirclePoints[12],2,1,1]]]];rep=Map[Function[vertex,vertex->SelectFirst[uniqueCross,Chop[Norm[N[#1-vertex]],2^6$MachineEpsilon]==0&,vertex]],VertexList[graph]];graph=VertexReplace[graph,rep];graph=Graph[Union[Sort/@EdgeList[graph]]];g1=Graph[graph,VertexCoordinates->Map[#->#&,VertexList[graph]]]]
Out[]=
In[]:=
Length@VertexList[g1]
Out[]=
313
The vertices are all intersection points, and the edges indicate nearest neighbors along the dodecagon’s chords. To read out individual polygons, we transform the graph into a doubly-linked list that gives all polygon vertex lists one particular circularity according to ArcTan:
In[]:=
getKey=Association[MapIndexed[#1->#2[[1]]&,VertexList[g1]]];getVertex=Association[MapIndexed[#2[[1]]->#1&,VertexList[g1]]];
In[]:=
AddLinks[edges_][vertex_]:=Module[{nextEdges=edges,sorted},sorted=SortBy[VertexOutComponent[g1,vertex,{1}],Apply[ArcTan,#-vertex]&,NumericalOrder];sorted=getKey/@sorted;MapApply[Set[nextEdges[#1,getKey[vertex]],#2]&,Partition[sorted,2,1,1]];nextEdges]
We can extract polygons from the data structure in a fairly generic way, using a function borrowed from another related notebook:
There is one dodecahedral polygon extracted:
The vertices of this polygon are the input dodecahedral vertices, but due to circularity conventions, the polygon should be thought of as representing exterior area. It can be ignored. Then we are left with triangles and quadrilaterals:
A quick and risky hack puts the results into equivalence classes we can check by eye:
Here we have recovered the claimed value 21, which indicates that Chris Scussel is probably telling the truth better than the OEIS (for now). For inspection, here are the results:
Indeed in the third item of the triangular table only, we can see pairs of triangles related by translation, but not by roto-reflection, for example these two:
Going a step further, we can actually compute the translation vector:
Again a canonical form is not achieved, but they are all the same:
CITE THIS NOTEBOOK
CITE THIS NOTEBOOK
Checking a dodecagon mistake at OEIS
by Brad Klee
Wolfram Community, STAFF PICKS, June 8, 2023
https://community.wolfram.com/groups/-/m/t/2932082
by Brad Klee
Wolfram Community, STAFF PICKS, June 8, 2023
https://community.wolfram.com/groups/-/m/t/2932082