Non-trivial partitions of numbers using Combinatorica

Question

I have made a code which gives back partitions of numbers in two Young diagrams (one Young diagram is trivial). For example, the partitions of 1 are

{{{0}, {1}}, {{1}, {0}}}

i.e. zero in first box and 1 in second box or 1 in the first box and zero for the second box. Of course the way it is written takes also into account antisymmetrization. So, if I choose the partitions of 2 then I will get back {{{0}, {2}}, {{0}, {1, 1}}, {{1}, {1}}, {{2}, {0}}, {{1, 1}, {0}}} where {1, 1}, {0} for example means I get the diagram pair with two boxes on top of each other and zero boxes while {2}, {0} gives the symmetric version, I get the pair with 2 boxes in horizontally and 0 boxes.

The question is how can I extend this for triples and quadruples of Young diagrams. I.e., for the partition of 1 to have

{{1,0,0},{0,1,0},{0,0,1}}

and so forth for the case I want it in 4 or more boxes. It would be great if the answer could also be slightly explained.

Answer 1

Here's a generic answer:

YD[n_, d_] := 
 Cases[Tuples[
    Flatten[{Flatten[{Table[IntegerPartitions[i], {i, n, 1, -1}], 0}, 
         1], IntegerPartitions[n]}, 2] /. Table[{i} -> i, {i, n}] // 
     DeleteDuplicates, d], a_ /; TrueQ[Total[Flatten[a]] == n]] // 
  DeleteDuplicates

Here n is how high the numbers go, and d the amount of tuples.

The section:

Flatten[{Flatten[{Table[IntegerPartitions[i], {i, n, 1, -1}], 0}, 1], 
   IntegerPartitions[n]}, 2] /.Table[{i} -> i, {i, n}] // DeleteDuplicates

creates a list of all possible ways to partition n and every integer below n, so say if n is 3, this gives us:

{3, {2, 1}, {1, 1, 1}, 2, {1, 1}, 1, 0}

Note that you need to manually add a 0.

The code then generates Tuples[] of d length from that list. Finally the Cases[] picks out the sublists that have a total value of n.

YD[1, 2]

{{1, 0}, {0, 1}}

YD[2, 2]

{{2, 0}, {{1, 1}, 0}, {1, 1}, {0, 2}, {0, {1, 1}}}

YD[1, 3]

{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}

Note that at a certain point, this gets memory intensive, and generating anything higher than YD[5, 5] requires a bit of patience.

YD[4, 4]

{{4, 0, 0, 0}, {{3, 1}, 0, 0, 0}, {{2, 2}, 0, 0, 0}, {{2, 1, 1}, 0, 0, 0}, {{1, 1, 1, 1}, 0, 0, 0}, {3, 1, 0, 0}, {3, 0, 1, 0}, {3, 0, 0, 1}, {{2, 1}, 1, 0, 0}, {{2, 1}, 0, 1, 0}, {{2, 1}, 0, 0, 1}, {{1, 1, 1}, 1, 0, 0}, {{1, 1, 1}, 0, 1, 0}, {{1, 1, 1}, 0, 0, 1}, {2, 2, 0, 0}, {2, {1, 1}, 0, 0}, {2, 1, 1, 0}, {2, 1, 0, 1}, {2, 0, 2, 0}, {2, 0, {1, 1}, 0}, {2, 0, 1, 1}, {2, 0, 0, 2}, {2, 0, 0, {1, 1}}, {{1, 1}, 2, 0, 0}, {{1, 1}, {1, 1}, 0, 0}, {{1, 1}, 1, 1, 0}, {{1, 1}, 1, 0, 1}, {{1, 1}, 0, 2, 0}, {{1, 1}, 0, {1, 1}, 0}, {{1, 1}, 0, 1, 1}, {{1, 1}, 0, 0, 2}, {{1, 1}, 0, 0, {1, 1}}, {1, 3, 0, 0}, {1, {2, 1}, 0, 0}, {1, {1, 1, 1}, 0, 0}, {1, 2, 1, 0}, {1, 2, 0, 1}, {1, {1, 1}, 1, 0}, {1, {1, 1}, 0, 1}, {1, 1, 2, 0}, {1, 1, {1, 1}, 0}, {1, 1, 1, 1}, {1, 1, 0, 2}, {1, 1, 0, {1, 1}}, {1, 0, 3, 0}, {1, 0, {2, 1}, 0}, {1, 0, {1, 1, 1}, 0}, {1, 0, 2, 1}, {1, 0, {1, 1}, 1}, {1, 0, 1, 2}, {1, 0, 1, {1, 1}}, {1, 0, 0, 3}, {1, 0, 0, {2, 1}}, {1, 0, 0, {1, 1, 1}}, {0, 4, 0, 0}, {0, {3, 1}, 0, 0}, {0, {2, 2}, 0, 0}, {0, {2, 1, 1}, 0, 0}, {0, {1, 1, 1, 1}, 0, 0}, {0, 3, 1, 0}, {0, 3, 0, 1}, {0, {2, 1}, 1, 0}, {0, {2, 1}, 0, 1}, {0, {1, 1, 1}, 1, 0}, {0, {1, 1, 1}, 0, 1}, {0, 2, 2, 0}, {0, 2, {1, 1}, 0}, {0, 2, 1, 1}, {0, 2, 0, 2}, {0, 2, 0, {1, 1}}, {0, {1, 1}, 2, 0}, {0, {1, 1}, {1, 1}, 0}, {0, {1, 1}, 1, 1}, {0, {1, 1}, 0, 2}, {0, {1, 1}, 0, {1, 1}}, {0, 1, 3, 0}, {0, 1, {2, 1}, 0}, {0, 1, {1, 1, 1}, 0}, {0, 1, 2, 1}, {0, 1, {1, 1}, 1}, {0, 1, 1, 2}, {0, 1, 1, {1, 1}}, {0, 1, 0, 3}, {0, 1, 0, {2, 1}}, {0, 1, 0, {1, 1, 1}}, {0, 0, 4, 0}, {0, 0, {3, 1}, 0}, {0, 0, {2, 2}, 0}, {0, 0, {2, 1, 1}, 0}, {0, 0, {1, 1, 1, 1}, 0}, {0, 0, 3, 1}, {0, 0, {2, 1}, 1}, {0, 0, {1, 1, 1}, 1}, {0, 0, 2, 2}, {0, 0, 2, {1, 1}}, {0, 0, {1, 1}, 2}, {0, 0, {1, 1}, {1, 1}}, {0, 0, 1, 3}, {0, 0, 1, {2, 1}}, {0, 0, 1, {1, 1, 1}}, {0, 0, 0, 4}, {0, 0, 0, {3, 1}}, {0, 0, 0, {2, 2}}, {0, 0, 0, {2, 1, 1}}, {0, 0, 0, {1, 1, 1, 1}}}