OFFSET
1,6
LINKS
Luca Petrone, Table of n, a(n) for n = 1..386
Eric Weisstein's World of Mathematics, Polyhex.
MATHEMATICA
polyhexeQ[{{_Integer, _Integer} .. }] := True
polyhexeQ[_] := False
rot[p_?polyhexeQ] := {-Last[#], Plus @@ #} & /@ p
ref[p_?polyhexeQ] := {-Plus @@ #, Last[#]} & /@ p
cyclic[p_] := Module[{i = p, ans = {p}},
While[(i = rot[i]) != p, AppendTo[ans, i]]; ans]
dihedral[p_?polyhexeQ] := Flatten[{#, ref[#]} & /@ cyclic[p], 1]
canonical[p_?polyhexeQ] :=
Sort[Map[(# - {Min[First /@ p], Min[Last /@ p]}) &, p]] allPieces[p_] := Union[canonical /@ dihedral[p]]
polyhexes[1] := {{{0, 0}}}
polyhexes[n_] :=
polyhexes[n] =
Module[{f, a, b, fig, ans = {}},
fig = Map[(f = #; Map[({a, b} = #; {f, {a - 1, b - 1}, f, {a + 1, b - 2}, f, {a + 2, b - 1}, f, {a + 1, b + 1}, f, {a - 1, b + 2}, f, {a - 2, b + 1}}) &, f]) &, polyhexes[n - 1]];
fig = Partition[Partition[Flatten[fig], 2], n];
f = Union[canonical /@ Select[Union /@ fig, Length[#] == n &]];
While[f != {},
ans = {ans, First[f]};
f = Complement[f, allPieces[First[f]]]];
Partition[Partition[Flatten[ans], 2], n]]
coord[z_] := {Re[#], Im[#]} & /@ z
atoms[p_?polyhexeQ] := Module[{a, b, v, t, u = E^(Pi I/3)}, {{a, b} = #; v = a + b u; coord[{v, v + 1, v + 1 + u, v + 2 u, v + 2 u - 1, v + u - 1}]} & /@ p]
A = {};
n = 1;
While[n <= 386,
polyhexes[n];
polyhexes[n] = Part[polyhexes[n], #] & /@ Ordering[Length[Tally[Flatten[atoms[#], 2]]] & /@ polyhexes[n], BinCounts[#, {Min[#], Min[#] + 1}][[1]] & [Length[Tally[Flatten[atoms[#], 2]]] & /@ polyhexes[n]]];
A = Flatten[{A, Length[#]}] & [Length[Tally[Flatten[atoms[#], 2]]] & /@ polyhexes[n]];
Print[A[[n]]];
n++; ]
(* Luca Petrone, Mar 25 2017, based on a program by Jaime Rangel-Mondragón *)
CROSSREFS
KEYWORD
nonn
AUTHOR
Luca Petrone, Mar 25 2017
STATUS
approved