Polyiamond

Author

Eric W. Weisstein
April 29, 2018

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

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

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

Graphs

Sort[{"Polyiamond"/.GraphData[#,"NotationRules"],#}&/@GraphData["Polyiamond"]]

polyiamondgraphs=SplitBy[DeleteCases[%,{_Missing,_}],#[[1,1]]&]

GraphicsGrid[Flatten[Partition[#,UpTo[6]]&/@Map[Show[GraphData[#]//StyleGraphs[#,VertexSize->{"Scaled",.1}]&,PlotLabel->Style[GraphData[#,"Name"],Directive[Italic,FontFamily->"Times"]]]&,polyiamondgraphs[[All,All,2]],{2}],1],Dividers->All,ImageSize->600]

Array

GraphicsArray[Map[ShowGraph[PolyformGraph[#]]&,Polyiamonds/@Range[6],{2}]]

GraphData["Polyiamond"]

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

{n,k}={6,12};
GraphData[g={"Polyiamond",{n,k}},{"#","StandardNames"}]

GraphData[g,"AllImages"]

ShowGraph[p=PolyformGraph[Polyiamonds[n][[k]]]]

ToCommonEdges[p,Graph[g]]

GraphData

GraphDataString

HexiamondNames={{"6-bar","6-rhomboid"},{"crook","club"},{"crown"},{"sphinx"},{"snake"},{"yacht"},{"chevron","bat"},{"signpost","pistol"},{"lobster"},{"hook","shoe"},{"hexagon"},{"butterfly"}};

HexiamondStandardNames={{"SixBar","SixRhomboid"},{"Crook","Club"},{"Crown"},{"Sphinx"},{"Snake"},{"Yacht"},{"Chevron","Bat"},{"Signpost","Pistol"},{"Lobster"},{"Hook","Shoe"},{"Hexagon"},{"Butterfly"}};

Do[Print[
GraphDataString[
PolyiamondGraph[Polyiamonds[n][[k]]],
"StandardName"->{"Polyiamond",{n,k}},
"AlternateStandardNames"->If[n==6,(#<>"Hexiamond")&/@HexiamondStandardNames[[k]],{}],
"AlternateNames"->If[n==6,(#<>" hexiamond")&/@HexiamondNames[[k]],{}],
"Name"->ToString[n]<>"-polyiamond "<>ToString[k],
"Classes"->{"Polyiamond"},
TimeConstraint->60
]],{n,6},{k,Length[polyiamonds[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[#,3]}&/@GraphData["Polyiamond"]//Column