A330661
T(n,k) is the index within the partitions of n in canonical ordering of the k-th partition whose parts differ pairwise by at most one.
Original entry on oeis.org
1, 1, 2, 1, 2, 3, 1, 3, 4, 5, 1, 3, 5, 6, 7, 1, 5, 8, 9, 10, 11, 1, 5, 9, 12, 13, 14, 15, 1, 8, 13, 18, 19, 20, 21, 22, 1, 8, 19, 22, 26, 27, 28, 29, 30, 1, 13, 22, 30, 37, 38, 39, 40, 41, 42, 1, 13, 30, 41, 46, 51, 52, 53, 54, 55, 56, 1, 20, 44, 59, 62, 71, 72, 73, 74, 75, 76, 77
Offset: 1
Partitions of 8 in canonical ordering begin: 8, 71, 62, 611, 53, 521, 5111, 44, 431, 422, 4211, 41111, 332, ... . The partitions whose parts differ pairwise by at most one in this list are 8, 44, 332, ... at indices 1, 8, 13, ... and this gives row 8 of this triangle.
Triangle T(n,k) begins:
1;
1, 2;
1, 2, 3;
1, 3, 4, 5;
1, 3, 5, 6, 7;
1, 5, 8, 9, 10, 11;
1, 5, 9, 12, 13, 14, 15;
1, 8, 13, 18, 19, 20, 21, 22;
1, 8, 19, 22, 26, 27, 28, 29, 30;
1, 13, 22, 30, 37, 38, 39, 40, 41, 42;
...
-
b:= proc(l) option remember; (n-> `if`(n=0, 1,
b(subsop(1=[][], l))+g(n, l[1]-1)))(add(j, j=l))
end:
g:= proc(n, i) option remember; `if`(n=0 or i=1, 1,
`if`(i<1, 0, g(n-i, min(n-i, i))+g(n, i-1)))
end:
T:= proc(n, k) option remember; 1 + g(n$2)-
b((q-> [q+1$r, q$k-r])(iquo(n, k, 'r')))
end:
seq(seq(T(n, k), k=1..n), n=1..14); # Alois P. Heinz, Feb 19 2020
-
b[l_List] := b[l] = Function[n, If[n == 0, 1, b[ReplacePart[l, 1 -> Nothing]] + g[n, l[[1]] - 1]]][Total[l]];
g[n_, i_] := g[n, i] = If[n == 0 || i == 1, 1, If[i < 1, 0, g[n - i, Min[n - i, i]] + g[n, i - 1]]];
T[n_, k_] := T[n, k] = Module[{q, r}, {q, r} = QuotientRemainder[n, k]; 1 + g[n, n] - b[Join[Table[q + 1, {r}], Table[q, {k - r}]]]];
Table[T[n, k], {n, 1, 14}, {k, 1, n}] // Flatten (* Jean-François Alcover, Apr 29 2020, after Alois P. Heinz *)
-
balP(p) = p[1]-p[#p]<=1
Row(n)={v=vecsort([Vecrev(p) | p<-partitions(n)], , 4);select(i->balP(v[i]),[1..#v])}
{ for(n=1, 10, print(Row(n))) }
A332706
Index position of {2}^n within the list of partitions of 2n in canonical ordering.
Original entry on oeis.org
1, 1, 3, 8, 18, 37, 71, 128, 223, 376, 617, 991, 1563, 2423, 3704, 5589, 8333, 12293, 17959, 25996, 37318, 53153, 75153, 105535, 147249, 204201, 281563, 386128, 526795, 715191, 966437, 1300125, 1741598, 2323487, 3087701, 4087933, 5392747, 7089463, 9289053
Offset: 0
a(3) = 8, because 222 has position 8 within the list of partitions of 6 in canonical ordering: 6, 51, 42, 411, 33, 321, 3111, 222, ... .
-
a:= n-> combinat[numbpart](2*n)-n:
seq(a(n), n=0..44);
-
a[n_] := PartitionsP[2n] - n;
Table[a[n], {n, 0, 44}] (* Jean-François Alcover, Aug 20 2021, from Maple *)
A238639
Position of [n, n-1, ..., 2, 1] in Mathematica-ordered list of partitions of n(n+1)/2.
Original entry on oeis.org
1, 1, 2, 6, 23, 103, 498, 2493, 12741, 66224, 348963, 1859009, 9994196, 54155387, 295477841, 1621962199, 8951635343, 49644856801, 276540258555, 1546630084062, 8681889729354, 48900895532763, 276302483274825, 1565747892473958, 8896975706929141, 50683901455201860
Offset: 0
The partitions of 6 in Mathematica order are 6, 51, 42, 411, 33, 321, 3111, 222, 2211, 21111, 111111. The position of 321 is a(3) = 6.
-
g:= (n, i)-> `if`(n=0, 1, g(n-i+1, i-1)+ b(n-i, i)):
b:= proc(n, i) option remember; `if`(n=0, 1,
`if`(i<1, 0, b(n, i-1)+`if`(i>n, 0, b(n-i, i))))
end:
a:= n-> (m-> add(b(m-j, min(j, m-j)), j=n+1..m)+
g(m-n, n))(n*(n+1)/2):
seq(a(n), n=0..25); # Alois P. Heinz, Jun 03 2015
-
r[n_] := Table[n - k, {k, 0, n - 1}]; Flatten[Table[Position[IntegerPartitions[n (n + 1)/2], r[n]], {n, 0, 2}]]
g[n_, i_] := If[n==0, 1, g[n-i+1, i-1] + b[n-i, i]]; b[n_, i_] := b[n, i] = If[n==0, 1, If[i<1, 0, b[n, i-1] + If[i>n, 0, b[n-i, i]]]]; a[n_] := Function[m, Sum[b[m-j, Min[j, m-j]], {j, n+1, m}] + g[m-n, n]][n(n+1)/2]; Table[a[n], {n, 0, 25}] (* Jean-François Alcover, Oct 28 2015, after Alois P. Heinz *)
A238638
Position of n-th row of Pascal's triangle in Mathematica-ordered list of partitions of 2^n.
Original entry on oeis.org
1, 2, 4, 14, 109, 3366, 380480, 592178710, 12245355432908, 42590813279958575804, 35428820136077436448479258280, 643572551892460566707053818908283349242945, 1088540944742787295982636155758383327725184898133092177544054
Offset: 0
The partitions of 4 in Mathematica order are 4, 31, 22, 211, 111. a(2) = 4 is the position of 211, which as a partition is equivalent to row 2 of Pascal's triangle: 1 2 1 (where the top row is counted as row 0).
-
p:= (n, k)-> binomial(n, iquo(2*n-k+1, 2)):
g:= (n, k, i)-> `if`(n=0, 1, g(n-p(k, i-1), k, i-1)
+add(b(n-j, j), j=p(k, i-1)+1..min(n, p(k, i)))):
b:= proc(n, i) option remember; `if`(n=0, 1,
`if`(i<1, 0, b(n, i-1)+`if`(i>n, 0, b(n-i, i))))
end:
a:= n-> (m-> add(b(m-j, min(j, m-j)), j=p(n$2)+1..m)
+g(m-p(n$2), n$2))(2^n):
seq(a(n), n=0..10); # Alois P. Heinz, Jun 03 2015
-
r[n_] := Reverse[Sort[Table[Binomial[n, k], {k, 0, n}]]]; Flatten[Table[Position[IntegerPartitions[2^n], r[n]], {n, 0, 6}]]
(* second program: *)
$RecursionLimit = 2000;
p[n_, k_] := Binomial[n, Quotient[2*n - k + 1, 2]];
g[n_, k_, i_] := If[n == 0, 1, g[n - p[k, i - 1], k, i - 1] + Sum[b[n - j, j], {j, p[k, i - 1] + 1, Min[n, p[k, i]]}]];
b[n_, i_] := b[n, i] = If[n == 0, 1, If[i < 1, 0, b[n, i - 1] + If[i > n, 0, b[n - i, i]]]];
a[n_] := Function[m, Sum[b[m - j, Min[j, m - j]], {j, p[n, n] + 1, m}] + g[m - p[n, n], n, n]][2^n];
Table[a[n], {n, 0, 10}] (* Jean-François Alcover, Aug 30 2016, after Alois P. Heinz *)
A238641
Number of partitions p of 2n-1 such that n - (number of parts of p) is a part of p.
Original entry on oeis.org
0, 0, 1, 4, 9, 21, 37, 69, 113, 187, 286, 449, 657, 976, 1397, 2003, 2788, 3902, 5323, 7284, 9789, 13144, 17405, 23052, 30142, 39379, 50967, 65842, 84368, 107954, 137126, 173893
Offset: 1
a(4) counts these partitions of 7: 52, 511, 421, 331.
-
z = 30; g[n_] := IntegerPartitions[n]; m[p_, t_] := MemberQ[p, t];
Table[Count[g[2 n], p_ /; m[p, n - Length[p]]], {n, z}] (*A238607*)
Table[Count[g[2 n - 1], p_ /; m[p, n - Length[p]]], {n, z}] (*A238641*)
Table[Count[g[2 n + 1], p_ /; m[p, n - Length[p]]], {n, z}] (*A238742*)
p[n_, k_] := p[n, k] = If[k == 1 || n == k, 1, If[k > n, 0, p[n - 1, k - 1] + p[n - k, k]]]; q[n_, k_, e_] := q[n, k, e] = If[n - e < k - 1 , 0, If[k == 1, If[n == e, 1, 0], p[n - e, k - 1]]]; a[n_] := Sum[q[2*n - 1, u, n - u], {u, n - 1}]; Array[a,100] (* Giovanni Resta, Mar 09 2014 *)
A238742
Number of partitions p of 2n+1 such that n - (number of parts of p) is a part of p.
Original entry on oeis.org
0, 0, 1, 5, 13, 31, 59, 109, 180, 301, 461, 712, 1051, 1547, 2200, 3138, 4349, 6036, 8211, 11146, 14901, 19908, 26232, 34513, 44953, 58412, 75244, 96752, 123448, 157201, 198931, 251155
Offset: 1
a(4) counts these partitions of 9: 72, 711, 621, 531, 441.
-
z = 30; g[n_] := IntegerPartitions[n]; m[p_, t_] := MemberQ[p, t];
Table[Count[g[2 n], p_ /; m[p, n - Length[p]]], {n, z}] (*A238607*)
Table[Count[g[2 n - 1], p_ /; m[p, n - Length[p]]], {n, z}] (*A238641*)
Table[Count[g[2 n + 1], p_ /; m[p, n - Length[p]]], {n, z}] (*A238742*)
p[n_, k_] := p[n, k] = If[k == 1 || n == k, 1, If[k > n, 0, p[n-1, k-1] + p[n-k, k]]]; q[n_, k_, e_] := q[n, k, e] = If[n-e < k-1 , 0, If[k == 1, If[n == e, 1, 0], p[n-e, k-1]]]; a[n_] := Sum[q[2*n+1, u, n-u], {u, n-1}]; Array[a, 100] (* Giovanni Resta, Mar 12 2014 *)
A332722
Index position of [2n-1, 2n-3, ..., 3, 1] within the list of partitions of n^2 in canonical ordering.
Original entry on oeis.org
1, 1, 2, 9, 74, 711, 7312, 77793, 848557, 9426039, 106218592, 1210785512, 13933358426, 161624712815, 1887635428421, 22176331059637, 261881397819259, 3106736469937751, 37006306302036790, 442425926101676831, 5306994321265281854, 63851605555921588684, 770371217568310624912
Offset: 0
a(3) = 9, because 531 has position 9 within the list of partitions of 3*3 in canonical ordering: 9, 81, 72, 711, 63, 621, 6111, 54, 531, ... .
-
b:= proc(n, i) option remember;
`if`(n=0, 1, b(n-i, i-2)+g(n, i-1))
end:
g:= proc(n, i) option remember; `if`(n=0 or i=1, 1,
`if`(i<1, 0, g(n-i, min(n-i, i))+g(n, i-1)))
end:
a:= n-> g(n^2$2)-b(n^2, 2*n-1)+1:
seq(a(n), n=0..23);
-
b[n_, i_] := b[n, i] = If[n == 0, 1, b[n - i, i - 2] + g[n, i - 1]];
g[n_, i_] := g[n, i] = If[n == 0 || i == 1, 1, If[i < 1, 0, g[n - i, Min[n - i, i]] + g[n, i - 1]]];
a[n_] := g[n^2, n^2] - b[n^2, 2n - 1] + 1;
a /@ Range[0, 23] (* Jean-François Alcover, May 10 2020, after Maple *)
Showing 1-7 of 7 results.
Comments