Wsrtjtyk

I have 4 empty lists. I would like to randomly distribute numbers from 1 to 10 to these 4 empty lists. How can I add integers to lists randomly?

For example:

m = {};

n = {};

p = {};

r = {};

listz = Range[10];

1->m , 2->n , 3->p , 4->m , 5->r , 6->r, 7->n , 8->m, 9->p , 10->n (Randomly distributed)

Here is the code I tried:

m = {};

n = {};

p = {};

r = {};

listz = Range[10];

s = RandomChoice[{m, n, p, r}, 4];

Do[listm = AppendTo[s, listz[i]];, {i, 1, 10}]

listm

Wanted Solution:(Randomly distributed)

m = {1, 5, 8}

n = {4, 6, 9}

p = {7, 10}

r = {2, 3}

on Mathematica 11.3

(R=RandomSample)[Range@10,10]~TakeList~R@RandomChoice[Select[IntegerPartitions@10,Length@#==4&]]    

Also I tried to fix your code

a = {};

b = {};

c = {};

d = {};

Listz = {a, b, c, d};

Do[t=RandomChoice@Range@4;Listz[[t]]=AppendTo[Listz[[t]],i],{i,1,10}]

Listz

n = 100;

m = 4;

list = Range[n];

s = RandomChoice[Range[m], n];



SparseArray[Transpose[{s, list}] -> _, {m, n}]["AdjacencyLists"]

Or slower, but easier to understand:

Lookup[GroupBy[Transpose[{s, list}], First -> Last], Range[m]]

Why not use MultinomialDistribution of a random sample? For example:

rand[n_, s_] := TakeList[

    RandomSample[Range[n]],

    RandomVariate[MultinomialDistribution[n, ConstantArray[1/s, s]]]

]



rand[10, 4]

{{4, 6, 1}, {2}, {5, 9, 8, 7, 3}, {10}}

listz = CharacterRange["A", "K"];

k = 4;



SeedRandom[1]

rc = RandomChoice[Range @ k, Length @ listz];

{m, n, p, r} = Pick[listz, rc, #]& /@ Range[k]

{{"C", "F", "G", "H", "K"}, {"B", "D", "E", "I"}, {}, {"A", "J"}}

Also

Lookup[GroupBy[Transpose[{rc, listz}], First -> Last], #, {}]& /@ Range[k] 

AdjacencyList[Graph[Range[k], Thread[rc -> listz]], # ] & /@ Range[k]

both give the same result. Also, using Carl Woll's GatherByList:

RandomSample[PadRight[GatherByList[listz, rc], {k, Automatic}, {}]]

{{"A", "J"}, {}, {"C", "F", "G", "H", "K"}, {"B", "D", "E", "I"}}

Update: To get k non-empty sublists:

SeedRandom[1]

rc = Module[{r}, While[Length[Counts[r = RandomChoice[Range@k, Length @ listz]]] < k]; r];



Pick[listz , rc, # ] & /@ Range[k]

Lookup[GroupBy[Transpose[{rc , listz}], First -> Last], #, {}] & /@ Range[k] 

AdjacencyList[Graph[Range[k], Thread[rc -> listz]], # ] & /@ Range[k]

all give

{{"A", "B", "C", "E", "H", "I"}, {"F"}, {"D", "G"}, {"J", "K"}}

GatherByList[listz, rc] 

{{"A", "B", "C", "E", "H", "I"}, {"D", "G"}, {"F"}, {"J", "K"}}

Update 2:

You can also use the function RandomKSetPartition from the Combinatorica package:

Quiet @ Needs["Combinatorica`"]

SeedRandom[1] 

RandomKSetPartition[listz, 4]

{{"A", "D", "H"}, {"B"}, {"C", "F", "J", "K"}, {"E", "G", "I"}}

Edit: I realized that my previous solution doesn't produce the same length partitions. Here is the desired solution.

s = RandomSample[Range@10, 10];

t = RandomSample@RandomChoice@IntegerPartitions[10, {4}]

{m, n, p, r} = TakeList[s, t]



(*or {m, n, p, r} = FoldPairList[TakeDrop, s, t]*)

{{1, 5, 10}, {3, 7}, {2, 9, 6, 8}, {4}}

Original answer:

s = RandomSample[Range@10, 10];

t = RandomSample[Range@4, 4];

{m, n, p, r} = FoldPairList[TakeDrop, s, t]

{{6, 2}, {9}, {5, 1, 7}, {10, 3, 8, 4}}

A fast and short way is to utilize Pick. For this, we will need two commands:

ClearAll[distribute];

distribute[list_, partNum_] := RandomInteger[partNum - 1, Length@list]

creates a number sequence which will assign each element to a list. And we do this with

ClearAll[splitList];

splitList[list_, partitionNumber_] := With[

     {selection = distribute[list, partitionNumber]}, 

     Table[Pick[list, selection, i], {i, 0, partitionNumber - 1}]

]

That's it. The code is fast enough; on my laptop, it takes less than half a second to split a list of $10^7$ elements into 3 lists:

splitList[Range[10^7], 3] // RepeatedTiming

(* {0.42,...} *)

It becomes slower if the number of list increases, as it is not optimized in that direction. Still, it should be fast enough, for example:

splitList[Range[10^7], 10^3] // RepeatedTiming

(* {8.3,...} *)