# Deleting sublists where an element repeats beyond a repetition threshold

I am looking for some help constructing a function Part[M_,N_] which outputs the list of all integer partitions of positive integers up to $$M$$ such that in each partition, no number is repeated more than $$N+1$$ times. For example, when $$N=3$$, the partition {1,4,5,5,5,5,5,7} of $$37$$ should not count, because there are more than four (i.e., $$N+1$$) copies of $$5$$.

I'd appreciate any assistance here!

• Is it necessary to use DeleteCases?
– Syed
Commented May 22, 2022 at 9:28
• I suppose not. From my very limited knowledge, it was just the main approach I could think of. Commented May 22, 2022 at 9:45

ClearAll[f]

f[m_, n_] := Select[LessEqualThan[1 + n] @* Max @* Counts] @*
Map[Apply[Sequence] @* IntegerPartitions] @* Range @ m;


Examples:

f[5, 2]

{{1}, {2}, {1, 1}, {3}, {2, 1}, {1, 1, 1}, {4}, {3, 1}, {2, 2}, {2, 1, 1}, {5},
{4, 1}, {3, 2}, {3, 1, 1}, {2, 2, 1}, {2, 1, 1, 1}}

f[9, 2]


Length @ f[37, 3]

62483

SeedRandom[1];
n = 2;
plist = RandomSample[IntegerPartitions[37, {6, 7}], 200];


The list is still too large; let's reduce it to 20 entries for better visualization.

xlist = plist[[1 ;; 20]]


• For n=2, four repetitions of an element are not allowed. The entries underlined in red should be deleted.

• For n=3, five repetitions of an element are not allowed. The entries enclosed by the green box should be deleted.

pos = First /@
Position[Tally /@ xlist, {_, x_ /; x > n + 1}, Infinity,


{1, 6, 13, 16, 17, 19}

Delete[xlist, List /@ pos]

{{23, 4, 4, 3, 2, 1}, {21, 5, 4, 4, 2, 1}, {15, 11, 5, 4, 1, 1}, {12,
7, 6, 4, 4, 2, 2}, {10, 9, 9, 7, 1, 1}, {14, 5, 4, 4, 4, 3, 3}, {13,
11, 5, 4, 2, 1, 1}, {14, 10, 4, 4, 4, 1}, {17, 6, 4, 4, 3, 2,
1}, {16, 5, 5, 5, 4, 1, 1}, {9, 9, 5, 5, 4, 3, 2}, {14, 12, 3, 3, 2,
2, 1}, {21, 9, 2, 2, 2, 1}, {12, 10, 9, 2, 2, 2}}


Now you can turn it into a function with n as a parameter if you wish to. IntegerPartitions grow in size rapidly so an attempt to make tuples of two large sets may run into difficulties. I hope this gives you a pointer in the right direction.

part[m_, n_] := DeleteCases[
IntegerPartitions[m], _?(Max[Tally[#][[All, 2]]] > n &)]

part[37, 2]


{{37}, {36, 1}, {35, 2}, {35, 1, 1}, {34, 3}, {34, 2, 1}, ... }