1
$\begingroup$

I have a list with 25 numbers:

list = Range[1, 25];

What would be a simple code that could generate 44 new lists with 15 numbers each one of them? Also need to check if there is no list of repeated and that the sum total of all lists, the elements have been used also, if possible.

Below I am describing my attempts:

Here I determine "manually" an initial list with a basis of 9 numbers:

B1 = {01, 03, 06, 09, 11, 12, 16, 21, 23}

As my list contains 25 numbers, here I get the 16 remaining numbers:

O1 = Complement[list, B1]

Here I have tried to mix the remaining numbers:

Dif1 = RandomSample[O1]

Here I create the first three lists with 15 numbers:

J1 = Join[B1, Part[Dif1, {1, 2, 3, 4, 5, 6}]]
Length[J1]
J2 = Join[B1, Part[Dif1, {7, 8, 9, 10, 11, 12}]]
Length[J2]
J3 = Join[B1, Part[Dif1, {13, 14, 15, 16, 1, 2}]]
Length[J3]

Here I see the use of numbers in the list are also used:

Soma = Tally[Sort[Join[J1, J2, J3]]]

I am evolving my way, but I am observing that is not very productive.

$\endgroup$
2
  • $\begingroup$ Perhaps newlists = Table[RandomSample[Range[25], 15], {44}] and then Complement[Range[25], Flatten[newlists]] to verify that all numbers were used $\endgroup$
    – Bill
    Jun 5, 2016 at 6:47
  • $\begingroup$ Length[Union[newlists]] will tell you if there are repeated lists. Histogram[Sort[Map[Length,Flatten[Outer[ Intersection, newlists, newlists, 1], 1]]]] will show you a histogram of all lengths of intersections between pairs of lists. Leave off Histogram to see actual numbers. For[i = 1, i <= 44, i++, ToExpression["J" <> ToString[i] <> "=" <> ToString[newlists[[i]]]]] will assign each list to a variable name $\endgroup$
    – Bill
    Jun 5, 2016 at 22:10

3 Answers 3

2
$\begingroup$

I'm not sure why all the machinations here - unless I misunderstand your question completely, @Bill has the correct and simple solution:

{j1, j2, j3, j4, j5, j6, j7, j8, j9, j10, j11, j12, j13, j14, j15, 
   j16, j17, j18, j19, j20, j21, j22, j23, j24, j25, j26, j27, j28, 
   j29, j30, j31, j32, j33, j34, j35, j36, j37, j38, j39, j40, j41, 
   j42, j43, j44} = allLists = Table[RandomSample[Range@25, 15], 44];

Gives you the 44 lists in the desired symbols (note I used lowercase j - it is generally a bad idea to name your symbols with leading capitalization, it might inadvertently clash with a built-in name).

To see the counts for each list:

Sort[Tally@#]&/@allLists

To see the counts for all the lists combined:

Sort@Tally@Flatten@allLists

To check no list is an exact duplicate of another:

Length@allLists == Length@DeleteDuplicates@allLists

To check no list has exactly the same elements as another:

Length@allLists == Length@DeleteDuplicates[Sort /@ allLists]

The first two tests are rather superfluous: the probability of two of your 44 lists being the same is ~2.2*10^-16, and for a number from the 25 to be missing from all lists is ~7.7*10^-17. In other words, unless you plan on generating trillions of such sets, the chance of such events is negligible. If having the same elements (order does not matter), it's still small, ~0.00029 per set of 44.

$\endgroup$
3
$\begingroup$

Here is one way to do it.

list = Range[31, 60]; (*any list*)
nlist = Length[list]

nlist1 = 10  (*element in small list*)

nbiglist = 40; (*number of small lists*)

biglist = {list[[#]] & /@ RandomSample[1 ;; nlist, nlist1]};
nbg = Length[biglist];
While[nbg < nbiglist,
 new = list[[#]] & /@ RandomSample[1 ;; nlist, nlist1];
 biglist = Join[biglist, {new}] // Union;
 nbg = Length[biglist]]

Union will remove if there is any repetition. All your lists are recorded in biglist. Lets see the first five lists.

ListLinePlot[biglist[[1 ;; 5]]]

enter image description here

And finally to see which number appears how many times, just use Histogram.

Histogram[Flatten[biglist], nlist]

enter image description here

$\endgroup$
0
1
$\begingroup$

Your problem is tremendously overdetermined:

Permutations[Range[25], {16}]

returns "Permutations[...] cannot be computed because its length is 42744736671436800000 ... Eliminating the repeated arrangements, still there are over 2 million combinations. I'll build a particular solution that is arbitrary but not random.

I'll cast these numbers (44, 25) in constants, to make the solution look more generic

numberOfCombinations = 44; numbersInSource = 25;

FactorInteger[numberOfCombinations]
{{2, 2}, {11, 1}}

Therefore, we need 3 groups of numbers and make 2 combinations for two of them and 11 combinations for the last one. Since you need 15 numbers in each combinations, the easiest way is

p1 = {{1, 2}, {3, 4}}
p2 = Length[ Union[Flatten[p1]] ] + p1
numbersUsed = Length[ Union[Flatten[p1]] ] + Length[ Union[Flatten[p2]] ]
numbersLeft = numbersInSource - numbersUsed

This last instruction returns 17. Therefore, we must make 11 combinations of 11 numbers from 17 numbers - 6 fixed and 1 sweeping the rest of the range will do.

p3 = Table[ Join[{i}, Range[numbersUsed + 11 + 1, numbersInSource]], {i, numbersUsed + 1, numbersUsed + 11}];
combinations = Flatten[ Table[ Union[p1[[i]], p2[[j]], p3[[k]]], {i, Length[p1]}, {j, Length[p2]}, {k, Length[p3]}] , 2];

Using TableForm[combinations], you can see all the combinations and the structure of the set. You can check how many combinations were made

Length[combinations ]
44

and that they exhaust the source

Union[Flatten[combinations ]] == Range[numbersInSource]
True

I have used Length[ Union[Flatten[ list ] ] ] to count how many values were embodied in the list to make the algorithm more generic. However, I am not sure whether this can be applied to all combinatorial problems like this.

$\endgroup$
1
  • $\begingroup$ No worry. I was unable to figure out if you wanted random combinations or some sort of structured combinations. $\endgroup$
    – Vito Vanin
    Jun 6, 2016 at 22:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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