A326331 Number of simple graphs covering the vertices {1..n} whose nesting edges are connected.
1, 0, 1, 0, 1, 14, 539
Offset: 0
Links
- Gus Wiseman, The a(5) = 14 simple nesting-connected covering graphs.
This is a front-end for the Online Encyclopedia of Integer Sequences, made by Christian Perfect. The idea is to provide OEIS entries in non-ancient HTML, and then to think about how they're presented visually. The source code is on GitHub.
G.f.: A(x) = 1 + x^4 + 5*x^6 + 14*x^7 + 62*x^8 + 298*x^9 + 1494*x^10 + 8140*x^11 + 47146*x^12 +...
n = 30; F = x*Sum[BellB[k] x^k, {k, 0, n}] + O[x]^n; B = ComposeSeries[1/( InverseSeries[F, w]/w)-1, x/(1+x) + O[x]^n]; A = (B-x)/(1+x); Join[{1}, CoefficientList[A, x] // Rest] (* Jean-François Alcover, Feb 23 2016, adapted from K. J. Dykema's code *) intvQ[set_]:=Or[set=={},Sort[set]==Range[Min@@set,Max@@set]]; sps[{}]:={{}};sps[set:{i_,_}]:=Join@@Function[s,Prepend[#,s]&/@sps[Complement[set,s]]]/@Cases[Subsets[set],{i,_}]; Table[Length[Select[sps[Range[n]],And[!MatchQ[#,{_,{_,x_,y_,_},_}/;x+1==y],#=={}||And@@Not/@intvQ/@Union@@@Subsets[#,{1,Length[#]-1}],#=={}||Position[#,1][[1,1]]!=Position[#,n][[1,1]]]&]],{n,0,10}] (* Gus Wiseman, Feb 23 2019 *)
lista(nn) = {c = x/serreverse(x*serlaplace(exp(exp(x+x*O(x^nn)) -1))); b = subst(c, x, x/(1+x)+ O(x^nn)); vb = Vec(b-1); va = vector(#vb); va[1] = 0; va[2] = 0; for (k=3, #va, va[k] = vb[k] - va[k-1]; ); concat(1, va); }
{a(n) = my(A=1+x^3); for(i=1, n, A = sum(m=0, n, x^m/prod(k=1, m, (1+x)^2*A - k*x +x*O(x^n)) )/(1+x) ); polcoeff( A, n)} for(n=0,35,print1(a(n),", ")) \\ Paul D. Hanna, Mar 07 2016
{Stirling2(n, k) = n!*polcoeff(((exp(x+x*O(x^n)) - 1)^k)/k!, n)} {Bell(n) = sum(k=0,n, Stirling2(n, k) )} {a(n) = my(A=1+x); for(i=1, n, A = sum(m=0, n, Bell(m)*x^m/((1+x +x*O(x^n))^(2*m+1)*A^m)) ); polcoeff(A, n)} for(n=0,25,print1(a(n),", ")) \\ Paul D. Hanna, Mar 07 2016
From _Gus Wiseman_, Feb 27 2019: (Start) Triangle begins: 1 0 1 0 1 2 0 4 6 5 0 27 36 28 14 0 248 310 225 120 42 0 2830 3396 2332 1210 495 132 0 38232 44604 29302 14560 6006 2002 429 0 593859 678696 430200 204540 81900 28392 8008 1430 Row n = 3 counts the following chord diagrams (see link for pictures): {{1,3},{2,5},{4,6}} {{1,2},{3,5},{4,6}} {{1,2},{3,4},{5,6}} {{1,4},{2,5},{3,6}} {{1,3},{2,4},{5,6}} {{1,2},{3,6},{4,5}} {{1,4},{2,6},{3,5}} {{1,3},{2,6},{4,5}} {{1,4},{2,3},{5,6}} {{1,5},{2,4},{3,6}} {{1,5},{2,3},{4,6}} {{1,6},{2,3},{4,5}} {{1,5},{2,6},{3,4}} {{1,6},{2,5},{3,4}} {{1,6},{2,4},{3,5}} (End)
Triangle begins: 1 0 1 0 1 0 0 1 0 0 0 1 1 0 0 0 1 5 0 0 0 0 1 16 4 0 0 0 0 1 42 42 0 0 0 0 0 1 99 258 27 0 0 0 0 0 1 219 1222 465 0 0 0 0 0 Row n = 6 counts the following set partitions: {{123456}} {{1235}{46}} {{13}{25}{46}} {{124}{356}} {{14}{25}{36}} {{1245}{36}} {{14}{26}{35}} {{1246}{35}} {{15}{24}{36}} {{125}{346}} {{13}{2456}} {{134}{256}} {{1345}{26}} {{1346}{25}} {{135}{246}} {{1356}{24}} {{136}{245}} {{14}{2356}} {{145}{236}} {{146}{235}} {{15}{2346}}
croXQ[stn_]:=MatchQ[stn,{_,{_,x_,_,y_,_},_,{_,z_,_,t_,_},_}/;x0]&]},If[c=={},s,csm[Sort[Append[Delete[s,List/@c[[1]]],Union@@s[[c[[1]]]]]]]]]; crosscmpts[stn_]:=csm[Union[Subsets[stn,{1}],Select[Subsets[stn,{2}],croXQ]]]; sps[{}]:={{}};sps[set:{i_,_}]:=Join@@Function[s,Prepend[#,s]&/@sps[Complement[set,s]]]/@Cases[Subsets[set],{i,_}]; Table[Length[Select[sps[Range[n]],Length[crosscmpts[#]]<=1&&Length[#]==k&]],{n,0,6},{k,0,n}]
The a(0) = 1 through a(6) = 21 set partitions: {} {1} {12} {123} {1234} {12345} {123456} {14}{23} {125}{34} {1236}{45} {134}{25} {1245}{36} {14}{235} {125}{346} {145}{23} {1256}{34} {15}{234} {126}{345} {134}{256} {1345}{26} {1346}{25} {136}{245} {14}{2356} {145}{236} {1456}{23} {146}{235} {15}{2346} {156}{234} {16}{2345} {15}{26}{34} {16}{23}{45} {16}{24}{35} {16}{25}{34}
nesXQ[stn_]:=MatchQ[stn,{_,{_,x_,y_,_},_,{_,z_,t_,_},_}/;x0]&]},If[c=={},s,csm[Sort[Append[Delete[s,List/@c[[1]]],Union@@s[[c[[1]]]]]]]]]; nestcmpts[stn_]:=csm[Union[List/@stn,Select[Subsets[stn,{2}],nesXQ]]]; sps[{}]:={{}};sps[set:{i_,_}]:=Join@@Function[s,Prepend[#,s]&/@sps[Complement[set,s]]]/@Cases[Subsets[set],{i,_}]; Table[Length[Select[sps[Range[n]],Length[nestcmpts[#]]<=1&]],{n,0,5}]
The a(0) = 1 through a(6) = 24 set partitions: {} {1} {12} {123} {1234} {12345} {123456} {14}{23} {125}{34} {1236}{45} {134}{25} {1245}{36} {135}{24} {1246}{35} {14}{235} {125}{346} {145}{23} {1256}{34} {15}{234} {126}{345} {134}{256} {1345}{26} {1346}{25} {135}{246} {1356}{24} {136}{245} {14}{2356} {145}{236} {1456}{23} {146}{235} {15}{2346} {156}{234} {16}{2345} {15}{26}{34} {16}{23}{45} {16}{24}{35} {16}{25}{34}
capXQ[stn_]:=MatchQ[stn,{_,{_,x_,_,y_,_},_,{_,z_,_,t_,_},_}/;x0]&]},If[c=={},s,csm[Sort[Append[Delete[s,List/@c[[1]]],Union@@s[[c[[1]]]]]]]]]; captcmpts[stn_]:=csm[Union[List/@stn,Select[Subsets[stn,{2}],capXQ]]]; sps[{}]:={{}};sps[set:{i_,_}]:=Join@@Function[s,Prepend[#,s]&/@sps[Complement[set,s]]]/@Cases[Subsets[set],{i,_}]; Table[Length[Select[sps[Range[n]],Length[captcmpts[#]]<=1&]],{n,0,6}]
wknXQ[eds_]:=MatchQ[eds,{_,{x_,y_},_,{z_,t_},_}/;(x<=z&&y>=t)||(x>=z&&y<=t)]; csm[s_]:=With[{c=Select[Tuples[Range[Length[s]],2],And[OrderedQ[#],UnsameQ@@#,Length[Intersection@@s[[#]]]>0]&]},If[c=={},s,csm[Sort[Append[Delete[s,List/@c[[1]]],Union@@s[[c[[1]]]]]]]]]; Table[Length[Select[Subsets[Subsets[Range[n],{2}]],Length[csm[Union[List/@#,Select[Subsets[#,{2}],wknXQ]]]]<=1&]],{n,0,5}]
O.g.f.: A(x) = 1 + x + 3*x^2 + 12*x^3 + 56*x^4 + 288*x^5 + 1586*x^6 +... The o.g.f. satisfies: (1) A(x) = 1 + x*A(x) + 2*x^2*A(x)^2 + 5*x^3*A(x)^3 + 15*x^4*A(x)^4 + 52*x^5*A(x)^5 + 203*x^6*A(x)^6 +...+ A000110(n)*x^n*A(x)^n +... (2) A(x) = 1 + x*A(x)/(1-x*A(x)) + x^2*A(x)^2/((1-x*A(x))*(1-2*x*A(x))) + x^3*A(x)^3/((1-x*A(x))*(1-2*x*A(x))*(1-3*x*A(x))) + x^4*A(x)^4/((1-x*A(x))*(1-2*x*A(x))*(1-3*x*A(x))*(1-4*x*A(x))) +...
{a(n)=if(n<0, 0, polcoeff( 1/x*serreverse(x/serlaplace(exp(exp(x+x*O(x^n))-1))), n))} for(n=0,30,print1(a(n),", "))
{a(n)=local(A=1+x); for(i=1, n, A=sum(m=0, n, x^m*A^m/prod(k=1, m,1-k*x*A +x*O(x^n)) )); polcoeff(A, n)} for(n=0,30,print1(a(n), ", "))
G.f.: A(x) = 1 + x + x^4 + x^5 + 5*x^6 + 19*x^7 + 76*x^8 + 360*x^9 + 1792*x^10 +...
n = 30; F = x*Sum[BellB[k] x^k, {k, 0, n}] + O[x]^n; B = ComposeSeries[1/( InverseSeries[F, w] /w)-1, x/(1+x) + O[x]^n]; CoefficientList[B, x] // Rest (* Jean-François Alcover, Feb 16 2016, adapted from K. J. Dykema's code *) sps[{}]:={{}};sps[set:{i_,_}]:=Join@@Function[s,Prepend[#,s]&/@sps[Complement[set,s]]]/@Cases[Subsets[set],{i,_}]; intvQ[set_]:=Or[set=={},Sort[set]==Range[Min@@set,Max@@set]]; Table[Length[Select[sps[Range[n]],And[!MatchQ[#,{_,{_,x_,y_,_},_}/;x+1==y],#=={}||And@@Not/@intvQ/@Union@@@Subsets[#,{1,Length[#]-1}]]&]],{n,0,10}] (* Gus Wiseman, Feb 23 2019 *)
lista(nn) = {c = x/serreverse(x*serlaplace(exp(exp(x+x*O(x^nn)) -1))); b = subst(c, x, x/(1+x) + O(x^nn)); Vec(b);}
{a(n) = my(A=1+x); for(i=1, n, A = sum(m=0, n, x^m/prod(k=1, m, (1+x)*A - k*x +x*O(x^n)) )); polcoeff(A, n)} for(n=0,25,print1(a(n),", ")) \\ Paul D. Hanna, Mar 07 2016
{Stirling2(n, k) = n!*polcoeff(((exp(x+x*O(x^n)) - 1)^k)/k!, n)} {Bell(n) = sum(k=0,n, Stirling2(n, k) )} {a(n) = my(A=1+x); for(i=1, n, A = sum(m=0, n, Bell(m)*x^m/((1+x)*A +x*O(x^n))^m) ); polcoeff(A, n)} for(n=0,25,print1(a(n),", ")) \\ Paul D. Hanna, Mar 07 2016
The a(36) = 10 crossing multiset partitions of {1,1,2,2,3,4}: {{1,3},{1,2,2,4}} {{2,4},{1,1,2,3}} {{1,1,3},{2,2,4}} {{1,2,3},{1,2,4}} {{1},{1,3},{2,2,4}} {{1},{2,4},{1,2,3}} {{2},{1,3},{1,2,4}} {{2},{1,1,3},{2,4}} {{1,2},{1,3},{2,4}} {{1},{2},{1,3},{2,4}}
Comments