A190900
Positive integers without recursively self-conjugate partitions.
Original entry on oeis.org
2, 5, 7, 8, 13, 14, 19, 20, 23, 26, 29, 30, 32, 35, 39, 41, 46, 50, 52, 53, 62, 63, 65, 74, 77, 92, 95, 104, 107, 109, 110, 116, 119, 128, 158, 159, 170, 173, 182, 185, 221, 248, 251, 317, 545
Offset: 1
From _Michael De Vlieger_, Oct 23 2018: (Start)
None of the partitions of 5, {{5}, {4,1}, {3,2}, {3,1,1}, {2,2,1}, {2,1,1,1}, {1,1,1,1,1}} are self-conjugate, thus 5 is in the sequence.
The partition {4,4,2,2} of 12 is self-conjugate and is made up of Durfee squares thus 12 is not in the sequence.
The partition {8,5,5,5,4,1,1,1} of 30 is self-conjugate. We eliminate the Durfee square {4,4,4,4} which leaves us with {4,1,1,1} which is self-conjugate, but when we eliminate the Durfee square {1} from this, we are left with {1,1,1} which is not self-conjugate. There are no other self-conjugate partitions of 30, therefore 30 is in the sequence.
Both self-conjugate partitions of 32 are not recursively so. Thus 32 is in the sequence. (End)
-
f[n_] := Block[{w = {n}, c}, c[x_] := Apply[Times, Most@ x - Reverse@ Accumulate@ Reverse@ Rest@ x]; Reap[Do[Which[And[Length@ w == 2, SameQ @@ w], Sow[w]; Break[], Length@ w == 1, Sow[w]; AppendTo[w, 1], c[w] > 0, Sow[w]; AppendTo[w, 1], True, Sow[w]; w = MapAt[1 + # &, Drop[w, -1], -1] ], {i, Infinity}] ][[-1, 1]] ]; With[{n = 30}, Complement[Range@ Last@ #, #] &@ TakeWhile[Union@ Flatten@ Array[Map[Total@ MapIndexed[#1^2*2^First[#2 - 1] &, #] &, f[#]] &, n], # <= n^2 &]] (* Michael De Vlieger, Oct 30 2018 *)
A321223
a(n) is the number of recursively self-conjugate partitions of n.
Original entry on oeis.org
1, 0, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, 0, 2, 1, 0, 0, 1, 0, 1, 1, 0, 2, 1, 2, 0, 1, 0, 1, 1, 1, 1, 0, 1, 2, 2, 0, 1, 0, 0, 1, 2, 1, 2, 1, 1, 1, 2, 0, 0, 1, 0, 2, 1, 1, 1, 2, 1, 2, 1, 0, 1, 1, 0, 1, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 1, 2, 1, 0, 2, 1, 0, 1, 1, 1, 2, 2, 1, 1, 3, 0, 2
Offset: 1
a(2) = 0 since neither (2) nor (1,1) is recursively symmetrical.
a(6) = 1 since the partition (3,2,1) of 6 is recursively symmetrical. S(3,2,1) = {2,1}.
a(27) = 2 since both (6,6,6,3,3,3) and (6,5,5,5,5,1) are recursively self-conjugate. S(6,6,6,3,3,3) = {3,3}; S(6,5,5,5,5,1) = {5,1}.
a(103) = 3 since there are 3 recursively self-conjugate partitions of 103: (13,13,13,10,10,10,7,6,6,6,3,3,3), (13,12,12,12,12,8,7,6,5,5,5,5,1), and (13,12,12,10,9,9,9,9,9,4,3,3,1). These can be stated in terms of recursive squares as {7,3,3}, {7,5,1}, and {9,3,1} respectively.
-
f[w_] := Block[{k}, k = Total@ w; Total@ Map[Apply[Function[{s, t}, s Array[Boole[t <= # <= s + t - 1] &, k] ], #] &, Apply[Join, Prepend[Table[Function[{v, c}, Map[{w[[k]], # + 1} &, Map[Total[v #] &, Tuples[{0, 1}, {Length@ v}]]]] @@ {Most@ #, ConstantArray[1, Length@ # - 1]} &@ Take[w, k], {k, 2, Length@ w}], {{w[[1]], 1}}]]] ]; g[n_] := Block[{w = {n}, c}, c[x_] := Apply[Times, Most@ x - Reverse@ Accumulate@ Reverse@ Rest@ x]; Reap[Do[Which[And[Length@ w == 2, SameQ @@ w], Sow[w]; Break[], Length@ w == 1, Sow[w]; AppendTo[w, 1], c[w] > 0, Sow[w]; AppendTo[w, 1], True, Sow[w]; w = MapAt[1 + # &, Drop[w, -1], -1] ], {i, Infinity}] ][[-1, 1]] ]; Block[{n = 12, a}, a = Merge[Map[<| #1 -> #2 |> & @@ # &, #], Identity] &@ TakeWhile[Sort@ Map[{Total@ #2, #1, #2} & @@ {#, f[#]} &, Apply[Join, Array[g, n]] ], First@ # <= n^2 &][[All, 1 ;; 2]]; Array[Length[Lookup[a, #] /. k_ /; MissingQ@ k -> {}] &, Length@ a] ]
A322156
Irregular triangle where row n includes all decreasing sequences S = {k_0 = n, k_1, k_2, ..., k_m} in reverse lexicographic order such that the sum of subsequent terms k_j for all i < j <= m does not exceed any k_i.
Original entry on oeis.org
1, 1, 1, 2, 2, 1, 2, 1, 1, 2, 2, 3, 3, 1, 3, 1, 1, 3, 2, 3, 2, 1, 3, 3, 4, 4, 1, 4, 1, 1, 4, 2, 4, 2, 1, 4, 2, 1, 1, 4, 2, 2, 4, 3, 4, 3, 1, 4, 4, 5, 5, 1, 5, 1, 1, 5, 2, 5, 2, 1, 5, 2, 1, 1, 5, 2, 2, 5, 3, 5, 3, 1, 5, 3, 1, 1, 5, 3, 2, 5, 4, 5, 4, 1, 5, 5, 6, 6, 1, 6, 1, 1, 6, 2, 6, 2, 1, 6, 2, 1, 1, 6, 2, 2, 6
Offset: 1
Triangle begins:
1; 1,1;
2; 2,1; 2,1,1; 2,2;
3; 3,1; 3,1,1; 3,2; 3,2,1; 3,3;
4; 4,1; 4,1,1; 4,2; 4,2,1; 4,2,1,1; 4,2,2; 4,3; 4,3,1; 4,4;
...
Row n = 5 starts with S_1 = 5. We append 1 to get {5,1}. 1 does not exceed 5, thus S_2 = {5,1}. We append 1 to get {5,1,1}. A = {1,2}; {5,1}-{2,1} = {3,0}, thus S_3 = {5,1,1} and we drop the last term and increment the new last term to get {5,2}. S_4 = {5,2}, and the ensuing terms {5,2,1}, {5,2,1,1}, {5,2,2} enter into the row. Since there are repeated terms at the last sequence, we drop the last term and increment the new last to get {5,3}. The terms {5,3,1}, {5,3,1,1}, {5,3,2}, {5,3,2,1}, are admitted. {5,3,2,1,1} has A = {1,2,4,6}. {5,3,2,1}-{6,4,2,1} = {-1,1,0,0}: {5,3,2,1,1} cannot be admitted, so we drop the last term and increment to {5,3,2,2} but the sum of the last two terms exceeds the second and we drop the last term and increment to {5,3,3}. For similar reasons, this cannot be admitted, so we drop the last term and increment to {5,4}. This enters as well as {5,4,1}. Since any appendage or increment proves invalid, we end up incrementing to {5,5}. The two terms are the same, therefore we end the row n = 5.
-
(* Generate sequence: *)
f[n_] := Block[{w = {n}, c}, c[x_] := Apply[Times, Most@ x - Reverse@ Accumulate@ Reverse@ Rest@ x]; Reap[Do[Which[And[Length@ w == 2, SameQ @@ w], Sow[w]; Break[], Length@ w == 1, Sow[w]; AppendTo[w, 1], c[w] > 0, Sow[w]; AppendTo[w, 1], True, Sow[w]; w = MapAt[1 + # &, Drop[w, -1], -1]], {i, Infinity}] ][[-1, 1]] ]; Array[f, 6] // Flatten
(* Convert S = row n to standard partition: *)
g[w_] := Block[{k}, k = Total@ w; Total@ Map[Apply[Function[{s, t}, s Array[Boole[t <= # <= s + t - 1] &, k] ], #] &, Apply[Join, Prepend[Table[Function[{v, c}, Map[{w[[k]], # + 1} &, Map[Total[v #] &, Tuples[{0, 1}, {Length@ v}]]]] @@ {Most@ #, ConstantArray[1, Length@ # - 1]} &@ Take[w, k], {k, 2, Length@ w}], {{w[[1]], 1}}]]] ]
A322457
Irregular triangle: Row n contains numbers k that have recursively symmetrical partitions having Durfee square with side length n.
Original entry on oeis.org
1, 3, 4, 6, 10, 12, 9, 11, 15, 17, 21, 27, 16, 18, 22, 24, 28, 34, 36, 38, 40, 48, 25, 27, 31, 33, 37, 43, 45, 47, 49, 55, 57, 59, 61, 75, 36, 38, 42, 44, 48, 54, 56, 58, 60, 66, 68, 70, 72, 78, 80, 84, 86, 90, 108, 49, 51, 55, 57, 61, 67, 69, 71, 73, 79, 81
Offset: 1
Triangle begins:
Row 1: 1, 3;
Row 2: 4, 6, 10, 12;
Row 3: 9, 11, 15, 17, 21, 27;
Row 4: 16, 18, 22, 24, 28, 34, 36, 38, 40, 48;
...
Row 2 contains the following recursively self-conjugate partitions with Durfee square with side length 2. Below are diagrams that place {2^0, 2^1, 2^2, ... 2^(m-1)} squares of side lengths in S = {k_1, k_2, k_3, ..., k_m}:
(2,2), sum 4, or in terms of squares, {2}:
11
11;
(3,2,1), sum 6, or in terms of squares, {2,1}:
112
11
2;
(4,3,2,1), sum 10, or in terms of squares, {2,1,1}:
1123
113
23
3;
(4,4,2,2), sum 12, or in terms of squares, {2,2}:
1122
1122
22
22.
-
f[n_] := Block[{w = {n}, c}, c[x_] := Apply[Times, Most@ x - Reverse@ Accumulate@ Reverse@ Rest@ x]; Reap[Do[Which[And[Length@ w == 2, SameQ @@ w], Sow[w]; Break[], Length@ w == 1, Sow[w]; AppendTo[w, 1], c[w] > 0, Sow[w]; AppendTo[w, 1], True, Sow[w]; w = MapAt[1 + # &, Drop[w, -1], -1] ], {i, Infinity}] ][[-1, 1]] ]; Array[Union@ Map[Total@ MapIndexed[#1^2*2^First[#2 - 1] &, #] &, f[#]] &, 7] // Flatten
Original entry on oeis.org
1, 27, 103, 175, 198, 310, 411, 495, 627, 675, 720, 838, 880, 1008, 1014, 1191, 1245, 1296, 1575, 1776, 1911, 1953, 2011, 2136, 2160, 2416, 2502, 2673, 2736, 3015, 3123, 3195, 3270, 3450, 3528, 3600, 3696, 4041, 4248, 4251, 4323, 4356, 4410, 4518, 4531, 4716
Offset: 1
RSCPs of the first 3 terms:
a(1) = 1: (1).
a(2) = 27: (6,6,6,3,3,3), (6,5,5,5,5,1).
a(3) = 103: (13,13,13,10,10,10,7,6,6,6,3,3,3),
(13,12,12,12,12,8,7,6,5,5,5,5,1),
(13,12,12,10,9,9,9,9,9,4,3,3,1).
RSCPs stated in terms of recursive Durfee squares for the first 5 terms:
a(1) = 1: {1}.
a(2) = 27: {3,3}, {5,1}.
a(3) = 103: {7,3,3}, {7,5,1}, {9,3,1}.
a(4) = 175: {9,5,3,1}, {11,3,3}, {11,5,1}, {13,1,1}.
a(5) = 198: {10,5,2,2}, {10,7}, {12,3,3}, {12,5,1}, {14,1}.
a(6) = 310: {12,7,3,2}, {12,9,1}, {14,5,4}, {14,7,2},
{16,3,3}, {16,5,1}.
-
f[w_] := Block[{k}, k = Total@ w; Total@ Map[Apply[Function[{s, t}, s Array[Boole[t <= # <= s + t - 1] &, k] ], #] &, Apply[Join, Prepend[Table[Function[{v, c}, Map[{w[[k]], # + 1} &, Map[Total[v #] &, Tuples[{0, 1}, {Length@ v}]]]] @@ {Most@ #, ConstantArray[1, Length@ # - 1]} &@ Take[w, k], {k, 2, Length@ w}], {{w[[1]], 1}}]]] ]; g[n_] := Block[{w = {n}, c}, c[x_] := Apply[Times, Most@ x - Reverse@ Accumulate@ Reverse@ Rest@ x]; Reap[Do[Which[And[Length@ w == 2, SameQ @@ w], Sow[w]; Break[], Length@ w == 1, Sow[w]; AppendTo[w, 1], c[w] > 0, Sow[w]; AppendTo[w, 1], True, Sow[w]; w = MapAt[1 + # &, Drop[w, -1], -1] ], {i, Infinity}] ][[-1, 1]] ]; Block[{n = 30, a, s}, a = Merge[Map[<| #1 -> #2 |> & @@ # &, #], Identity] &@ TakeWhile[Sort@ Map[{Total@ #2, #1, #2} & @@ {#, f[#]} &, Apply[Join, Array[g, n]] ], First@ # <= n^2 &][[All, 1 ;; 2]]; s = Array[Length[Lookup[a, #] /. k_ /; MissingQ@ k -> {}] &, Length@ a]; Map[FirstPosition[s, #][[1]] &, Union@ FoldList[Max, s]]]
Original entry on oeis.org
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 17, 18, 23, 25, 26, 28, 29, 30, 32, 34, 37, 41, 42, 48, 49, 50, 51, 56, 57, 59, 61, 68, 71, 72, 75, 76, 79, 80, 81, 82, 84, 86, 88, 89, 92, 93, 100, 103, 108, 118, 119, 120, 122, 125, 129, 130, 135, 141, 143
Offset: 1
-
f[w_] := Block[{k}, k = Total@ w; Total@ Map[Apply[Function[{s, t}, s Array[Boole[t <= # <= s + t - 1] &, k] ], #] &, Apply[Join, Prepend[Table[Function[{v, c}, Map[{w[[k]], # + 1} &, Map[Total[v #] &, Tuples[{0, 1}, {Length@ v}]]]] @@ {Most@ #, ConstantArray[1, Length@ # - 1]} &@ Take[w, k], {k, 2, Length@ w}], {{w[[1]], 1}}]]] ]; g[n_] := Block[{w = {n}, c}, c[x_] := Apply[Times, Most@ x - Reverse@ Accumulate@ Reverse@ Rest@ x]; Reap[Do[Which[And[Length@ w == 2, SameQ @@ w], Sow[w]; Break[], Length@ w == 1, Sow[w]; AppendTo[w, 1], c[w] > 0, Sow[w]; AppendTo[w, 1], True, Sow[w]; w = MapAt[1 + # &, Drop[w, -1], -1] ], {i, Infinity}] ][[-1, 1]] ]; Block[{n = 40, a}, a = Merge[Map[<| #1 -> #2 |> & @@ # &, #], Identity] &@ TakeWhile[Sort@ Map[{Total@ #2, #1, #2} & @@ {#, f[#]} &, Apply[Join, Array[g, n]] ], First@ # <= n^2 &][[All, 1 ;; 2]]; Union@ FoldList[Max, Array[Length[Lookup[a, #] /. k_ /; MissingQ@ k -> {}] &, Length@ a]]]
Showing 1-6 of 6 results.
Comments