A100092 Number of n-celled polyominoes with minimum perimeter.

1, 1, 1, 2, 1, 1, 1, 4, 2, 1, 6, 1, 1, 11, 4, 2, 1, 11, 6, 1, 1, 28, 11, 4, 2, 1, 35, 11, 6, 1, 1, 65, 28, 11, 4, 2, 1, 73, 35, 11, 6, 1, 1, 147, 65, 28, 11, 4, 2, 1, 182, 73, 35, 11, 6, 1, 1, 321, 147, 65, 28, 11, 4, 2, 1, 374, 182, 73, 35, 11, 6, 1, 1, 678, 321, 147, 65, 28, 11, 4, 2, 1

Offset

0,4

Comments

An n-celled polyomino has minimum perimeter A027709(n) = 2*ceiling(2*sqrt(n)). - Dmitry Kamenetsky, Feb 27 2017

Links

Joerg Arndt, Table of n, a(n) for n = 0..144

Sascha Kurz, Counting polyominoes with minimum perimeter, submitted to Ars Combinatoria

Sascha Kurz, Counting polyominoes with minimum perimeter, arXiv:math/0506428 [math.CO], 2005-2015.

Kival Ngaokrajang, Illustration of initial terms ["A275966" should be changed to "A100092"]

Piotr Pikul, Tightest Arrangements of All Different Nets of a Cube, Math. Mag. (2024).

Formula

It seems that for m >= 1, 0 <= k <= m-1, we have a(m^2-k) = a(k^2+k+1) = A100094(k) and a(m^2+m-k) = a((k+1)^2+1) = A100093(k+1). If this is true, then a(n) = 1 if and only if n is of the form m^2, m^2 + m - 1 or m^2 + m. - Jianing Song, Aug 10 2021

Example

a(9) = 1 because the 3 X 3 square is the unique polyomino with minimum perimeter.

Mathematica

(* Warning: some local maxima are precomputed from A100094. *)
A100094 = {2, 4, 11, 28, 65, 147, 321, 678, 1382, 2738, 5289 (* extend if needed *)};
amax = Last[A100094]; nmax = 144;
S[x_] := 1 + Sum[ x^(2*n + 1)*Product[ (x^(2*k - 1) - 1), {k, n}], {n, 0, nmax}] + O[x]^nmax;
A[x_] = Product[1/(1 - x^k), {k, 1, nmax}] + O[x]^nmax // Normal;
R[x_] := 1/4 (A[x]^4 + 3A[x^2]^2) + O[x]^nmax;
Q[x_] := 1/8 (A[x]^4 + 3A[x^2]^2 + 2S[x]^2 A[x^2] + 2A[x^4]) + O[x]^nmax;
r[k_] := SeriesCoefficient[R[x], {x, 0, k}];
q[k_] := SeriesCoefficient[Q[x], {x, 0, k}];
e[n_] := Module[{s, w}, s = Floor[Sqrt[n]]; a94Q[k_] := IntegerQ[w = Sqrt[k + n] - k] && w > 0; Which[Evaluate[Sequence @@ Flatten[Table[{a94Q[k], A100094[[k]]}, {k, 3, Length[A100094]}]]], n == s^2, 1, IntegerQ[t = n - s^2] && 0 < t < s, Sum[r[s - c - c^2 - t], {c, 0, Floor[-1/2 + (1/2)* Sqrt[1 + 4 s - 4 t]]}], n == s^2 + s, 1, IntegerQ[t = n - s^2 - s] && 0 < t <= s, q[s + 1 - t] + Sum[r[s + 1 - c^2 - t], {c, 1, Floor[Sqrt[s + 1 - t]]}], True, Print["error n = ", n]]];
Select[Table[e[n], {n, 0, nmax}], # <= amax&] (* Jean-François Alcover, Jul 20 2018 *)

Crossrefs

Cf. A027709, A100093, A100094, left nonzero term in row n of A342243.

Sequence in context: A252733 A181876 A131505 * A131508 A305502 A308211

Adjacent sequences: A100089 A100090 A100091 * A100093 A100094 A100095

Keyword

nonn

Author

Sascha Kurz, Nov 03 2004

Extensions

Offset changed to 0 by N. J. A. Sloane, Mar 19 2017

Status

approved