Polyhex

Author

Eric W. Weisstein
October 30, 2007

This notebook downloaded from http://mathworld.wolfram.com/notebooks/RecreationalMath/Polyhex.nb.

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

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

Initialization

Array

GraphicsArray[Map[ShowGraph[PolyformGraph[#]]&,Polyhexes/@Range[4],{2}]]

GraphData["Polyhex"]

GraphicsGrid[Partition[Show[GraphData[#],PlotLabel->TextCell[GraphData[#,"Name"],PageWidth->70,TextAlignment->Center]]&/@GraphData["Polyhex"],5,5,{1,1},{}],ImageSize->500]

{n,k}={4,7};
GraphData[g={"Polyhex",{n,k}},{"#","StandardNames"}]
p=PolyformGraph[Polyhexes[n][[k]]];
Vertices[p]

Counts

A000228

l={{1,1,3,7,22,82,333,1448,6572,30490,143552,683101,3274826},
{1,1,2,5,12,37,123,446,1689,6693,27034,111630,467262,1981353,8487400,36695369,159918120,701957539,3101072051,13779935438,61557789660,276327463180,1245935891922,5640868033058,25635351908072,116911035023017},
{1,1,3,10,33,147,620,2821,12942,60639,286190,1364621,6545430}};

Length/@l

l2={Join[l[[1]],Table["",{13}]],l[[2]],Join[l[[3]],Table["",{13}]]}

TableForm[Transpose[Take[#,24]&/@l2],TableAlignments->Right,TableHeadings->{Automatic,{"A000228","A002216","A006536"}}]

Harary-Read numbers

h[x_]:=1/24/x^2(12+24x-48x^2-24x^3+(1-x)^(3/2)(1-5x)^(3/2)-3(3+5x)Sqrt[1-x^2]Sqrt[1-5x^2]-4Sqrt[1-x^3]Sqrt[1-5x^3])

h[x]

FullSimplify[h[x]]

Series[h[x],{x,0,10}]

Figures

o={2,1};
Show[Graphics[{
PistolPolyhex[o,0,1,LineStyle->{Dashing[{.02,.02}]}],
PistolPolyhex[o,0,-1,LineStyle->{Dashing[{.02,.02}]}],
PointSize[.04],Point[o]
},AspectRatio->Automatic,PlotRange->All]]

Planar

Show[Graphics[{
Polyhex[1,1],
Polyhex[2,1,{0,-4}],
Polyhex[3,1,{0,-7}],Polyhex[3,2,{5,-7}],Polyhex[3,3,{11,-8}],
BeePolyhex[{0,-13}],BarPolyhex[4,{6,-14}],PistolPolyhex[{13,-13}],PropellerPolyhex[{18,-13.5}],WormPolyhex[{24,-13.5}],ArchPolyhex[{30,-11.5}],WavePolyhex[{36,-12.5}]
}
],AspectRatio->Automatic]

Hollow

SetOptions[Polyhex,LineStyle->None]

Show[Graphics[{
Polyhex[1,1],
Polyhex[2,1,{0,-4}],
Polyhex[3,1,{0,-7}],Polyhex[3,2,{5,-7}],Polyhex[3,3,{11,-8}],
BeePolyhex[{0,-13}],BarPolyhex[4,{6,-14}],PistolPolyhex[{13,-13}],PropellerPolyhex[{18,-13.5}],WormPolyhex[{24,-13.5}],ArchPolyhex[{30,-11.5}],WavePolyhex[{36,-12.5}]
}
],AspectRatio->Automatic]

GraphData

GraphDataString

TetrahexNames={"bee","bar","pistol","propeller","worm","arch","wave"};
TetrahexStandardNames={"Bee","Bar","Pistol","Propeller","Worm","Arch","Wave"};

Do[Print[
GraphDataString[
PolyformGraph[Polyhexes[n][[k]]],
"StandardName"->{"Polyhex",{n,k}},
"AlternateStandardNames"->If[n==4,(#<>"Polyhex")&/@TetrahexStandardNames[[k]],{}],
"AlternateNames"->If[n==4,(#<>" polyhex")&/@TetrahexNames[[k]],{}],
"Name"->ToString[n]<>"-polyhex "<>ToString[k],
"Classes"->{"Polyhex","UnitDistance"},
"NotationRules"->{"Polyhex"->{n,k}},
TimeConstraint->60
]],{n,4},{k,Length[Polyhexes[n]]}]

Faces

CycleFromEdgeList[e_List]:=Module[{indx,v=Union[Flatten[e]]},
indx=Range[Length[v]];
First[HamiltonianCycles[FromUnorderedPairs[e/.Thread[v->indx]]]/.Thread[indx->v]]
]

CyclesLength[g_,n_]:=Quiet[DeleteCases[CycleFromEdgeList/@Select[Subsets[GraphData[g,"EdgeIndices"],{n}],Length[Union[Join@@#]]==n&],_First]]

{#,CyclesLength[#,6]}&/@GraphData["Polyhex"]//Column