Problem 3 - I did them out of order.
​
The Counts command gives the number of times every element in the list occurs. Elements are listed in the order they are encountered in the list.
In[]:=
Counts[{1,1,2,4,4,3,1,2,a,bc}]
Out[]=
13,22,42,31,a1,bc1
If the length of this list is equal to the number of possible entries, then every possible entry occurred at least once.
counter=0;​​trials=1000000;​​people=30;​​units=12;​​Do[If[Length[Counts[RandomInteger[{1,units},people]]]==units,counter++],​​{k,1,trials}]​​Print[counter/trials1.]
0.359139
Problem 1
​
The DeleteDuplicates command does what it say - deletes duplicates. If there are no duplicates, nothing is deleted and every element in the list occurred only once.
In[]:=
counter2=0;​​trials=1000000;​​population=1000000;​​samplesize=2000;​​Do[​​If[Length[DeleteDuplicates[RandomInteger[{1,population},samplesize]]]==samplesize,counter2++],{j,1,trials}];​​Print[1.-counter2/trials]
0.864288
Problem 2
​
Very similar to the previous problem - I used DeleteDuplicates to see if any district had more than one robbers. The first element in the list is the district in which the first crime was committed, the second is the list in which the second crime was committed, and so on.
In[]:=
count3=0;​​districts=6;​​robberies=6;​​trials=1000000;​​Do[If[Length[DeleteDuplicates[RandomInteger[{1,districts},robberies]]]==districts,count3++],{n,1,trials}]​​Print[1.-count3/trials]
0.984687
Bonus! Let’s simulate homework problem 20. We place n balls into n boxes, and we want to know the probability that no ball is placed into a box of the same color. This is the opposite of the de Montmort problem, so we expect the probability to be close to 1-(1-1/e).
In[]:=
1./E
Out[]=
0.367879
Let’s write some code to test this. The code below will place a 0 if the box is the same color as the ball. We want to estimate the probability that there are no 0’s. If there are no 0’s, every ball was in a box of a different color.
In[]:=
n=4;​​RandomSample[Range[1,n],n]-Table[i,{i,1,n}]
Out[]=
{0,0,1,-1}
In[]:=
counter=0;​​If[Count[RandomSample[Range[1,n],n]-Table[i,{i,1,n}],0]==0,counter++];​​Print[counter]
0
Looks like it’s working. Let’s do many trials!
In[]:=
counter=0;​​trials=100000;​​Do[​​If[Count[RandomSample[Range[1,n],n]-Table[i,{i,1,n}],0]==0,counter++],​​{m,1,trials}];​​Print[counter/trials1.]
0.37582