cp's OEIS Frontend

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

%I A284373 #16 Feb 16 2025 08:33:43
%S A284373 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 A284373 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 A284373 10,7,4,1,7,5,4,2,1,5,4,3,2,1,7,6,4,3,1,15,12,9,6
%N A284373 Number of distinct planar connected n-polyhexes having a minimal number of vertices.
%H A284373 Luca Petrone, <a href="/A284373/b284373.txt">Table of n, a(n) for n = 1..386</a>
%H A284373 Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/Polyhex.html">Polyhex</a>.
%t A284373 polyhexeQ[{{_Integer, _Integer} .. }] := True
%t A284373 polyhexeQ[_] := False
%t A284373 rot[p_?polyhexeQ] := {-Last[#], Plus @@ #} & /@ p
%t A284373 ref[p_?polyhexeQ] := {-Plus @@ #, Last[#]} & /@ p
%t A284373 cyclic[p_] := Module[{i = p, ans = {p}},
%t A284373   While[(i = rot[i]) != p, AppendTo[ans, i]]; ans]
%t A284373 dihedral[p_?polyhexeQ] := Flatten[{#, ref[#]} & /@ cyclic[p], 1]
%t A284373 canonical[p_?polyhexeQ] :=
%t A284373 Sort[Map[(# - {Min[First /@ p], Min[Last /@ p]}) &, p]] allPieces[p_] := Union[canonical /@ dihedral[p]]
%t A284373 polyhexes[1] := {{{0, 0}}}
%t A284373 polyhexes[n_] :=
%t A284373 polyhexes[n] =
%t A284373   Module[{f, a, b, fig, ans = {}},
%t A284373    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 A284373    fig = Partition[Partition[Flatten[fig], 2], n];
%t A284373    f = Union[canonical /@ Select[Union /@ fig, Length[#] == n &]];
%t A284373    While[f != {},
%t A284373     ans = {ans, First[f]};
%t A284373     f = Complement[f, allPieces[First[f]]]];
%t A284373    Partition[Partition[Flatten[ans], 2], n]]
%t A284373 coord[z_] := {Re[#], Im[#]} & /@ z
%t A284373 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 A284373 A = {};
%t A284373 n = 1;
%t A284373 While[n <= 386,
%t A284373 polyhexes[n];
%t A284373 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 A284373 A = Flatten[{A, Length[#]}] & [Length[Tally[Flatten[atoms[#], 2]]] &  /@ polyhexes[n]];
%t A284373 Print[A[[n]]];
%t A284373 n++;]
%t A284373 (* _Luca Petrone_, Mar 25 2017, based on a program by Jaime Rangel-Mondragón *)
%Y A284373 Cf. A121149.
%K A284373 nonn
%O A284373 1,6
%A A284373 _Luca Petrone_, Mar 25 2017