4
$\begingroup$

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}
$\endgroup$
  • $\begingroup$ Why not just generate four random lists in the first place? $\endgroup$ – gothicVI Nov 4 '18 at 20:00
4
$\begingroup$

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
$\endgroup$
  • $\begingroup$ Have you tried that with a list of 100 elements? $\endgroup$ – Henrik Schumacher Nov 4 '18 at 21:18
  • $\begingroup$ how about 10^100? $\endgroup$ – J42161217 Nov 4 '18 at 21:20
  • 1
    $\begingroup$ @J42161217 Because Select[IntegerPartitions@10, Length@# == 4 &] sorted, you cannot get Lenght=1or 2 set for m. $\endgroup$ – OkkesDulgerci Nov 4 '18 at 21:23
  • $\begingroup$ @OkkesDulgerci fixed! $\endgroup$ – J42161217 Nov 4 '18 at 21:25
2
$\begingroup$
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]]
$\endgroup$
  • $\begingroup$ Is this supposed to spew errors in 11.3? $\endgroup$ – user6014 Nov 4 '18 at 20:06
  • $\begingroup$ Ah, sorry. Please try again. $\endgroup$ – Henrik Schumacher Nov 4 '18 at 20:10
  • $\begingroup$ Sorry, I couldn't understand what sparsearray function does here. But thanks this code is working. $\endgroup$ – ithilquessirr Nov 4 '18 at 20:19
  • $\begingroup$ Well, you might inspect MatrixForm@Normal[SparseArray[Transpose[{s, listz}] -> _, {mm, nn}]] to find that out. $\endgroup$ – Henrik Schumacher Nov 4 '18 at 20:52
2
$\begingroup$

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}}

$\endgroup$
2
$\begingroup$
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"}}

$\endgroup$
1
$\begingroup$

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}}

$\endgroup$
1
$\begingroup$

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,...} *)
$\endgroup$

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.