A284373 Number of distinct planar connected n-polyhexes having a minimal number of vertices.

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

Author

Luca Petrone, Mar 25 2017

Keywords

• nonn

Links

• Luca Petrone, Table of n, a(n) for n = 1..386
• Eric Weisstein's World of Mathematics, Polyhex.

Crossrefs

Cf. A121149.

Programs

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 *)