A003436
Number of inequivalent labeled Hamiltonian circuits on n-octahedron. Interlacing chords joining 2n points on circle.
Original entry on oeis.org
1, 0, 1, 4, 31, 293, 3326, 44189, 673471, 11588884, 222304897, 4704612119, 108897613826, 2737023412199, 74236203425281, 2161288643251828, 67228358271588991, 2225173863019549229, 78087247031912850686, 2896042595237791161749, 113184512236563589997407
Offset: 0
- N. J. A. Sloane and Simon Plouffe, The Encyclopedia of Integer Sequences, Academic Press, 1995 (includes this sequence).
- Vincenzo Librandi, Table of n, a(n) for n = 0..200
- F. R. Bernhart & N. J. A. Sloane, Emails, April-May 1994
- Kenneth P. Bogart and Peter G. Doyle, Nonsexist solution of the menage problem, Amer. Math. Monthly 93:7 (1986), 514-519.
- Robert Cori and G. Hetyei, Counting partitions of a fixed genus, arXiv preprint arXiv:1710.09992 [math.CO], 2017.
- M. Hazewinkel and V. V. Kalashnikov, Counting Interlacing Pairs on the Circle, CWI report AM-R9508 (1995)
- Evgeniy Krasko, Igor Labutin, and Alexander Omelchenko, Enumeration of Labelled and Unlabelled Hamiltonian Cycles in Complete k-partite Graphs, arXiv:1709.03218 [math.CO], 2017.
- E. Krasko and A. Omelchenko, Enumeration of Chord Diagrams without Loops and Parallel Chords, arXiv preprint arXiv:1601.05073 [math.CO], 2016.
- E. Krasko and A. Omelchenko, Enumeration of Chord Diagrams without Loops and Parallel Chords, The Electronic Journal of Combinatorics, 24(3) (2017), #P3.43.
- D. Singmaster, Hamiltonian circuits on the n-dimensional octahedron, J. Combinatorial Theory Ser. B 19 (1975), no. 1, 1-4.
- Gus Wiseman, The a(5) = 293 interlacing chord diagrams.
Cf.
A000179,
A000296,
A000699,
A001147,
A005493,
A170941,
A190823,
A278990,
A306386,
A306419,
A322402,
A324011,
A324172,
A324173.
-
A003436 := proc(n) local k;
if n = 0 then 1
elif n = 1 then 0
else add( (-1)^k*binomial(n,k)*2*n/(2*n-k)*2^k*(2*n-k)!/2^n/n!,k=0..n) ;
end if;
end proc: # R. J. Mathar, Dec 11 2013
A003436 := n-> `if`(n<2, 1-n, (-1)^n*2*hypergeom([n, -n], [], 1/2)):
seq(simplify(A003436(n)), n=0..18); # Peter Luschny, Nov 10 2016
-
a[n_] := (2*n-1)!! * Hypergeometric1F1[-n, 1-2*n, -2]; a[1] = 0;
Table[a[n], {n, 0, 19}] (* Jean-François Alcover, Apr 05 2013 *)
twounifll[{}]:={{}};twounifll[set:{i_,_}]:=Join@@Function[s,Prepend[#,s]&/@twounifll[Complement[set,s]]]/@Table[{i,j},{j,If[i==1,Select[set,2<#i+1&]]}];
Table[Length[twounifll[Range[n]]],{n,0,14,2}] (* Gus Wiseman, Feb 27 2019 *)
A278990
Number of loopless linear chord diagrams with n chords.
Original entry on oeis.org
1, 0, 1, 5, 36, 329, 3655, 47844, 721315, 12310199, 234615096, 4939227215, 113836841041, 2850860253240, 77087063678521, 2238375706930349, 69466733978519340, 2294640596998068569, 80381887628910919255, 2976424482866702081004, 116160936719430292078411
Offset: 0
- Seiichi Manyama, Table of n, a(n) for n = 0..404 (terms 0..200 from Gheorghe Coserea)
- Dmitry Efimov, The hafnian of Toeplitz matrices of a special type, perfect matchings and Bessel polynomials, arXiv:1904.08651 [math.CO], 2019.
- H. Eriksson and A. Martin, Enumeration of Carlitz multipermutations, arXiv:1702.04177 [math.CO], 2017.
- E. Krasko, I. Labutin, and A. Omelchenko, Enumeration of labelled and unlabelled Hamiltonian Cycles in complete k-partite graphs, arXiv:1709.03218 [math.CO], 2017, Table 1.
- E. Krasko and A. Omelchenko, Enumeration of Chord Diagrams without Loops and Parallel Chords, arXiv:1601.05073 [math.CO], 2016.
- E. Krasko and A. Omelchenko, Enumeration of Chord Diagrams without Loops and Parallel Chords, The Electronic Journal of Combinatorics, 24(3) (2017), #P3.43.
- Gus Wiseman, The a(4) = 36 loopless linear chord diagrams.
- Donovan Young, Counting Bubbles in Linear Chord Diagrams, arXiv:2311.01569 [math.CO], 2023.
- Donovan Young, Bubbles in Linear Chord Diagrams: Bridges and Crystallized Diagrams, arXiv:2408.17232 [math.CO], 2024.
Cf.
A000110,
A000699 (topologically connected 2-uniform),
A000806,
A001147 (2-uniform),
A003436 (cyclical version),
A005493,
A170941,
A190823 (distance 3+ version),
A322402,
A324011,
A324172.
Other sequences involving the multiset {1,1,2,2,...,n,n}:
A001147,
A007717,
A020555,
A094574,
A316972.
-
[n le 2 select 2-n else (2*n-3)*Self(n-1) + Self(n-2): n in [1..30]]; // G. C. Greubel, Sep 26 2023
-
RecurrenceTable[{a[n]== (2n-1)a[n-1] +a[n-2], a[0]==1, a[1]==0}, a, {n,0,20}] (* Vaclav Kotesovec, Sep 15 2017 *)
FullSimplify[Table[-I*(BesselI[1/2+n,-1] BesselK[3/2,1] - BesselI[3/2,-1] BesselK[1/2+ n,1]), {n,0,20}]] (* Vaclav Kotesovec, Sep 15 2017 *)
Table[(2 n-1)!! Hypergeometric1F1[-n,-2 n,-2], {n,0,20}] (* Eric W. Weisstein, Nov 14 2018 *)
Table[Sqrt[2/Pi]/E ((-1)^n Pi BesselI[1/2+n,1] +BesselK[1/2+n,1]), {n,0,20}] // FunctionExpand // FullSimplify (* Eric W. Weisstein, Nov 14 2018 *)
twouniflin[{}]:={{}};twouniflin[set:{i_,_}]:=Join@@Function[s,Prepend[#,s]&/@twouniflin[Complement[set,s]]]/@Table[{i,j},{j,Select[set,#>i+1&]}];
Table[Length[twouniflin[Range[n]]],{n,0,14,2}] (* Gus Wiseman, Feb 27 2019 *)
-
seq(N) = {
my(a = vector(N)); a[1] = 0; a[2] = 1;
for (n = 3, N, a[n] = (2*n-1)*a[n-1] + a[n-2]);
concat(1, a);
};
seq(20) \\ Gheorghe Coserea, Dec 09 2016
-
def A278990_list(prec):
P. = PowerSeriesRing(QQ, prec)
return P( exp(-1+sqrt(1-2*x))/sqrt(1-2*x) ).egf_to_ogf().list()
A278990_list(30) # G. C. Greubel, Sep 26 2023
A190823
Number of permutations of 2 copies of 1..n introduced in order 1..n with no element equal to another within a distance of 2.
Original entry on oeis.org
1, 0, 0, 1, 10, 99, 1146, 15422, 237135, 4106680, 79154927, 1681383864, 39034539488, 983466451011, 26728184505750, 779476074425297, 24281301468714902, 804688068731837874, 28269541494090294129, 1049450257149017422000, 41050171013933837206545
Offset: 0
All solutions for n=4 (read downwards):
1 1 1 1 1 1 1 1 1 1
2 2 2 2 2 2 2 2 2 2
3 3 3 3 3 3 3 3 3 3
4 4 4 4 1 4 4 1 4 4
1 1 2 1 4 2 1 4 2 2
3 3 1 2 2 3 2 3 1 3
2 4 4 4 3 4 3 2 3 1
4 2 3 3 4 1 4 4 4 4
Distance of 1 instead of 2 gives |
A000806|.
-
I:=[1,0,0,1,10,99]; [n le 5 select I[n] else 2*n*Self(n-1) -2*(3*n-8)*Self(n-2) +2*(3*n-11)*Self(n-3) -2*(n-5)*Self(n-4) -Self(n-5): n in [1..40]]; // G. C. Greubel, Dec 03 2023
-
a[0]=1; a[1]=0; a[2]=0; a[3]=1; a[4]=10; a[5]=99; a[n_] := a[n] = (2*n+2) a[n-1] - (6*n-10) a[n-2] + (6*n-16) a[n-3] - (2*n-8) a[n-4] - a[n-5]; Array[a, 20, 0] (* based on Sullivan's formula, Giovanni Resta, Mar 20 2017 *)
dtui[{}]:={{}};dtui[set:{i_,_}]:=Join@@Function[s,Prepend[#,s]&/@dtui[Complement[set,s]]]/@Table[{i,j},{j,Select[set,#>i+2&]}];
Table[Length[dtui[Range[n]]],{n,0,12,2}] (* Gus Wiseman, Feb 27 2019 *)
-
@CachedFunction
def a(n): # a = A190823
if (n<6): return (1,0,0,1,10,99)[n]
else: return 2*(n+1)*a(n-1) - 2*(3*n-5)*a(n-2) + 2*(3*n-8)*a(n-3) - 2*(n-4)*a(n-4) - a(n-5)
[a(n) for n in range(41)] # G. C. Greubel, Dec 03 2023
A306386
Number of chord diagrams with n chords all having arc length at least 3.
Original entry on oeis.org
1, 0, 0, 1, 7, 68, 837, 11863, 189503, 3377341, 66564396, 1439304777, 33902511983, 864514417843, 23735220814661, 698226455579492, 21914096529153695, 731009183350476805, 25829581529376423945, 963786767538027630275, 37871891147795243899204, 1563295398737378236910447
Offset: 0
The a(8) = 7 2-uniform set partitions with all arc lengths at least 3:
{{1,4},{2,6},{3,7},{5,8}}
{{1,4},{2,7},{3,6},{5,8}}
{{1,5},{2,6},{3,7},{4,8}}
{{1,5},{2,6},{3,8},{4,7}}
{{1,5},{2,7},{3,6},{4,8}}
{{1,6},{2,5},{3,7},{4,8}}
{{1,6},{2,5},{3,8},{4,7}}
Cf.
A000296,
A000699,
A001006,
A001147,
A001610,
A003436,
A038041,
A054726,
A135042,
A170941,
A190823,
A278990,
A306419,
A322402,
A324011,
A324169.
-
a:= proc(n) option remember; `if`(n<8, [1, 0$2, 1, 7, 68, 837, 11863][n+1],
((8*n^4-64*n^3+142*n^2-66*n+109) *a(n-1)
-(24*n^4-248*n^3+870*n^2-1106*n+241)*a(n-2)
+(24*n^4-264*n^3+982*n^2-1270*n+145)*a(n-3)
-(8*n^4-96*n^3+374*n^2-486*n+33) *a(n-4)
-(4*n^3-24*n^2+39*n-2) *a(n-5))/(4*n^3-36*n^2+99*n-69))
end:
seq(a(n), n=0..23); # Alois P. Heinz, Feb 27 2019
-
dtui[{},]:={{}};dtui[set:{i,___},n_]:=Join@@Function[s,Prepend[#,s]&/@dtui[Complement[set,s],n]]/@Table[{i,j},{j,Switch[i,1,Select[set,3<#i+2&]]}];
Table[Length[dtui[Range[n],n]],{n,0,12,2}]
A239145
Number T(n,k) of self-inverse permutations p on [n] where the minimal transposition distance equals k (k=0 for the identity permutation); triangle T(n,k), n>=0, 0<=k<=n, read by rows.
Original entry on oeis.org
1, 1, 0, 1, 1, 0, 1, 2, 1, 0, 1, 5, 3, 1, 0, 1, 13, 8, 3, 1, 0, 1, 39, 22, 10, 3, 1, 0, 1, 120, 65, 32, 10, 3, 1, 0, 1, 401, 208, 103, 37, 10, 3, 1, 0, 1, 1385, 703, 344, 136, 37, 10, 3, 1, 0, 1, 5069, 2517, 1206, 501, 151, 37, 10, 3, 1, 0, 1, 19170, 9390, 4421, 1890, 622, 151, 37, 10, 3, 1, 0
Offset: 0
T(4,0) = 1: 1234.
T(4,1) = 5: 1243, 1324, 2134, 2143, 4321.
T(4,2) = 3: 1432, 3214, 3412.
T(4,3) = 1: 4231.
Triangle T(n,k) begins:
00: 1;
01: 1, 0;
02: 1, 1, 0;
03: 1, 2, 1, 0;
04: 1, 5, 3, 1, 0;
05: 1, 13, 8, 3, 1, 0;
06: 1, 39, 22, 10, 3, 1, 0;
07: 1, 120, 65, 32, 10, 3, 1, 0;
08: 1, 401, 208, 103, 37, 10, 3, 1, 0;
09: 1, 1385, 703, 344, 136, 37, 10, 3, 1, 0;
10: 1, 5069, 2517, 1206, 501, 151, 37, 10, 3, 1, 0;
-
b:= proc(n, k, s) option remember; `if`(n=0, 1, `if`(n in s,
b(n-1, k, s minus {n}), b(n-1, k, s) +add(`if`(i in s, 0,
b(n-1, k, s union {i})), i=1..n-k-1)))
end:
T:= (n, k)-> `if`(k=0, 1, b(n, k-1, {})-b(n, k, {})):
seq(seq(T(n, k), k=0..n), n=0..14);
-
b[n_, k_, s_List] := b[n, k, s] = If[n == 0, 1, If[MemberQ[s, n], b[n-1, k, s ~Complement~ {n}], b[n-1, k, s] + Sum[If[MemberQ[s, i], 0, b[n-1, k, s ~Union~ {i}]], {i, 1, n - k - 1}]]] ; T[n_, k_] := If[k == 0, 1, b[n, k-1, {}] - b[n, k, {}]]; Table[Table[T[n, k], {k, 0, n}], {n, 0, 14}] // Flatten (* Jean-François Alcover, Jan 22 2015, after Maple *)
A239144
Number T(n,k) of self-inverse permutations p on [n] such that all transposition distances (if any) are larger than k; triangle T(n,k), n>=0, 0<=k<=n, read by rows.
Original entry on oeis.org
1, 1, 1, 2, 1, 1, 4, 2, 1, 1, 10, 5, 2, 1, 1, 26, 13, 5, 2, 1, 1, 76, 37, 15, 5, 2, 1, 1, 232, 112, 47, 15, 5, 2, 1, 1, 764, 363, 155, 52, 15, 5, 2, 1, 1, 2620, 1235, 532, 188, 52, 15, 5, 2, 1, 1, 9496, 4427, 1910, 704, 203, 52, 15, 5, 2, 1, 1
Offset: 0
T(4,0) = 10: 1234, 1243, 1324, 1432, 2134, 2143, 3214, 3412, 4231, 4321.
T(4,1) = 5: 1234, 1432, 3214, 3412, 4231.
T(4,2) = 2: 1234, 4231.
T(4,3) = 1: 1234.
Triangle T(n,k) begins:
00: 1;
01: 1, 1;
02: 2, 1, 1;
03: 4, 2, 1, 1;
04: 10, 5, 2, 1, 1;
05: 26, 13, 5, 2, 1, 1;
06: 76, 37, 15, 5, 2, 1, 1;
07: 232, 112, 47, 15, 5, 2, 1, 1;
08: 764, 363, 155, 52, 15, 5, 2, 1, 1;
09: 2620, 1235, 532, 188, 52, 15, 5, 2, 1, 1;
10: 9496, 4427, 1910, 704, 203, 52, 15, 5, 2, 1, 1;
-
b:= proc(n, k, s) option remember; `if`(n=0, 1, `if`(n in s,
b(n-1, k, s minus {n}), b(n-1, k, s) +add(`if`(i in s, 0,
b(n-1, k, s union {i})), i=1..n-k-1)))
end:
T:= (n, k)-> b(n, k, {}):
seq(seq(T(n, k), k=0..n), n=0..14);
-
b[n_, k_, s_List] := b[n, k, s] = If[n == 0, 1, If[MemberQ[s, n], b[n-1, k, s ~Complement~ {n}], b[n-1, k, s] + Sum[If[MemberQ[s, i], 0, b[n-1, k, s ~Union~ {i}]], {i, 1, n-k-1}]]]; T[n_, k_] := b[n, k, {}]; Table[Table[T[n, k], {k, 0, n}], {n, 0, 14}] // Flatten (* Jean-François Alcover, Jan 19 2015, after Alois P. Heinz *)
A306419
Number of set partitions of {1, ..., n} whose blocks are all singletons and pairs, not including {1, n} or {i, i + 1} for any i.
Original entry on oeis.org
1, 1, 1, 1, 4, 11, 32, 99, 326, 1123, 4064, 15291, 59924, 242945, 1019584, 4409233, 19648674, 89938705, 422744384, 2035739041, 10039057524, 50610247483, 260704414816, 1370387233859, 7346982653702, 40131663286851, 223238920709024, 1263531826402891, 7273434344119460
Offset: 0
The a(1) = 1 through a(5) = 11 set partitions:
{{1}} {{1}{2}} {{1}{2}{3}} {{13}{24}} {{1}{24}{35}}
{{1}{24}{3}} {{13}{24}{5}}
{{13}{2}{4}} {{13}{25}{4}}
{{1}{2}{3}{4}} {{14}{2}{35}}
{{14}{25}{3}}
{{1}{2}{35}{4}}
{{1}{24}{3}{5}}
{{1}{25}{3}{4}}
{{13}{2}{4}{5}}
{{14}{2}{3}{5}}
{{1}{2}{3}{4}{5}}
-
stableSets[u_,Q_]:=If[Length[u]===0,{{}},With[{w=First[u]},Join[stableSets[DeleteCases[u,w],Q],Prepend[#,w]&/@stableSets[DeleteCases[u,r_/;r===w||Q[r,w]||Q[w,r]],Q]]]];
Table[Length[stableSets[Complement[Subsets[Range[n],{2}],Sort/@Partition[Range[n],2,1,1]],Intersection[#1,#2]!={}&]],{n,0,10}]
(* Second program: *)
CompoundExpression[
b[n_] := I^(1 - n) 2^((n - 1)/2) HypergeometricU[(1 - n)/2, 3/2, -1/2],
Join[{1, 1, 1}, Table[Sum[(-1)^k b[n - 2 k] n (n - 1 - k)!/(k! (n - 2 k)!), {k, 0, n/2}], {n, 3, 20}]]
] (* Eric W. Weisstein, Sep 02 2025 *)
-
\\ here b(n) is A000085(n)
b(n) = {sum(k=0, n\2, n!/((n-2*k)!*2^k*k!))}
a(n) = {if(n < 3, n >= 0, sum(k=0, n\2, (-1)^k*b(n-2*k)*n*(n-1-k)!/(k!*(n-2*k)!)))} \\ Andrew Howroyd, Aug 30 2019
A217876
Triangle read by rows: distribution of adjacent transpositions in involutions.
Original entry on oeis.org
1, 1, 1, 1, 2, 2, 5, 4, 1, 13, 10, 3, 37, 29, 9, 1, 112, 88, 28, 4, 363, 288, 96, 16, 1, 1235, 984, 336, 60, 5, 4427, 3555, 1248, 240, 25, 1, 16526, 13334, 4764, 956, 110, 6, 64351, 52252, 19023, 3984, 505, 36, 1, 259471, 211646, 78101, 16836, 2261, 182, 7
Offset: 0
Triangle starts at n=0, k=0:
..1
..1
..1 ...1
..2 ...2
..5 ...4 ...1
.13 ..10 ...3
.37 ..29 ...9 ...1
112 ..88 ..28 ...4
363 .288 ..96 ..16 ...1
T(5,2) = 3 counts, in cycle form, {(12),(34),(5)}, {(12),(3),(45)}, and {(1),(23),(45)} because each contains 2 adjacent transpositions.
- P. Stadler and C. Haslinger, RNA structures with pseudo-knots: Graph theoretical and combinatorial properties, Bull. Math. Biol. (1999) Vol 61 Issue 3, 437-67.
-
b:= proc(n, s) option remember; `if`(n=0, 1, `if`(n in s,
b(n-1, s minus {n}), expand(b(n-1, s)+add(`if`(i in s, 0,
`if`(i=n-1, x, 1)*b(n-1, s union {i})), i=1..n-1))))
end:
T:= n->(p->seq(coeff(p, x, i), i=0..degree(p)))(b(n, {})):
seq(T(n), n=0..14); # Alois P. Heinz, Mar 10 2014
-
Clear[T]; (* T(n,k,j) is the number of involutions on [n] containing k adjacent transpositions but not the adjacent transposition (j,j+1) *)
T[n_, k_] /; k < 0 || k > n/2 := 0;
T[0, 0] = 1; T[1, 0] = 1; T[2, 0] = 1;
T[n_, k_] := T[n, k] = T[n - 1, k] + T[n - 2, k - 1] - T[n - 3, k] - T[n - 4, k - 1] + T[n - 4, k] + Sum[T[n - 2, k, j], {j, 0, n - 2}];
T[n_, k_, j_] /; n <= 1 && k >= 1 := 0;
T[n_, k_, j_] /; k < 0 := 0;
T[n_, k_, j_] /; 0 <= n <= 1 && k == 0 := 1;
T[n_, k_, j_] /; j <= 0 || j >= n := T[n, k];
T[n_, k_, j_] /; n >= 2 && k >= 0 := T[n, k, j] = T[n - 2, k, j - 1] + T[n, k] - T[n - 2, k] - T[n - 2, k - 1, j - 1];
Table[T[n, k], {n, 0, 15}, {k, 0, n/2}]
A302719
Number of edge covers in the n-path complement graph.
Original entry on oeis.org
0, 0, 0, 2, 26, 580, 23116, 1703182, 237842582, 64143512608, 33852316389688, 35268292090882874, 72930742736413804146, 300323342846133370497564, 2467442527810798875863471748, 40490661363717159406441954638982, 1327931037076594186049396631983031214
Offset: 1
-
Table[Sum[Sum[Binomial[n - i, k] Sum[(-1)^(k - j) Binomial[k, j] 2^Binomial[j, 2], {j, 0, k}] (2^i)^k If[i == 0 && k == n, 1, (2^i - 1)^(n - i - k)], {k, 0, n - i}] Sum[(-1)^j Binomial[n - j, i - j] Binomial[j - 1, 2 j - i] 2^(Binomial[i, 2] - j), {j, Ceiling[i/2], i}], {i, 0, n}], {n, 10}] (* Eric W. Weisstein, Apr 24 2018 *)
-
a(n)={ my(p=serlaplace(sum(k=0, n, 2^binomial(k,2)*x^k/k!)/exp(x+O(x*x^n))));
sum(i=0, n, sum(k=0, n-i, binomial(n-i,k)*polcoeff(p,k)*(2^i)^k*(2^i-1)^(n-i-k)) * sum(j=(i+1)\2, i, (-1)^j * binomial(n-j, i-j) * binomial(j-1, 2*j-i) * 2^binomial(i,2)/2^j))} \\ Andrew Howroyd, Apr 23 2018
A302749
Number of maximal matchings in the n-path complement graph.
Original entry on oeis.org
1, 1, 1, 2, 6, 11, 41, 77, 365, 694, 3984, 7639, 51499, 99343, 769159, 1490474, 13031514, 25341713, 246925295, 481540391, 5173842311, 10113069526, 118776068256, 232612909297, 2964697094281, 5815557347521, 79937923931761, 157024987610282, 2315462770608870, 4553838477539219
Offset: 1
-
Table[If[Mod[n, 2] == 0, (n - 1)!! (Hypergeometric1F1[1 - n/2, 1 - n, -2] + Hypergeometric1F1[-n/2, -n, -2]), (2^-Floor[n/2] n! Hypergeometric1F1[-Floor[n/2], -n, -2])/Floor[n/2]!], {n, 30}]
-
b(n)=(2*n)!/(2^n*n!);
a(n)=sum(k=0, n\2, if(n%2,1,(1-k))*(-1)^k*binomial(n-k,k)*b((n+1)\2-k)) \\ Andrew Howroyd, Apr 15 2018
Showing 1-10 of 11 results.
Comments