A284373 - OEIS

%I #15 Mar 26 2017 11:55:50

%S 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,

%T 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,

%U 10,7,4,1,7,5,4,2,1,5,4,3,2,1,7,6,4,3,1,15,12,9,6

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

%H Luca Petrone, <a href="/A284373/b284373.txt">Table of n, a(n) for n = 1..386</a>

%H Eric Weisstein's World of Mathematics, <a href="http://mathworld.wolfram.com/Polyhex.html">Polyhex</a>.

%t polyhexeQ[{{_Integer, _Integer} .. }] := True

%t polyhexeQ[_] := False

%t rot[p_?polyhexeQ] := {-Last[#], Plus @@ #} & /@ p

%t ref[p_?polyhexeQ] := {-Plus @@ #, Last[#]} & /@ p

%t cyclic[p_] := Module[{i = p, ans = {p}},

%t   While[(i = rot[i]) != p, AppendTo[ans, i]]; ans]

%t dihedral[p_?polyhexeQ] := Flatten[{#, ref[#]} & /@ cyclic[p], 1]

%t canonical[p_?polyhexeQ] :=

%t Sort[Map[(# - {Min[First /@ p], Min[Last /@ p]}) &, p]] allPieces[p_] := Union[canonical /@ dihedral[p]]

%t polyhexes[1] := {{{0, 0}}}

%t polyhexes[n_] :=

%t polyhexes[n] =

%t   Module[{f, a, b, fig, ans = {}},

%t    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]];

%t    fig = Partition[Partition[Flatten[fig], 2], n];

%t    f = Union[canonical /@ Select[Union /@ fig, Length[#] == n &]];

%t    While[f != {},

%t     ans = {ans, First[f]};

%t     f = Complement[f, allPieces[First[f]]]];

%t    Partition[Partition[Flatten[ans], 2], n]]

%t coord[z_] := {Re[#], Im[#]} & /@ z

%t 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]

%t A = {};

%t n = 1;

%t While[n <= 386,

%t polyhexes[n];

%t 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]]];

%t A = Flatten[{A, Length[#]}] & [Length[Tally[Flatten[atoms[#], 2]]] &  /@ polyhexes[n]];

%t Print[A[[n]]];

%t n++;]

%t (* _Luca Petrone_, Mar 25 2017, based on a program by Jaime Rangel-Mondragón *)

%Y Cf. A121149.

%K nonn

%O 1,6

%A _Luca Petrone_, Mar 25 2017