A046650 Number of sensed nonseparable (2-connected) planar maps with n edges and a distinguished face of size 2.

1, 1, 2, 4, 14, 49, 216, 984, 4862, 24739, 130338, 701584, 3852744, 21489836, 121525520, 695307888, 4019381790, 23446201495, 137875564710, 816646459860, 4868578092510, 29196022525905, 176022392938080, 1066433501134560, 6490009570139784, 39659537885087124, 243278423033093336, 1497584057249141728, 9249144367260811824

Offset: 2

Author

N. J. A. Sloane

Keywords

• nonn
• easy

Comments

From R. J. Mathar, Apr 13 2019: (Start)

Table III with row sums A000087 is (A046653 row-reversed):

1;

1, 1;

2, 1, 1;

4, 3, 2, 1;

14, 12, 8, 2, 1;

49, 43, 30, 12, 3, 1;

216, 189, 134, 63, 22, 3, 1;

984, 888, 608, 323, 133, 31, 4, 1;

4862, 4332, 2988, 1671, 759, 238, 48, 4, 1;

...

(End)

Equivalently, by duality, a(n) is the number of sensed nonseparable planar maps with n edges and a distinguished vertex of degree 2. - Andrew Howroyd, Jan 19 2025

Links

• Andrew Howroyd, Table of n, a(n) for n = 2..500
• W. G. Brown, Enumeration of non-separable planar maps, Canad. J. Math., 15 (1963), 526-545.

Crossrefs

Main diagonal of A046653.

Cf. A000087 (distinguished face of any size).

Programs

Maple

B1nm := proc(n,m) # eq (4.15)
    local j ;
    if m>=2 and n>= m  then
        add((3*m-2*j-1)*(2*j-m)*(j-2)!*(3*n-j-m-1)!/(n-j)!/(j-m)!/(j-m+1)!/(2*m-j)!,j=m..min(n,2*m) ) ;
        %*m/(2*n-m)! ;
    else
        0 ;
    end if;
end proc:
B2wj := proc(w,j) # eq (8.21)
    local k ;
    if  w >= j and j>=1 and w >= 1 then
        add((2*k-j+1)*(k-1)!*(3*w-k-j)!/(k-j+1)!/(k-j)!/(2*j-k-1)!/(w-k)!,k=j..min(w,2*j-1) ) ;
        %*j/(2*w-j+1)! ;
    else
        0;
    end if;
end proc:
Brwj := proc(r,w,j) # eq. (8.21)
    local k ;
    if  w >= j and j>=1 and w>=1 and r > 1 then
        add((2*k-j)*(k-1)!*(3*w-k-j-1)!/((k-j)!)^2/(2*j-k)!/(w-k)!,k=j..min(w,2*j) ) ;
        %*j/(2*w-j)! ;
    else
        0 ;
    end if;
end proc:
Brnm := proc(r,n,m)
    if r = 1 then
        B1nm(n,m) ;
    elif r = 2 and type(n,'odd') and type (m,'even') then
        B2wj((n-1)/2,m/2) ;
    elif modp(n,r) <> 0 or modp(m,r) <> 0 then
        0;
    else
        Brwj(r,n/r,m/r) ;
    end if;
end proc:
L := proc(n,m) # eq. (6.7)
    add(numtheory[phi](s)*Brnm(s,n,m),s=numtheory[divisors](m)) ;
    %/m ;
end proc:
seq(L(n,2),n=2..40) ; # R. J. Mathar, Apr 13 2019

Mathematica

B1nm[n_, m_] := If[m >= 2 && n >= m, Sum[(3m - 2j - 1)(2j - m)(j - 2)! (3n - j - m - 1)!/(n - j)!/(j - m)!/(j - m + 1)!/(2m - j)!, {j, m, Min[n, 2m] }] m/(2n - m)!, 0];
B2wj[w_, j_]  := If[w >= j && j >= 1 && w >= 1, Sum[(2k - j + 1)(k - 1)! (3 w - k - j)!/(k - j + 1)!/(k - j)!/(2j - k - 1)!/(w - k)!, {k, j, Min[w, 2 j - 1] }] j/(2w - j + 1)!, 0];
Brwj[r_, w_, j_] := If[w >= j && j >= 1 && w >= 1 && r > 1 , Sum[(2k - j)(k - 1)! (3w - k - j - 1)!/((k - j)!)^2/(2j - k)!/(w - k)!, {k, j, Min[w, 2j]}] j/(2w - j)!, 0];
Brnm[r_, n_, m_] := Which[r == 1, B1nm[n, m], r == 2 && OddQ[n] && EvenQ[m], B2wj[(n - 1)/2, m/2], Mod[n, r] != 0 || Mod[m, r] != 0, 0, True, Brwj[r, n/r, m/r]];
L[n_, m_] := Sum[EulerPhi[s] Brnm[s, n, m], {s, Divisors[m]}]/m;
Table[L[n, 2], {n, 2, 30}] // Flatten (* Jean-François Alcover, Apr 05 2020, after R. J. Mathar *)

PARI

a(n) = n-=2; if(n<=0, n==0, (n*binomial(3*n\2, n\2) + binomial(3*n, 2*n+1))/(n*(n+1)) ) \\ Andrew Howroyd, Jan 19 2025

Formula

Reference gives generating functions.

a(n+2) = binomial(floor(3*n/2), floor(n/2))/(n+1) + binomial(3*n, 2*n+1)/(n*(n+1)) for n > 0. - Andrew Howroyd, Jan 19 2025

Extensions

More terms from R. J. Mathar, Apr 13 2019

Name clarified by Andrew Howroyd, Jan 19 2025