Coxeter Graph

Author

Eric W. Weisstein
November 1, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/CoxeterGraph.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/CoxeterGraph.html.

©2023 Wolfram Research, Inc. except for portions noted otherwise

Derived Graphs

Figure

GraphicsRow[Show[StyleGraphs@GraphData[#],PlotLabel->Style[GraphData[#,"Name"],Directive[Italic,14,FontFamily->"Times",Black]]]&/@{"CoxeterLineGraph","EdgeExcisedCoxeterGraph","TetrahedronReplacedCoxeterLineGraph","TriangleReplacedCoxeterGraph"},ImageSize->1000,Dividers->All]

Embeddings

<<MathWorld`Graphs`

Names

GraphData["CoxeterGraph","StandardName"]

GraphData["CoxeterGraph","StandardNames"]

Primary

GraphData["CoxeterGraph"]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

edges=Sort[Sort/@Join[
Partition[Range[22,28],2,1,1],
{14+#,21+#}&/@Range[7],
Flatten[Partition[#,2,1]&/@{{13,21,14},{1,15,2},{3,16,4},{5,17,6},{7,18,8},{9,19,10},{11,20,12}},1],
{{12,2},{2,6},{11,5},{11,3},{4,8},{4,14},{1,7},{1,9},{13,7},{13,5},{8,12},{10,6},{10,14},{9,3}}
]]

v=Join[
Through[{Cos,Sin}[2π#/14]]&/@Range[0,13],
12/10Through[{Cos,Sin}[2π(#+1/4)/7]]&/@Range[0,6],
3/2Through[{Cos,Sin}[2π(#+1/4)/7]]&/@Range[0,6]
];

g=Graph[Range[28],UndirectedEdge@@@edges,VertexCoordinates->v]

RecognizeGraph@g

(24, 3, 1)-ring construction

ee={{1,2},{1,14},{1,24},{2,3},{2,8},{3,4},{3,28},{4,5},{4,27},{5,6},{5,26},{6,7},{6,17},{7,8},{7,25},{8,9},{9,10},{9,22},{10,11},{10,16},{11,12},{11,28},{12,13},{12,26},{13,14},{13,25},{14,15},{15,16},{15,27},{16,17},{17,18},{18,19},{18,24},{19,20},{19,28},{20,21},{20,25},{21,22},{21,27},{22,23},{23,24},{23,26}};

v=Join[Table[{Cos[n 2 Pi/24],Sin[n 2 Pi/24]},{n,0,23}],Table[{-Cos[n 2 Pi/3],Sin[n 2 Pi/3]},{n,0,2}]/2,{{0,0}}]

g=Graph[Range[28],UndirectedEdge@@@ee,VertexCoordinates->(RotationMatrix[4Pi/24].#&/@v)]

v=Join[CirclePoints[{1,0},24],CirclePoints[{-1/2,0},3],{{0,0}}];
g=Graph[Range[28],UndirectedEdge@@@ee,VertexCoordinates->v]

All

GraphData["CoxeterGraph","Graph","All"]//StyleGraphs

Inexact

Select[GraphData["CoxeterGraph","Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData["CoxeterGraph","EdgeList"]]

Default embedding

GraphPlot@GraphData["CoxeterGraph","Edges"]

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Degenerate

GraphData["CoxeterGraph","Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData["CoxeterGraph","Graph","Degenerate"]

7-fold rotationally symmetric construction #1

Boben et al.

7-fold rotationally symmetric construction #2

Import["https://upload.wikimedia.org/wikipedia/commons/f/f0/Coxeter_graph_RGBW_7_central.svg"]

Pi/14.

v=Join[CirclePoints[1/4,7],CirclePoints[1/2,7],CirclePoints[{3/4,Pi/2-Pi/28},7],CirclePoints[{1,Pi/2+Pi/28},7]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,4,7,3,6,2,5,1],e[{22,28},22,11,4],e[3,10,28],e[2,9,27],e[1,8,26],e[7,14,25],e[6,13,24],e[5,12,23],e[17,19,21,16,18,20,15,17],{8,19},{9,20},{10,21},{11,15},{12,16},{13,17},{14,18}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

g0=LabelGraph@

v0=GraphEmbedding[g0];

v=MapIndexed[If[MemberQ[{5,8,13,21,28,24,16},#2[[1]]],.53#,#]&,v0]

Annotate[g0,VertexCoordinates->v]

Octagon "mirror symmetry" (modulo two inner points)

Import["https://upload.wikimedia.org/wikipedia/commons/8/82/Coxeter_graph_RGBW_8.svg"]

a=(1/(4 (Sqrt[2])));

v=Join[CirclePoints[1,8],CirclePoints[3/4,8],CirclePoints[{1/2,0},8],a{{-1,-1},{-1,1},{0,1},{1,0}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,4,5,6,7,8,1,9,17,12,20,15,23,10,18,13,21,16,24,11,19,14,22,9],Sequence@@Table[{i,i+8},{i,2,8}],e[21,28,17],e[22,25,18],e[20,26,24],e[23,27,19],{27,28},{26,25}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

Bilateral

GraphData["CoxeterGraph","Graph","Bilateral"]//StyleGraphs

Circular

GraphData["CoxeterGraph","Graph","Circular"]//StyleGraphs

Halin

GraphData["CoxeterGraph","Graph","Halin"]//StyleGraphs

LCF

GraphData["CoxeterGraph","LCFSignature"]

GraphData["CoxeterGraph","Graph","LCF"]//StyleGraphs

MinimalCrossing

GraphData["CoxeterGraph",{"RCN","CN"}]

GraphData["CoxeterGraph","Graph","MinimalCrossing"]//StyleGraphs

MinimalRectilinearCrossing from Exoo

Show[img=ImageCrop[Import["http://isu.indstate.edu/ge/COMBIN/RECTILINEAR/coxeter.png"]],ImageSize->Small]

GraphData["CoxeterGraph","Graph","MinimalRectilinearCrossing"][[1]]

MinimalCrossing construction

(cn=CrossingNumber[GraphData["CoxeterGraph"],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData["CoxeterGraph"],TimeConstraint->10])//AbsoluteTiming

GraphData["CoxeterGraph","CrossingNumber"]

[Computation timed out!]

Dear Eric Weisstein,

we are sorry to report that the requested computation (Coxeter graph) failed.
Please contact Markus Chimani (http://www-lehre.informatik.uni-osnabrueck.de/theoinf/index/staff/chimani)
if you really need to compute the crossing number of this graph.

Please visit this link for detailed results: http://crossings.uos.de/job/pdcB6t4DW4esI05wIZG4BA

(g=MinimalCrossingGraph[GraphData["CoxeterGraph"],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[g,"OuterFace"->#]&/@faces

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["CoxeterGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,500}],Max[OuterFace[#]]<=GraphData["CoxeterGraph","V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData["CoxeterGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,500}]//Union

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

UnitDistance

GraphData["CoxeterGraph","UnitDistance"]

UnitDistanceGraphQ[GraphData["CoxeterGraph"],Debug->True]//Timing

GraphData["CoxeterGraph","Graph","UnitDistance"]//StyleGraphs

Select[%,!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&]

Select[UnitDistanceEmbeddingRefine/@Complement@@(GraphData["CoxeterGraph","Graph",#]&/@{"All","UnitDistance"}),UnitDistanceGraphEmbeddingQ]

FindUnitDistanceEmbedding[GraphData["CoxeterGraph"],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

UnitDistance construction

Boben et al.

UnitDistance construction Weisstein

Aug 22, 2021

GraphData["CoxeterGraph","Graph","All"]

UnitDistanceEmbeddingRefine/@%

Select[%,UnitDistanceGraphEmbeddingQ]

Show[g0=GraphData["CoxeterGraph","Graph",{"Labeled","UnitDistance"}][[1]],Axes->True,Ticks->None,TickLabels->None]

v0=GraphEmbedding[g0];

Mean[v0]

ArcTan@@v0[[9]]//RootReduce

Pi/2-N[%]

{a,b,c,d}=Norm/@v[[{20,2,11,16}]]//RootReduce

a=FullSimplify[((Csc[Pi/7]/2)/(Csc[Pi/14]/2))]

N[a]

{c,Csc[Pi/7]/2}//N

SquaredEuclideanDistance@@CirclePoints[Csc[Pi/7]/2,7][[{1,4}]]//FullSimplify

SquaredEuclideanDistance@@CirclePoints[((Csc[Pi/7]/2)/(Csc[Pi/14]/2)),7][[{1,4}]]//FullSimplify

{0.5128584316362763`,(Sqrt[((NumericalApproximation[Root, (RowDefault["0.623", FEExpressionsNumericalApproximationElider]), Root[-1-4 #1+4 ((#1)^2)+8 ((#1)^3)&,3], ])^2)+((NumericalApproximation[Root, (RowDefault["0.142", FEExpressionsNumericalApproximationElider]), Root[-1+56 ((#1)^2)-336 ((#1)^4)+448 ((#1)^6)&,4], ])^2)]),(Sqrt[((NumericalApproximation[Root, (RowDefault["0.277", FEExpressionsNumericalApproximationElider]), Root[1-2 #1-8 ((#1)^2)+8 ((#1)^3)&,2], ])^2)+((NumericalApproximation[Root, (RowDefault["0.576", FEExpressionsNumericalApproximationElider]), Root[-1+28 ((#1)^2)-224 ((#1)^4)+448 ((#1)^6)&,6], ])^2)]),(Sqrt[((NumericalApproximation[Root, (RowDefault["-0.263", FEExpressionsNumericalApproximationElider]), Root[-27-36 #1+528 ((#1)^2)+448 ((#1)^3)-2816 ((#1)^4)-1024 ((#1)^5)+4096 ((#1)^6)&,3], ])^2)+((NumericalApproximation[Root, (RowDefault["1.12", FEExpressionsNumericalApproximationElider]), Root[19321-1851024 ((#1)^2)+54288640 ((#1)^4)-514461696 ((#1)^6)+1724448768 ((#1)^8)-2106589184 ((#1)^10)+822083584 ((#1)^12)&,12], ])^2)]),(Sqrt[((NumericalApproximation[Root, (RowDefault["-0.0840", FEExpressionsNumericalApproximationElider]), Root[72227-1369130 #1-7183624 ((#1)^2)+180055288 ((#1)^3)-669000416 ((#1)^4)-366311680 ((#1)^5)+5550416704 ((#1)^6)-6166065920 ((#1)^7)-8974328832 ((#1)^8)+18100891648 ((#1)^9)-1530970112 ((#1)^10)-10953621504 ((#1)^11)+4868276224 ((#1)^12)&,4], ])^2)+((NumericalApproximation[Root, (RowDefault["1.51", FEExpressionsNumericalApproximationElider]), Root[93001211521-132557479184620 ((#1)^2)+10669377915082208 ((#1)^4)-248916022829395264 ((#1)^6)+2873284730477278208 ((#1)^8)-19508479032321155072 ((#1)^10)+84007853119263281152 ((#1)^12)-236847257341596073984 ((#1)^14)+438914746763774525440 ((#1)^16)-523277675730240012288 ((#1)^18)+379961833023701254144 ((#1)^20)-149513165873264721920 ((#1)^22)+23700113393163698176 ((#1)^24)&,24], ])^2)])}//RootReduce

q=ArcTan@@v[[15]]//RootReduce

N[q]

r=ArcTan@@v[[16]]//RootReduce

N[r]

s=ArcTan@@v[[17]]

t=ArcTan@@v[[9]]//RootReduce

N[%]

v1=Join[CirclePoints[{a,s},7],CirclePoints[{b,q},7],CirclePoints[{c,t},7],CirclePoints[{d,r},7]];
ee=UnitEdges[v1,Tolerance->.007]

noee=Sort[{{1,12},{3,14},{5,9},{6,10},{7,11},{2,13},{4,8}}]

g=Graph[Range[Length[v]],Complement[ee,UndirectedEdge@@@noee],VertexCoordinates->v1,VertexLabels->"Name"]

RecognizeGraph[g]

Clear[s]

v1=Join[CirclePoints[{a,s},7],CirclePoints[{b,q},7],CirclePoints[{c,t},7],CirclePoints[{d,r},7]];

FullSimplify[SquaredEuclideanDistance@@v1[[{2,23}]]/.Abs->Identity]

TrigExpand[%]

RootReduce[%141]

Solve[(NumericalApproximation[Root, (RowDefault["2.55", FEExpressionsNumericalApproximationElider]), Root[507966607-5238296042 #1+23804136251 ((#1)^2)-63111236006 ((#1)^3)+108884438110 ((#1)^4)-128982743932 ((#1)^5)+107734378031 ((#1)^6)-64022560336 ((#1)^7)+26899742660 ((#1)^8)-7801933664 ((#1)^9)+1484163744 ((#1)^10)-166396160 ((#1)^11)+8319808 ((#1)^12)&,10], ])+Cos[s] (NumericalApproximation[Root, (RowDefault["-1.55", FEExpressionsNumericalApproximationElider]), Root[-304961+13619179 #1-99555771 ((#1)^2)+58585163 ((#1)^3)+550688313 ((#1)^4)-414966251 ((#1)^5)-1135380813 ((#1)^6)+670843516 ((#1)^7)+1033140696 ((#1)^8)-419741448 ((#1)^9)-408746240 ((#1)^10)+87357984 ((#1)^11)+58238656 ((#1)^12)&,2], ])+(NumericalApproximation[Root, (RowDefault["0.0862", FEExpressionsNumericalApproximationElider]), Root[5216739529-1280891382141 ((#1)^2)+97112806680757 ((#1)^4)-2845133013808141 ((#1)^6)+36483633158261905 ((#1)^8)-237004400661991501 ((#1)^10)+828289216222231113 ((#1)^12)-1578746037974811664 ((#1)^14)+1666101519179595456 ((#1)^16)-986780984555951424 ((#1)^18)+322286712240657920 ((#1)^20)-53294632992111616 ((#1)^22)+3391741052686336 ((#1)^24)&,13], ]) Sin[s]==1&&-15/100<s<-12/100,s]

-2 ArcTan[((NumericalApproximation[Root, (RowDefault["0.0862", FEExpressionsNumericalApproximationElider]), Root[5216739529-1280891382141 ((#1)^2)+97112806680757 ((#1)^4)-2845133013808141 ((#1)^6)+36483633158261905 ((#1)^8)-237004400661991501 ((#1)^10)+828289216222231113 ((#1)^12)-1578746037974811664 ((#1)^14)+1666101519179595456 ((#1)^16)-986780984555951424 ((#1)^18)+322286712240657920 ((#1)^20)-53294632992111616 ((#1)^22)+3391741052686336 ((#1)^24)&,13], ])/(-1+(NumericalApproximation[Root, (RowDefault["2.55", FEExpressionsNumericalApproximationElider]), Root[507966607-5238296042 #1+23804136251 ((#1)^2)-63111236006 ((#1)^3)+108884438110 ((#1)^4)-128982743932 ((#1)^5)+107734378031 ((#1)^6)-64022560336 ((#1)^7)+26899742660 ((#1)^8)-7801933664 ((#1)^9)+1484163744 ((#1)^10)-166396160 ((#1)^11)+8319808 ((#1)^12)&,10], ])-(NumericalApproximation[Root, (RowDefault["-1.55", FEExpressionsNumericalApproximationElider]), Root[-304961+13619179 #1-99555771 ((#1)^2)+58585163 ((#1)^3)+550688313 ((#1)^4)-414966251 ((#1)^5)-1135380813 ((#1)^6)+670843516 ((#1)^7)+1033140696 ((#1)^8)-419741448 ((#1)^9)-408746240 ((#1)^10)+87357984 ((#1)^11)+58238656 ((#1)^12)&,2], ])))+((Sqrt[-1+2 (NumericalApproximation[Root, (RowDefault["2.55", FEExpressionsNumericalApproximationElider]), Root[507966607-5238296042 #1+23804136251 ((#1)^2)-63111236006 ((#1)^3)+108884438110 ((#1)^4)-128982743932 ((#1)^5)+107734378031 ((#1)^6)-64022560336 ((#1)^7)+26899742660 ((#1)^8)-7801933664 ((#1)^9)+1484163744 ((#1)^10)-166396160 ((#1)^11)+8319808 ((#1)^12)&,10], ])-((NumericalApproximation[Root, (RowDefault["2.55", FEExpressionsNumericalApproximationElider]), Root[507966607-5238296042 #1+23804136251 ((#1)^2)-63111236006 ((#1)^3)+108884438110 ((#1)^4)-128982743932 ((#1)^5)+107734378031 ((#1)^6)-64022560336 ((#1)^7)+26899742660 ((#1)^8)-7801933664 ((#1)^9)+1484163744 ((#1)^10)-166396160 ((#1)^11)+8319808 ((#1)^12)&,10], ])^2)+((NumericalApproximation[Root, (RowDefault["-1.55", FEExpressionsNumericalApproximationElider]), Root[-304961+13619179 #1-99555771 ((#1)^2)+58585163 ((#1)^3)+550688313 ((#1)^4)-414966251 ((#1)^5)-1135380813 ((#1)^6)+670843516 ((#1)^7)+1033140696 ((#1)^8)-419741448 ((#1)^9)-408746240 ((#1)^10)+87357984 ((#1)^11)+58238656 ((#1)^12)&,2], ])^2)+((NumericalApproximation[Root, (RowDefault["0.0862", FEExpressionsNumericalApproximationElider]), Root[5216739529-1280891382141 ((#1)^2)+97112806680757 ((#1)^4)-2845133013808141 ((#1)^6)+36483633158261905 ((#1)^8)-237004400661991501 ((#1)^10)+828289216222231113 ((#1)^12)-1578746037974811664 ((#1)^14)+1666101519179595456 ((#1)^16)-986780984555951424 ((#1)^18)+322286712240657920 ((#1)^20)-53294632992111616 ((#1)^22)+3391741052686336 ((#1)^24)&,13], ])^2)])/(-1+(NumericalApproximation[Root, (RowDefault["2.55", FEExpressionsNumericalApproximationElider]), Root[507966607-5238296042 #1+23804136251 ((#1)^2)-63111236006 ((#1)^3)+108884438110 ((#1)^4)-128982743932 ((#1)^5)+107734378031 ((#1)^6)-64022560336 ((#1)^7)+26899742660 ((#1)^8)-7801933664 ((#1)^9)+1484163744 ((#1)^10)-166396160 ((#1)^11)+8319808 ((#1)^12)&,10], ])-(NumericalApproximation[Root, (RowDefault["-1.55", FEExpressionsNumericalApproximationElider]), Root[-304961+13619179 #1-99555771 ((#1)^2)+58585163 ((#1)^3)+550688313 ((#1)^4)-414966251 ((#1)^5)-1135380813 ((#1)^6)+670843516 ((#1)^7)+1033140696 ((#1)^8)-419741448 ((#1)^9)-408746240 ((#1)^10)+87357984 ((#1)^11)+58238656 ((#1)^12)&,2], ])))]//N

RootReduce[((NumericalApproximation[Root, (RowDefault["0.0862", FEExpressionsNumericalApproximationElider]), Root[5216739529-1280891382141 ((#1)^2)+97112806680757 ((#1)^4)-2845133013808141 ((#1)^6)+36483633158261905 ((#1)^8)-237004400661991501 ((#1)^10)+828289216222231113 ((#1)^12)-1578746037974811664 ((#1)^14)+1666101519179595456 ((#1)^16)-986780984555951424 ((#1)^18)+322286712240657920 ((#1)^20)-53294632992111616 ((#1)^22)+3391741052686336 ((#1)^24)&,13], ])/(-1+(NumericalApproximation[Root, (RowDefault["2.55", FEExpressionsNumericalApproximationElider]), Root[507966607-5238296042 #1+23804136251 ((#1)^2)-63111236006 ((#1)^3)+108884438110 ((#1)^4)-128982743932 ((#1)^5)+107734378031 ((#1)^6)-64022560336 ((#1)^7)+26899742660 ((#1)^8)-7801933664 ((#1)^9)+1484163744 ((#1)^10)-166396160 ((#1)^11)+8319808 ((#1)^12)&,10], ])-(NumericalApproximation[Root, (RowDefault["-1.55", FEExpressionsNumericalApproximationElider]), Root[-304961+13619179 #1-99555771 ((#1)^2)+58585163 ((#1)^3)+550688313 ((#1)^4)-414966251 ((#1)^5)-1135380813 ((#1)^6)+670843516 ((#1)^7)+1033140696 ((#1)^8)-419741448 ((#1)^9)-408746240 ((#1)^10)+87357984 ((#1)^11)+58238656 ((#1)^12)&,2], ])))]

RootReduce[((Sqrt[-1+2 (NumericalApproximation[Root, (RowDefault["2.55", FEExpressionsNumericalApproximationElider]), Root[507966607-5238296042 #1+23804136251 ((#1)^2)-63111236006 ((#1)^3)+108884438110 ((#1)^4)-128982743932 ((#1)^5)+107734378031 ((#1)^6)-64022560336 ((#1)^7)+26899742660 ((#1)^8)-7801933664 ((#1)^9)+1484163744 ((#1)^10)-166396160 ((#1)^11)+8319808 ((#1)^12)&,10], ])-((NumericalApproximation[Root, (RowDefault["2.55", FEExpressionsNumericalApproximationElider]), Root[507966607-5238296042 #1+23804136251 ((#1)^2)-63111236006 ((#1)^3)+108884438110 ((#1)^4)-128982743932 ((#1)^5)+107734378031 ((#1)^6)-64022560336 ((#1)^7)+26899742660 ((#1)^8)-7801933664 ((#1)^9)+1484163744 ((#1)^10)-166396160 ((#1)^11)+8319808 ((#1)^12)&,10], ])^2)+((NumericalApproximation[Root, (RowDefault["-1.55", FEExpressionsNumericalApproximationElider]), Root[-304961+13619179 #1-99555771 ((#1)^2)+58585163 ((#1)^3)+550688313 ((#1)^4)-414966251 ((#1)^5)-1135380813 ((#1)^6)+670843516 ((#1)^7)+1033140696 ((#1)^8)-419741448 ((#1)^9)-408746240 ((#1)^10)+87357984 ((#1)^11)+58238656 ((#1)^12)&,2], ])^2)+((NumericalApproximation[Root, (RowDefault["0.0862", FEExpressionsNumericalApproximationElider]), Root[5216739529-1280891382141 ((#1)^2)+97112806680757 ((#1)^4)-2845133013808141 ((#1)^6)+36483633158261905 ((#1)^8)-237004400661991501 ((#1)^10)+828289216222231113 ((#1)^12)-1578746037974811664 ((#1)^14)+1666101519179595456 ((#1)^16)-986780984555951424 ((#1)^18)+322286712240657920 ((#1)^20)-53294632992111616 ((#1)^22)+3391741052686336 ((#1)^24)&,13], ])^2)])/(-1+(NumericalApproximation[Root, (RowDefault["2.55", FEExpressionsNumericalApproximationElider]), Root[507966607-5238296042 #1+23804136251 ((#1)^2)-63111236006 ((#1)^3)+108884438110 ((#1)^4)-128982743932 ((#1)^5)+107734378031 ((#1)^6)-64022560336 ((#1)^7)+26899742660 ((#1)^8)-7801933664 ((#1)^9)+1484163744 ((#1)^10)-166396160 ((#1)^11)+8319808 ((#1)^12)&,10], ])-(NumericalApproximation[Root, (RowDefault["-1.55", FEExpressionsNumericalApproximationElider]), Root[-304961+13619179 #1-99555771 ((#1)^2)+58585163 ((#1)^3)+550688313 ((#1)^4)-414966251 ((#1)^5)-1135380813 ((#1)^6)+670843516 ((#1)^7)+1033140696 ((#1)^8)-419741448 ((#1)^9)-408746240 ((#1)^10)+87357984 ((#1)^11)+58238656 ((#1)^12)&,2], ])))]

-2 ArcTan[(NumericalApproximation[Root, (RowDefault["0.0279", FEExpressionsNumericalApproximationElider]), Root[5216739529-7091605005556 ((#1)^2)+490139235521186 ((#1)^4)-12561214728941673 ((#1)^6)+151111068069832233 ((#1)^8)-1003420303493356705 ((#1)^10)+3980376909094062337 ((#1)^12)-9697693549881115992 ((#1)^14)+14315845246795099157 ((#1)^16)-11991759968248866551 ((#1)^18)+4799502992290153320 ((#1)^20)-522296716842699824 ((#1)^22)+10325637490140736 ((#1)^24)&,13], ])+(NumericalApproximation[Root, (RowDefault["0.0356", FEExpressionsNumericalApproximationElider]), Root[-17808611093231+14308443421116509 ((#1)^2)-203785684749513720 ((#1)^4)+616529248753811449 ((#1)^6)+3841512328618650735 ((#1)^8)-31837001647280086691 ((#1)^10)+91543838028522215463 ((#1)^12)-132207918859835070834 ((#1)^14)+102026156184546197304 ((#1)^16)-41753717124080012647 ((#1)^18)+8385228165851717608 ((#1)^20)-668898737738805232 ((#1)^22)+10325637490140736 ((#1)^24)&,12], ])]//N

RootApproximant[N[(NumericalApproximation[Root, (RowDefault["0.0279", FEExpressionsNumericalApproximationElider]), Root[5216739529-7091605005556 ((#1)^2)+490139235521186 ((#1)^4)-12561214728941673 ((#1)^6)+151111068069832233 ((#1)^8)-1003420303493356705 ((#1)^10)+3980376909094062337 ((#1)^12)-9697693549881115992 ((#1)^14)+14315845246795099157 ((#1)^16)-11991759968248866551 ((#1)^18)+4799502992290153320 ((#1)^20)-522296716842699824 ((#1)^22)+10325637490140736 ((#1)^24)&,13], ])+(NumericalApproximation[Root, (RowDefault["0.0356", FEExpressionsNumericalApproximationElider]), Root[-17808611093231+14308443421116509 ((#1)^2)-203785684749513720 ((#1)^4)+616529248753811449 ((#1)^6)+3841512328618650735 ((#1)^8)-31837001647280086691 ((#1)^10)+91543838028522215463 ((#1)^12)-132207918859835070834 ((#1)^14)+102026156184546197304 ((#1)^16)-41753717124080012647 ((#1)^18)+8385228165851717608 ((#1)^20)-668898737738805232 ((#1)^22)+10325637490140736 ((#1)^24)&,12], ]),6000],48]

-2ArcTan[(NumericalApproximation[Root, (RowDefault["0.0635", FEExpressionsNumericalApproximationElider]), Root[1-20006 ((#1)^2)+58595157 ((#1)^4)-60693100145 ((#1)^6)+25179218007820 ((#1)^8)-4040396194464648 ((#1)^10)+191872234816717141 ((#1)^12)-4154035334817233389 ((#1)^14)+48923444882019200287 ((#1)^16)-347425906775202774148 ((#1)^18)+1608017822899855406282 ((#1)^20)-5180173274863409824146 ((#1)^22)+12163165792586411005784 ((#1)^24)-21363727567189686108968 ((#1)^26)+28335543480840869557874 ((#1)^28)-28320526010259358718258 ((#1)^30)+21129430419244440772183 ((#1)^32)-11595339488470852918854 ((#1)^34)+4585518232364247528641 ((#1)^36)-1268999069938839318269 ((#1)^38)+234861902550943705228 ((#1)^40)-26911957339106801248 ((#1)^42)+1643577546765561177 ((#1)^44)-37224857955672033 ((#1)^46)+161338085783449 ((#1)^48)&,27], ])]//N

r0=(NumericalApproximation[Root, (RowDefault["0.0279", FEExpressionsNumericalApproximationElider]), Root[5216739529-7091605005556 ((#1)^2)+490139235521186 ((#1)^4)-12561214728941673 ((#1)^6)+151111068069832233 ((#1)^8)-1003420303493356705 ((#1)^10)+3980376909094062337 ((#1)^12)-9697693549881115992 ((#1)^14)+14315845246795099157 ((#1)^16)-11991759968248866551 ((#1)^18)+4799502992290153320 ((#1)^20)-522296716842699824 ((#1)^22)+10325637490140736 ((#1)^24)&,13], ])+(NumericalApproximation[Root, (RowDefault["0.0356", FEExpressionsNumericalApproximationElider]), Root[-17808611093231+14308443421116509 ((#1)^2)-203785684749513720 ((#1)^4)+616529248753811449 ((#1)^6)+3841512328618650735 ((#1)^8)-31837001647280086691 ((#1)^10)+91543838028522215463 ((#1)^12)-132207918859835070834 ((#1)^14)+102026156184546197304 ((#1)^16)-41753717124080012647 ((#1)^18)+8385228165851717608 ((#1)^20)-668898737738805232 ((#1)^22)+10325637490140736 ((#1)^24)&,12], ]);
r1=(NumericalApproximation[Root, (RowDefault["0.0635", FEExpressionsNumericalApproximationElider]), Root[1-20006 ((#1)^2)+58595157 ((#1)^4)-60693100145 ((#1)^6)+25179218007820 ((#1)^8)-4040396194464648 ((#1)^10)+191872234816717141 ((#1)^12)-4154035334817233389 ((#1)^14)+48923444882019200287 ((#1)^16)-347425906775202774148 ((#1)^18)+1608017822899855406282 ((#1)^20)-5180173274863409824146 ((#1)^22)+12163165792586411005784 ((#1)^24)-21363727567189686108968 ((#1)^26)+28335543480840869557874 ((#1)^28)-28320526010259358718258 ((#1)^30)+21129430419244440772183 ((#1)^32)-11595339488470852918854 ((#1)^34)+4585518232364247528641 ((#1)^36)-1268999069938839318269 ((#1)^38)+234861902550943705228 ((#1)^40)-26911957339106801248 ((#1)^42)+1643577546765561177 ((#1)^44)-37224857955672033 ((#1)^46)+161338085783449 ((#1)^48)&,27], ]);

N[r0-r1,10^5]

RootReduce[Csc[(π/7)] Sin[(π/14)]]

{a,b,c,d}={(NumericalApproximation[Root, (RowDefault["0.513", FEExpressionsNumericalApproximationElider]), Root[-1+7 ((#1)^2)-14 ((#1)^4)+7 ((#1)^6)&,4], ]),(NumericalApproximation[Root, (RowDefault["0.640", FEExpressionsNumericalApproximationElider]), Root[-1+7 ((#1)^2)-14 ((#1)^4)+7 ((#1)^6)&,5], ]),(NumericalApproximation[Root, (RowDefault["1.15", FEExpressionsNumericalApproximationElider]), Root[-1+7 ((#1)^2)-14 ((#1)^4)+7 ((#1)^6)&,6], ]),(NumericalApproximation[Root, (RowDefault["1.51", FEExpressionsNumericalApproximationElider]), Root[1276864-28639744 ((#1)^2)+279443024 ((#1)^4)-1566588800 ((#1)^6)+5612815544 ((#1)^8)-13522226984 ((#1)^10)+22435317429 ((#1)^12)-25801321616 ((#1)^14)+20392920940 ((#1)^16)-10795817984 ((#1)^18)+3633462112 ((#1)^20)-698863872 ((#1)^22)+58238656 ((#1)^24)&,24], ])};

{q,r,s,t}={ArcTan[(NumericalApproximation[Root, (RowDefault["0.482", FEExpressionsNumericalApproximationElider]), Root[-7+35 ((#1)^2)-21 ((#1)^4)+((#1)^6)&,4], ])],ArcTan[(NumericalApproximation[Root, (RowDefault["-0.0557", FEExpressionsNumericalApproximationElider]), Root[5216739529-2381780701852 ((#1)^2)+239725030738746 ((#1)^4)-4600603093800316 ((#1)^6)+32585240471511615 ((#1)^8)-97969884239739512 ((#1)^10)+153473672173746828 ((#1)^12)-136768448983085976 ((#1)^14)+70616716067949015 ((#1)^16)-20321434041354860 ((#1)^18)+2893270371546842 ((#1)^20)-145969784289132 ((#1)^22)+93001211521 ((#1)^24)&,12], ])],-2ArcTan[(NumericalApproximation[Root, (RowDefault["0.0635", FEExpressionsNumericalApproximationElider]), Root[1-20006 ((#1)^2)+58595157 ((#1)^4)-60693100145 ((#1)^6)+25179218007820 ((#1)^8)-4040396194464648 ((#1)^10)+191872234816717141 ((#1)^12)-4154035334817233389 ((#1)^14)+48923444882019200287 ((#1)^16)-347425906775202774148 ((#1)^18)+1608017822899855406282 ((#1)^20)-5180173274863409824146 ((#1)^22)+12163165792586411005784 ((#1)^24)-21363727567189686108968 ((#1)^26)+28335543480840869557874 ((#1)^28)-28320526010259358718258 ((#1)^30)+21129430419244440772183 ((#1)^32)-11595339488470852918854 ((#1)^34)+4585518232364247528641 ((#1)^36)-1268999069938839318269 ((#1)^38)+234861902550943705228 ((#1)^40)-26911957339106801248 ((#1)^42)+1643577546765561177 ((#1)^44)-37224857955672033 ((#1)^46)+161338085783449 ((#1)^48)&,27], ])],ArcTan[(NumericalApproximation[Root, (RowDefault["175.", FEExpressionsNumericalApproximationElider]), Root[2401-1094170 ((#1)^2)+7551439 ((#1)^4)-6801452 ((#1)^6)+1297135 ((#1)^8)-30618 ((#1)^10)+((#1)^12)&,12], ])]};

v3=Join[CirclePoints[{a,s},7],CirclePoints[{b,q},7],CirclePoints[{c,t},7],CirclePoints[{d,r},7]]

g=Graph[Range[Length[v3]],Complement[ee,UndirectedEdge@@@noee],VertexCoordinates->v3,VertexLabels->"Name"]

RecognizeGraph@g

UnitDistanceGraphEmbeddingQ[g]

f0=v3[[1]]

{Cos[2 ArcTan[u]]w,-w Sin[2 ArcTan[u]]}//TrigExpand

TrigExpand[f0]

RootReduce[%]

(f1=RootApproximant[N[f0,5000],48])//Timing

N[f0-f1,10000]

(v4=RootApproximant[N[#,5000],48]&/@v3)//Timing

N[v3-v4,10000]

g=Graph[Range[Length[v4]],Complement[ee,UndirectedEdge@@@noee],VertexCoordinates->v4,VertexLabels->"Name"]

Max[N[Abs[EdgeLengths[g]-1],100000]]

UnitDistance construction Gerbracht

E. H.-A. Gerbracht
Jan. 4, 2010

s1=Sin[1/2*(Pi-2*k/n*Pi)]/Sin[k*2*Pi/n]/.{n->7,k->1};
s2=Sin[1/2*(Pi-2*k/n*Pi)]/Sin[k*2*Pi/n]/.{n->7,k->2};
s3=Sin[1/2*(Pi-2*k/n*Pi)]/Sin[k*2*Pi/n]/.{n->7,k->3};
{s1,s2,s3}=RootReduce/@{s1,s2,s3}

A1={-s2*Cos[0*2*Pi/7],s2*Sin[0*2*Pi/7]};
A2={-s2*Cos[6*2*Pi/7],s2*Sin[6*2*Pi/7]};
A3={-s2*Cos[5*2*Pi/7],s2*Sin[5*2*Pi/7]};
A4={-s2*Cos[4*2*Pi/7],s2*Sin[4*2*Pi/7]};
A5={-s2*Cos[3*2*Pi/7],s2*Sin[3*2*Pi/7]};
A6={-s2*Cos[2*2*Pi/7],s2*Sin[2*2*Pi/7]};
A7={-s2*Cos[1*2*Pi/7],s2*Sin[1*2*Pi/7]};
{A1,A2,A3,A4,A5,A6,A7}=RootReduce[{A1,A2,A3,A4,A5,A6,A7}]

alpha=FullSimplify[TrigExpand[ArcSin[1/(4*s1)]]];
V1={-s1*Cos[0*2*Pi/7-alpha],s1*Sin[0*2*Pi/7-alpha]};
V2={-s1*Cos[6*2*Pi/7-alpha],s1*Sin[6*2*Pi/7-alpha]};
V3={-s1*Cos[5*2*Pi/7-alpha],s1*Sin[5*2*Pi/7-alpha]};
V4={-s1*Cos[4*2*Pi/7-alpha],s1*Sin[4*2*Pi/7-alpha]};
V5={-s1*Cos[3*2*Pi/7-alpha],s1*Sin[3*2*Pi/7-alpha]};
V6={-s1*Cos[2*2*Pi/7-alpha],s1*Sin[2*2*Pi/7-alpha]};
V7={-s1*Cos[1*2*Pi/7-alpha],s1*Sin[1*2*Pi/7-alpha]};
{V1,V2,V3,V4,V5,V7,V7}=RootReduce[TrigExpand[#]]&/@{V1,V2,V3,V4,V5,V7,V7}

dAV=Sqrt[(A1[[1]]-V1[[1]])^2+(A1[[2]]-V1[[2]])^2];
dAVO=Sqrt[1-(1/2*dAV)^2];
t1={V1[[1]]-A1[[1]],V1[[2]]-A1[[2]]};
t2={t1[[2]],-t1[[1]]}/dAV;
O1=A1+1/2*t1+dAVO*t2;
O2={Re[(O1[[1]]+I*O1[[2]])*Exp[I*1*(2*Pi)/7]],Im[(O1[[1]]+I*O1[[2]])*Exp[I*1*(2*Pi)/7]]};
O3={Re[(O1[[1]]+I*O1[[2]])*Exp[I*2*(2*Pi)/7]],Im[(O1[[1]]+I*O1[[2]])*Exp[I*2*(2*Pi)/7]]};
O4={Re[(O1[[1]]+I*O1[[2]])*Exp[I*3*(2*Pi)/7]],Im[(O1[[1]]+I*O1[[2]])*Exp[I*3*(2*Pi)/7]]};
O5={Re[(O1[[1]]+I*O1[[2]])*Exp[I*4*(2*Pi)/7]],Im[(O1[[1]]+I*O1[[2]])*Exp[I*4*(2*Pi)/7]]};
O6={Re[(O1[[1]]+I*O1[[2]])*Exp[I*5*(2*Pi)/7]],Im[(O1[[1]]+I*O1[[2]])*Exp[I*5*(2*Pi)/7]]};
O7={Re[(O1[[1]]+I*O1[[2]])*Exp[I*6*(2*Pi)/7]],Im[(O1[[1]]+I*O1[[2]])*Exp[I*6*(2*Pi)/7]]};
simp[expr_]:=RootReduce[Expand[(expr/.(x:(_Cos|_Sin|_Sec))*(y:(_Cos|_Sin|_Sec)):>RootReduce[x y]/.x:(_Cos|_Sin|_Sec):>RootReduce[x])/.Sqrt[x_]:>RootReduce[Sqrt[RootReduce[x]]]]/.(x_Root y_Root :>RootReduce[x y])]
{O1,O2,O3,O4,O5,O6,O7}=simp/@{O1,O2,O3,O4,O5,O6,O7}

PxH1=Resultant[(xH1-O1[[1]])^2+(yH1-O1[[2]])^2-1,xH1^2+yH1^2-s3^2,yH1];//Timing

PyH1=Resultant[(xH1-O1[[1]])^2+(yH1-O1[[2]])^2-1,xH1^2+yH1^2-s3^2,xH1];//Timing

S1=Solve[PxH1==0,xH1];
S2=Solve[PyH1==0,yH1];

S1

H1={xH1,yH1}/.S1[[2]]/.S2[[2]]

N[H1]

(H1=RootReduce[H1])//Timing

Ran over two nights...

H2={Re[(H1[[1]]+I*H1[[2]])*Exp[I*1*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*1*(2*Pi)/7]]};
H3={Re[(H1[[1]]+I*H1[[2]])*Exp[I*2*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*2*(2*Pi)/7]]};
H4={Re[(H1[[1]]+I*H1[[2]])*Exp[I*3*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*3*(2*Pi)/7]]};
H5={Re[(H1[[1]]+I*H1[[2]])*Exp[I*4*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*4*(2*Pi)/7]]};
H6={Re[(H1[[1]]+I*H1[[2]])*Exp[I*5*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*5*(2*Pi)/7]]};
H7={Re[(H1[[1]]+I*H1[[2]])*Exp[I*6*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*6*(2*Pi)/7]]};

Flatten[Outer[StringJoin, {"A","H","O","V"}, ToString/@Range[7]]]

exact=ToExpression[Flatten[Outer[StringJoin, {"A","H","O","V"}, ToString/@Range[7]]]]

exact=;

N[exact]

H1[[1]]

N[H1orig=H1[[1]]]

RootReduce[2 (((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^2)+((NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])^2))]

RootReduce[(-((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^2)+2 ((NumericalApproximation[Root, (RowDefault["0.513", FEExpressionsNumericalApproximationElider]), Root[-1+7 ((#1)^2)-14 ((#1)^4)+7 ((#1)^6)&,4], ])^2) ((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^2)-((NumericalApproximation[Root, (RowDefault["0.513", FEExpressionsNumericalApproximationElider]), Root[-1+7 ((#1)^2)-14 ((#1)^4)+7 ((#1)^6)&,4], ])^4) ((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^2)+2 ((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^4)+2 ((NumericalApproximation[Root, (RowDefault["0.513", FEExpressionsNumericalApproximationElider]), Root[-1+7 ((#1)^2)-14 ((#1)^4)+7 ((#1)^6)&,4], ])^2) ((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^4)-((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^6)+2 ((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^2) ((NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])^2)+2 ((NumericalApproximation[Root, (RowDefault["0.513", FEExpressionsNumericalApproximationElider]), Root[-1+7 ((#1)^2)-14 ((#1)^4)+7 ((#1)^6)&,4], ])^2) ((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^2) ((NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])^2)-2 ((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^4) ((NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])^2)-((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^2) ((NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])^4))]

RootReduce[Sqrt[%]]

RootReduce[((NumericalApproximation[Root, (RowDefault["0.513", FEExpressionsNumericalApproximationElider]), Root[-1+7 ((#1)^2)-14 ((#1)^4)+7 ((#1)^6)&,4], ])^2) (NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])]

H1simp=((-(NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])+(NumericalApproximation[Root, (RowDefault["-0.348", FEExpressionsNumericalApproximationElider]), Root[35152125121-30840943058520 ((#1)^2)+9263088652296528 ((#1)^4)-1344609890874083456 ((#1)^6)+107707695791698462208 ((#1)^8)-5066312922699606667264 ((#1)^10)+144338943733555571789824 ((#1)^12)-2506213242983931267383296 ((#1)^14)+26077761420455023175794688 ((#1)^16)-155937872519913671418183680 ((#1)^18)+490671443613085317231280128 ((#1)^20)-656030919445692748230819840 ((#1)^22)+136626437389023480408702976 ((#1)^24)&,4], ])+((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^2) (NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])+((NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])^3)+(NumericalApproximation[Root, (RowDefault["0.0804", FEExpressionsNumericalApproximationElider]), Root[-15847850455283228107703039+1271594731066783754969926448 ((#1)^2)+254248947470146641599552201824 ((#1)^4)-12487955777330973574706226365056 ((#1)^6)+«6»+52755831999294724480682979110158336 ((#1)^16)-57049637497520903555515501401604096 ((#1)^18)+36267828361782591336094743050321920 ((#1)^20)-12243169755233782382360963844145152 ((#1)^22)+1640503011202338209907900430680064 ((#1)^24)&,12], ]))/(NumericalApproximation[Root, (RowDefault["4.57", FEExpressionsNumericalApproximationElider]), Root[81719296-916471808 #1+4471088384 ((#1)^2)-12532710400 ((#1)^3)+22451262176 ((#1)^4)-27044453968 ((#1)^5)+22435317429 ((#1)^6)-12900660808 ((#1)^7)+5098230235 ((#1)^8)-1349477248 ((#1)^9)+227091382 ((#1)^10)-21839496 ((#1)^11)+909979 ((#1)^12)&,12], ]));

N[H1orig-H1simp,10000]

(rnum=RootReduce[-(NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])+(NumericalApproximation[Root, (RowDefault["-0.348", FEExpressionsNumericalApproximationElider]), Root[35152125121-30840943058520 ((#1)^2)+9263088652296528 ((#1)^4)-1344609890874083456 ((#1)^6)+107707695791698462208 ((#1)^8)-5066312922699606667264 ((#1)^10)+144338943733555571789824 ((#1)^12)-2506213242983931267383296 ((#1)^14)+26077761420455023175794688 ((#1)^16)-155937872519913671418183680 ((#1)^18)+490671443613085317231280128 ((#1)^20)-656030919445692748230819840 ((#1)^22)+136626437389023480408702976 ((#1)^24)&,4], ])+((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^2) (NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])+((NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])^3)+(NumericalApproximation[Root, (RowDefault["0.0804", FEExpressionsNumericalApproximationElider]), Root[-15847850455283228107703039+1271594731066783754969926448 ((#1)^2)+254248947470146641599552201824 ((#1)^4)-12487955777330973574706226365056 ((#1)^6)+«6»+52755831999294724480682979110158336 ((#1)^16)-57049637497520903555515501401604096 ((#1)^18)+36267828361782591336094743050321920 ((#1)^20)-12243169755233782382360963844145152 ((#1)^22)+1640503011202338209907900430680064 ((#1)^24)&,12], ])])//Timing

(r1=RootReduce[((-(NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ]))/(NumericalApproximation[Root, (RowDefault["4.57", FEExpressionsNumericalApproximationElider]), Root[81719296-916471808 #1+4471088384 ((#1)^2)-12532710400 ((#1)^3)+22451262176 ((#1)^4)-27044453968 ((#1)^5)+22435317429 ((#1)^6)-12900660808 ((#1)^7)+5098230235 ((#1)^8)-1349477248 ((#1)^9)+227091382 ((#1)^10)-21839496 ((#1)^11)+909979 ((#1)^12)&,12], ]))])//Timing

(r2=RootReduce[((NumericalApproximation[Root, (RowDefault["-0.348", FEExpressionsNumericalApproximationElider]), Root[35152125121-30840943058520 ((#1)^2)+9263088652296528 ((#1)^4)-1344609890874083456 ((#1)^6)+107707695791698462208 ((#1)^8)-5066312922699606667264 ((#1)^10)+144338943733555571789824 ((#1)^12)-2506213242983931267383296 ((#1)^14)+26077761420455023175794688 ((#1)^16)-155937872519913671418183680 ((#1)^18)+490671443613085317231280128 ((#1)^20)-656030919445692748230819840 ((#1)^22)+136626437389023480408702976 ((#1)^24)&,4], ])/(NumericalApproximation[Root, (RowDefault["4.57", FEExpressionsNumericalApproximationElider]), Root[81719296-916471808 #1+4471088384 ((#1)^2)-12532710400 ((#1)^3)+22451262176 ((#1)^4)-27044453968 ((#1)^5)+22435317429 ((#1)^6)-12900660808 ((#1)^7)+5098230235 ((#1)^8)-1349477248 ((#1)^9)+227091382 ((#1)^10)-21839496 ((#1)^11)+909979 ((#1)^12)&,12], ]))])//Timing

(r3=RootReduce[((((NumericalApproximation[Root, (RowDefault["0.730", FEExpressionsNumericalApproximationElider]), Root[6603409-45743880 #1-79630712 ((#1)^2)+721966784 ((#1)^3)+448464016 ((#1)^4)-4203539200 ((#1)^5)-1924433728 ((#1)^6)+11423896064 ((#1)^7)+5587248128 ((#1)^8)-14727659520 ((#1)^9)-8435187712 ((#1)^10)+7302414336 ((#1)^11)+4868276224 ((#1)^12)&,11], ])^2) (NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ]))/(NumericalApproximation[Root, (RowDefault["4.57", FEExpressionsNumericalApproximationElider]), Root[81719296-916471808 #1+4471088384 ((#1)^2)-12532710400 ((#1)^3)+22451262176 ((#1)^4)-27044453968 ((#1)^5)+22435317429 ((#1)^6)-12900660808 ((#1)^7)+5098230235 ((#1)^8)-1349477248 ((#1)^9)+227091382 ((#1)^10)-21839496 ((#1)^11)+909979 ((#1)^12)&,12], ]))])//Timing

(r4=RootReduce[(((NumericalApproximation[Root, (RowDefault["-1.32", FEExpressionsNumericalApproximationElider]), Root[35152125121-5176175313232 ((#1)^2)+308862648818528 ((#1)^4)-9856956441883264 ((#1)^6)+186994254304806144 ((#1)^8)-2213961156988442624 ((#1)^10)+16672290628110716928 ((#1)^12)-79548368098411806720 ((#1)^14)+233628101261512409088 ((#1)^16)-396841563440740827136 ((#1)^18)+351747527532020236288 ((#1)^20)-148946458016732938240 ((#1)^22)+23700113393163698176 ((#1)^24)&,2], ])^3)/(NumericalApproximation[Root, (RowDefault["4.57", FEExpressionsNumericalApproximationElider]), Root[81719296-916471808 #1+4471088384 ((#1)^2)-12532710400 ((#1)^3)+22451262176 ((#1)^4)-27044453968 ((#1)^5)+22435317429 ((#1)^6)-12900660808 ((#1)^7)+5098230235 ((#1)^8)-1349477248 ((#1)^9)+227091382 ((#1)^10)-21839496 ((#1)^11)+909979 ((#1)^12)&,12], ]))])//Timing

(r5=RootReduce[((NumericalApproximation[Root, (RowDefault["0.0804", FEExpressionsNumericalApproximationElider]), Root[-15847850455283228107703039+1271594731066783754969926448 ((#1)^2)+254248947470146641599552201824 ((#1)^4)-12487955777330973574706226365056 ((#1)^6)+«6»+52755831999294724480682979110158336 ((#1)^16)-57049637497520903555515501401604096 ((#1)^18)+36267828361782591336094743050321920 ((#1)^20)-12243169755233782382360963844145152 ((#1)^22)+1640503011202338209907900430680064 ((#1)^24)&,12], ])/(NumericalApproximation[Root, (RowDefault["4.57", FEExpressionsNumericalApproximationElider]), Root[81719296-916471808 #1+4471088384 ((#1)^2)-12532710400 ((#1)^3)+22451262176 ((#1)^4)-27044453968 ((#1)^5)+22435317429 ((#1)^6)-12900660808 ((#1)^7)+5098230235 ((#1)^8)-1349477248 ((#1)^9)+227091382 ((#1)^10)-21839496 ((#1)^11)+909979 ((#1)^12)&,12], ]))])//Timing

N[r1+r2+r3+r4+r5-H1orig,20000]

(r12=RootReduce[r1+r2])//Timing

(r=RootApproximant[N[H1orig,20000],24])//Timing

N[r-H1orig,20000]

v=Join[
{A1,A2,A3,A4,A5,A6,A7},
N[{H1,H2,H3,H4,H5,H6,H7}],
{O1,O2,O3,O4,O5,O6,O7},
{V1,V2,V3,V4,V5,V6,V7}]

e=UnitEdges[v]//Quiet

g=Graph[Range[Length[v]],e,VertexCoordinates->v,VertexLabels->Automatic]

v[[8]]

R=Norm[H1]

alpha

alpha/Pi//N

N[ArcTan@@H7-Pi/2]

(π/14)-ArcCsc[4 (NumericalApproximation[Root, (RowDefault["1.15", FEExpressionsNumericalApproximationElider]), Root[-1+7 ((#1)^2)-14 ((#1)^4)+7 ((#1)^6)&,6], ])]//N

R1=RootApproximant[N[R,1000],12]

N[R-R1,10000]

r=RecognizeGraph[g]

UnitDistanceGraphEmbeddingQ@g

RootReduce[Expand[((EdgeLengths[g])^2)]]//Timing

GraphData["CoxeterGraph","Embeddings","UnitDistance"]

(v=Identity[ToExpression[Flatten[Outer[StringJoin, {"A","H","O","V"}, ToString/@Range[7]]]]])//N

Length[v]

nv=N[v];

e=Select[Subsets[Range[Length[v]],{2}],.99<Norm[Subtract@@(nv[[#]])]<1.01&]

Length[e]

ShowLabeledGraph[g=Graph[List/@e,List/@nv]]

r=RecognizeGraph[g]

ToCommonEdges[g,r]

GetGraphData[r,"File"]

GraphPlot[g,Method->None,ImageSize->200]

Exact

Table[Print[{i,ByteCount[expr=v[[i]]],expr2=TimeConstrained[RootReduce[expr],60]//Timing;ByteCount[expr2[[2]]],expr2}],{i,Length[v]}]

Table[Print[{i,ByteCount[expr=v[[i]]],expr2=TimeConstrained[RootReduce[Expand[(expr/.(x:(_Cos|_Sin|_Sec))*(y:(_Cos|_Sin|_Sec)):>RootReduce[x y]/.x:(_Cos|_Sin|_Sec):>RootReduce[x])/.Sqrt[x_]:>RootReduce[Sqrt[RootReduce[x]]]]/.(x_Root y_Root :>RootReduce[x y])],60]//Timing;ByteCount[expr2[[2]]],expr2}],{i,16,21}];

Table[Print[{i,ByteCount[expr=v[[i]]],expr2=TimeConstrained[RootReduce[TrigExpand[expr]],60]//Timing;ByteCount[expr2[[2]]],expr2}],{i,22,Length[v]}];

Redo H's

(PxH1=RootReduce@Resultant[RootReduce[(xH1-O1[[1]])^2+(yH1-O1[[2]])^2-1],RootReduce[xH1^2+yH1^2-s3^2],yH1])//Timing

(PyH1=RootReduce@Resultant[RootReduce[(xH1-O1[[1]])^2+(yH1-O1[[2]])^2-1],RootReduce[xH1^2+yH1^2-s3^2],xH1])//Timing

S1=Solve[PxH1==0,xH1]

(PyH1eqn=FullSimplify[PxH1==0])//Timing

S1=Solve[PyH1eqn,xH1]

S2=Solve[PyH1==0,yH1]

H1={xH1,yH1}/.RootReduce[S1[[2]]]/.RootReduce[S2[[2]]]

H2={Re[(H1[[1]]+I*H1[[2]])*Exp[I*1*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*1*(2*Pi)/7]]};
H3={Re[(H1[[1]]+I*H1[[2]])*Exp[I*2*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*2*(2*Pi)/7]]};
H4={Re[(H1[[1]]+I*H1[[2]])*Exp[I*3*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*3*(2*Pi)/7]]};
H5={Re[(H1[[1]]+I*H1[[2]])*Exp[I*4*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*4*(2*Pi)/7]]};
H6={Re[(H1[[1]]+I*H1[[2]])*Exp[I*5*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*5*(2*Pi)/7]]};
H7={Re[(H1[[1]]+I*H1[[2]])*Exp[I*6*(2*Pi)/7]],Im[(H1[[1]]+I*H1[[2]])*Exp[I*6*(2*Pi)/7]]};

Find H[[1]] Exactly

E Gerbracht 1/2010

(* Characteristic Polynomial of the radii for the A, H, and V-circles *)
(* for all three it is the same, though i usually do not use Mathematica's MinimalPolynomial - routine but one of my own. Experience has shown that mine is faster (for regular n-gons with large n), but I have no proof, why this works out                           *)
s1=Sin[(7-2*1)/(2*7)*Pi]/Sin[1*2*Pi/7]
N[%]
s2=Sin[(7-2*2)/(2*7)*Pi]/Sin[2*2*Pi/7]
N[%]
s3=Sin[(7-2*3)/(2*7)*Pi]/Sin[3*2*Pi/7]
N[%]

MinimalPolynomial[s3];

Pr=-1+7 (r^2)-14 (r^4)+7 (r^6);

(* Minimal polynomials for the coordinates of A1, formerly A *)
yA=0
PxA=Resultant[Pr,r+xA,r]

(* Minimal polynomials for the coordinates of V1 *)
yV1=-1/4;
s01=xV1^2+yV1^2-r^2;
Factor[Resultant[Pr,s01,r]]

PxV1=-2521+21840 (xV1^2)-51968 (xV1^4)+28672 (xV1^6)

(* ... leaving out some stuff, but you have done this already *)
(* minimal polynomials for v2 *)

PxV2=6889-731920 (xV2^2)+16828672 (xV2^4)-156405760 (xV2^6)+671154176 (xV2^8)-1284505600 (xV2^10)+822083584 (xV2^12)
PyV2=13-452 yV2+976 (yV2^2)+1984 (yV2^3)-4864 (yV2^4)-1024 (yV2^5)+4096 (yV2^6)

(* Minimal polynomials for the coordinates of O1, formerly just O *)
(* defining equations *)
t01=(xO-xV1)^2+(yO-yV1)^2-1;
t02=(xO-xA)^2+(yO-yA)^2-1;

(* several  Factor[resultants[...   later, none of them taking too much time: *)

PxO=35152125121-5176175313232 (xO^2)+308862648818528 (xO^4)-9856956441883264 (xO^6)+186994254304806144 (xO^8)-2213961156988442624 (xO^10)+16672290628110716928 (xO^12)-79548368098411806720 (xO^14)+233628101261512409088 (xO^16)-396841563440740827136 (xO^18)+351747527532020236288 (xO^20)-14894645801673293824;
PyO=6603409-45743880 yO-79630712 (yO^2)+721966784 (yO^3)+448464016 (yO^4)-4203539200 (yO^5)-1924433728 (yO^6)+11423896064 (yO^7)+5587248128 (yO^8)-14727659520 (yO^9)-8435187712 (yO^10)+7302414336 (yO^11)+4868276224 (yO^12)0 (xO^22)+23700113393163698176 (xO^24);

(* Now for the heavy stuff: the Hs (in fact only H1, formerly H) *)
(* defining equations:  *)
u01=(xH-xO)^2+(yH-yO)^2-1;
u02=xH^2+yH^2-r3^2;
Pr3=Resultant[Pr,r-r3,r]

(* r3 is just one of the radii with characteristic polynomial Pr *)
(* Now again with the resultants followed by factoring:          *)
(* first eliminating r3 from u02                                 *)

Factor[Resultant[u02,Pr3,r3]]

(*  the correct factor will be called  P6                        *)
(* then eliminating xO from u01 using PxO                        *)

Timing[P7=Factor[Resultant[u01,PxO,xO]]]
(* both were done in a breeze (the last took 69.33). Now it took longer and  *)
(* longer: times needed using Mathematica 6                      *)

Timing[P8=Resultant[P6,P7,yH]]
(* 931.019 sec *)
(* Factoring P8 at that time took 5051.78 secs  *)
(* The correct factor was called P11. *)

Timing[Resultant[P11,PyO,yO]]       
(* yO thus eliminated in 24.995 but resulting single variable (xH) polynomial was of degree 576  *)
(* Factoring was done OUTSIDE of Mathematica, using SINGULAR,       *)(* because the running time with M. was prohibitive                 *)

PxH=1556509462029770409163053651654790491406336*xH^48-15451021871963797287891139494971254371254272*xH^46+71086082661521244440555893131167542542336000*xH^44-201762273037678684164883219978134281770762240*xH^42+396792474499376769858312072819115010362966016*xH^40-575805628333333689571374757217422123751964672*xH^38+641184195466227576752536813560001052907929600*xH^36-562540869457946574582843660294160770949709824*xH^34+396192473322912547947596832021599490985164800*xH^32-227051405374173222754728384112270055097499648*xH^30+106924530247444466063385459082051747284254720*xH^28-41664111371970627884062602693636680495136768*xH^26+13492117478002023244366127010001606349422592*xH^24-3638363492046043448791372189034586327482368*xH^22+816721375962361320237232636381944229134336*xH^20-152157283851826844435437142388912924655616*xH^18+23387895909592998216444977996957353771008*xH^16-2938111609580112359949778337582248460288*xH^14+297507593762978624475343036075671760896*xH^12-23805146877966446553155273304027164672*xH^10+1462933469724695989299832514691985920*xH^8-66188655206975079837615527443448192*xH^6+2060734221932216146375255874990032*xH^4-39042416211921490362796217300696*xH^2+334584415190272321697674847041;

(* Finally without much further ado *)
Factor[Resultant[PxH,P6,xH]]
(* gives a characteristic polynomial for yH *)
(* The minimal polynomial is  *)

PyH=1301124497-140431701200 yH+3715685304828 (yH^2)+10709517085120 (yH^3)-453656291585056 (yH^4)+170523143258496 (yH^5)+19424459120037440 (yH^6)-17749636661947904 (yH^7)-443032467304412160 (yH^8)+339833600540944384 (yH^9)+6274493786791071744 (yH^10)-2154253264491044864 (yH^11)-57993994169592606720 (yH^12)-9778651621836783616 (yH^13)+346205425033696772096 (yH^14)+232402603462550355968 (yH^15)-1257532602614735175680 (yH^16)-1448774721658201047040 (yH^17)+2423384487750742835200 (yH^18)+4195436093902518484992 (yH^19)-1583377091316982743040 (yH^20)-5496811842070554607616 (yH^21)-1034092063538383159296 (yH^22)+2621613994296301584384 (yH^23)+1247601483659654201344 (yH^24);

H1//N

(H1={Solve[Reduce[PxH==0&&-.49<xH<-.48,xH],xH][[1,1,-1]],Solve[Reduce[PyH==0&&.27<yH<.28,yH],yH][[1,1,-1]]})//N

H1c=RootReduce/@(H1.{1,I})

H1c=Root[334584415190272321697674847041-39042416211921490362796217300696 ((#1)^2)+2060734221932216146375255874990032 ((#1)^4)-66188655206975079837615527443448192 ((#1)^6)+1462933469724695989299832514691985920 ((#1)^8)-23805146877966446553155273304027164672 ((#1)^10)+297507593762978624475343036075671760896 ((#1)^12)-2938111609580112359949778337582248460288 ((#1)^14)+23387895909592998216444977996957353771008 ((#1)^16)-152157283851826844435437142388912924655616 ((#1)^18)+816721375962361320237232636381944229134336 ((#1)^20)-3638363492046043448791372189034586327482368 ((#1)^22)+13492117478002023244366127010001606349422592 ((#1)^24)-41664111371970627884062602693636680495136768 ((#1)^26)+106924530247444466063385459082051747284254720 ((#1)^28)-227051405374173222754728384112270055097499648 ((#1)^30)+396192473322912547947596832021599490985164800 ((#1)^32)-562540869457946574582843660294160770949709824 ((#1)^34)+641184195466227576752536813560001052907929600 ((#1)^36)-575805628333333689571374757217422123751964672 ((#1)^38)+396792474499376769858312072819115010362966016 ((#1)^40)-201762273037678684164883219978134281770762240 ((#1)^42)+71086082661521244440555893131167542542336000 ((#1)^44)-15451021871963797287891139494971254371254272 ((#1)^46)+1556509462029770409163053651654790491406336 ((#1)^48)&,14]+Root[1692924956693503009+10051924355416835096968 ((#1)^2)+15633702062703498250963920 ((#1)^4)+3387540798959559527875189376 ((#1)^6)+340363840338954863209927748096 ((#1)^8)+20453518089305643918677739868160 ((#1)^10)+823925207615747297910973202214912 ((#1)^12)+23721886247086703034922681944670208 ((#1)^14)+508296520878133979587282749879484416 ((#1)^16)+8330079363656494853183795782342934528 ((#1)^18)+106434393200356255314128861896307113984 ((#1)^20)+1074932478937474086798613908635315601408 ((#1)^22)+8664830655624764761638553238917477302272 ((#1)^24)+56103148579727800776879765795467897602048 ((#1)^26)+292745150208384412141518505269902287306752 ((#1)^28)+1231157713574660361136778916336028675473408 ((#1)^30)+4158920994524636384814779252214321796612096 ((#1)^32)+11200935399029291922374849754588773393367040 ((#1)^34)+23757067637411538230840660855619526152159232 ((#1)^36)+38957109136982678480659075985261323259740160 ((#1)^38)+48076580377383150132501132842198944368820224 ((#1)^40)+42891016846798394583456087208412254444716032 ((#1)^42)+25939536877605116490316216079170203428061184 ((#1)^44)+9453129520512529258717718931505393491247104 ((#1)^46)+1556509462029770409163053651654790491406336 ((#1)^48)&,40];

Timing[H1c=RootReduce[H1c]]

H2c=H1c Exp[2π I/7];
H3c=H1c Exp[2 2π I/7];
H4c=H1c Exp[3 2π I/7];
H5c=H1c Exp[4 2π I/7];
H6c=H1c Exp[5 2π I/7];
H7c=H1c Exp[6 2π I/7];

H7//N

H7c//N

{H2,H3}//N

H3//N

RootReduce[RootReduce/@(H1.{1,I})]

N[RootApproximant[r,48]-r,20]

N[r,100]

Length/@{xH/.{ToRules[NRoots[PxH==0,xH]]},yH/.{ToRules[NRoots[PyH==0,yH]]}}

RootReduce[RotationMatrix[2π/7]].H1//RootReduce

RootReduce[H2[[1]]/.f:(_Sin|_Cos):>RootReduce[f]]/. r_Root s_Root:>RootReduce[r s]

RootReduce[H2]

Using Resultants

mat=RootReduce[RotationMatrix[2 π k/7]/.k->1]

{e1,e2}={{a,b},{c,d}}.{xH,yH}-{u,v}

{fa,fb,fc,fd}=MapThread[MinimalPolynomial,{Flatten[mat],{a,b,c,d}}]

e11=Resultant[e1,fa,a]

e12=Resultant[e11,fb,b]

ee12=Select[First/@FactorList[e12],!NumberQ[#]&]

ee13=Resultant[#,PyH,yH]&/@ee12;//Timing

ee14=Union@@(Select[First/@FactorList[#],!NumberQ[#]&]&/@ee13);//Timing

UnitDistance FindSubgraphUnitDistanceEmbedding

{"CoxeterGraph",l=FindSubgraphUnitDistanceEmbedding[GraphData["CoxeterGraph"],TimeConstraint->300,"Results"->All]//Timing}

gs=UniqueEmbeddings[l]

Matchstick

GraphData["CoxeterGraph","Graph","Matchstick"]//StyleGraphs

Default embedding

GraphPlot@GraphData["CoxeterGraph","Edges"]

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

3D default

Graph3D[GraphData["CoxeterGraph","Edges"]]

3D All

GraphData["CoxeterGraph","Graph",{"3D","All"}]

3D UnitDistance

GraphData["CoxeterGraph","Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData["CoxeterGraph","Graph",{"3D","Polyhedron"}]

YGraph expansion (7; 1, 2, 4)

GraphData

GraphClassString

GraphClassString["CoxeterGraph"]