Random Partitions

Question

I want to write a function RandomPartition to partition a vector of length n into p partitions of varying (random) lengths.

For example with

n = 100;
p = 10;

Choose from many (here 10^6) "partition lists" the list whose total is nearest to n:

tab = Table[RandomInteger[{1, n - p + 1}, p], {10^6}];

dif = Map[n - # &, Total /@ tab];

min = First @ MinimalBy[dif, Abs]

-16

res = Flatten[#, 1] & @ tab[[FirstPosition[dif, min]]]

{6, 3, 2, 19, 29, 7, 5, 2, 21, 22}

Total @ res

116

The sum of the elements should be n = 100:

pos = FirstPosition[res, a_ /; a > Abs @ min];
res[[pos]] += min;

res

{6, 3, 2, 3, 29, 7, 5, 2, 21, 22}

 Total @ res

100

Create a list of partitions:

par = Partition[Accumulate @ res, 2, 1] /. {a_, b_} :> {a + 1, b}

{{7, 9}, {10, 11}, {12, 14}, {15, 43}, {44, 50}, {51, 55}, {56, 57}, {58, 78}, {79, 100}}

par = Span @@@ Join[{{1, First @ res}}, par]

{1 ;; 6, 7 ;; 9, 10 ;; 11, 12 ;; 14, 15 ;; 43, 44 ;; 50, 51 ;; 55, 56 ;; 57, 58 ;; 78, 79 ;; 100}

Range[n][[#]] & /@ par

{{1, 2, 3, 4, 5, 6}, {7, 8, 9}, {10, 11}, ..., {79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100}}

I am, of course, unhappy with this "solution", especially with the big table I have to depart from.

Isn't there a more elegant algorithm?

Answer 1

RandomPartition[n_, p_] :=
Module[{r},
  r = RandomSample[Range[n - 1], p - 1] // Sort;
  AppendTo[r, n];
  Prepend[r // Differences, r[[1]]]
]    

RandomPartition[100, 16]
(* {4, 1, 4, 3, 12, 5, 13, 3, 9, 8, 2, 2, 12, 11, 1, 10} *)

RandomPartition[100, 16] // Total
(* 100 *)

Testing:

And @@ Table[
  n = RandomInteger[100000];
  p = RandomInteger[{1, n}];
  {p, n} == Through[{Length, Total}[RandomPartition[n, p]]], {1000}
  ]
(* True *)

And a demo:

Table[
  BlockMap[
   {RandomColor[], Rectangle[{#[[1]], y}, {#[[2]], y + 1}]} &, 
   Accumulate@Prepend[0]@RandomPartition[100, 16], 2, 1
  ],
  {y, 100}
] // Graphics