4
$\begingroup$

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?

$\endgroup$
  • $\begingroup$ << Combinatorica`; RandomComposition[100, 10] $\endgroup$ – Dr. belisarius Nov 1 '15 at 19:20
  • $\begingroup$ And then some post-processing .... $\endgroup$ – Dr. belisarius Nov 1 '15 at 19:20
  • $\begingroup$ Oh, thanks. Actually, RandomComposition is now inbuilt $\endgroup$ – eldo Nov 1 '15 at 19:25
  • $\begingroup$ Depending on what exactly you want for distribution of the random partitions, there might be reponses in this recent MSE thread that can be of use. $\endgroup$ – Daniel Lichtblau Nov 1 '15 at 19:25
  • $\begingroup$ @eldo I don't think RandomComposition is built-in. At least not in my version 10.3 $\endgroup$ – Sjoerd C. de Vries Nov 1 '15 at 19:27
13
$\begingroup$
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

Mathematica graphics

$\endgroup$
  • $\begingroup$ Why did you change RandomChoice to RandomSample ? $\endgroup$ – eldo Nov 1 '15 at 22:01
  • $\begingroup$ I thought you might not want empty partitions that potentially can occur if you use RandomChoice. If that's no problem for you, you can change it back. $\endgroup$ – Sjoerd C. de Vries Nov 1 '15 at 22:16

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.