login
A284373
Number of distinct planar connected n-polyhexes having a minimal number of vertices.
4
1, 1, 1, 1, 1, 3, 1, 1, 4, 1, 2, 1, 2, 1, 3, 1, 6, 3, 1, 1, 1, 7, 4, 1, 4, 2, 1, 3, 2, 1, 4, 3, 1, 9, 6, 3, 1, 2, 1, 1, 10, 7, 4, 1, 5, 4, 2, 1, 4, 3, 2, 1, 6, 4, 3, 1, 12, 9, 6, 3, 1, 2, 2, 1, 1, 13, 10, 7, 4, 1, 7, 5, 4, 2, 1, 5, 4, 3, 2, 1, 7, 6, 4, 3, 1, 15, 12, 9, 6
OFFSET
1,6
LINKS
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
Cf. A121149.
Sequence in context: A084795 A364097 A030184 * A104610 A138684 A132442
KEYWORD
nonn
AUTHOR
Luca Petrone, Mar 25 2017
STATUS
approved