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$
7
  • $\begingroup$ << Combinatorica`; RandomComposition[100, 10] $\endgroup$ Nov 1, 2015 at 19:20
  • $\begingroup$ And then some post-processing .... $\endgroup$ Nov 1, 2015 at 19:20
  • $\begingroup$ Oh, thanks. Actually, RandomComposition is now inbuilt $\endgroup$
    – eldo
    Nov 1, 2015 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$ Nov 1, 2015 at 19:25
  • $\begingroup$ @eldo I don't think RandomComposition is built-in. At least not in my version 10.3 $\endgroup$ Nov 1, 2015 at 19:27

1 Answer 1

16
$\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$
2
  • $\begingroup$ Why did you change RandomChoice to RandomSample ? $\endgroup$
    – eldo
    Nov 1, 2015 at 22:01
  • 1
    $\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$ Nov 1, 2015 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.