How to find all sets of elements smaller than another group

Question

Source of this problem:

A: There are nine tetrahedral dice (each dice has four sides of 1,2,3,4)
B: There are 6 hexahedral dice (each dice has six faces, 1,2,3,4,5,6)
If two people roll dice, the one with the largest number wins.
What is the probability of A winning B?

I calculate the problem in the following way:
Clear["Global`*"]
A = Range[9, 36];
B = Range[6, 36];

data = Tuples[{1, 2, 3, 4}, 9(*Nine tetrahedral dice*)];(*Equal probability event*)
p1 = Evaluate[Array[tetrahedron, Length[A]]] = 
  Tally[Total /@ data][[All, 2]]/4^9;
data = Tuples[{1, 2, 3, 4, 5, 6}, 
  6(*Six hexahedral dice*)];(*Equal probability event*)
p2 = Evaluate[Array[hexahedron, Length[B]]] = 
  Tally[Total /@ data][[All, 2]]/6^6;
s = Table[p2[[6 - 6 + 1 ;; 9 - 6 + i]], {i, 0, Length[A] - 1}];
Total[Table[Total[(p1[[i]]*s[[i]])], {i, 1, Length[A]}]]//N
(*Violence simulation results*)
Count[Table[If[Total[RandomInteger[{1, 4}, 9]] >
     Total[RandomInteger[{1, 6}, 6]], 1, 0], 1000000], 1]/1000000.

In calculating this problem, I encountered some array operation problems.  I extracted them and described them as follows:
First question
I've got two sets of data a and B (simulating nine tetrahedral and six hexahedral dice):
A = Range[9, 36]
B = Range[6, 36]

Now I want to get the set of elements in group B that are smaller than each element in group A one by one:
{9, {6, 7, 8}}
{10, {6, 7, 8, 9}}
{11, {6, 7, 8, 9, 10}}
 ...
{36, {6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 
  23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35}}

What should I do to get the desired result? In addition, it is better to use a general method, because we need to consider two irregular arrays.

Second question
In addition, how to efficiently split an array step by step?
{1, 2, 4, 6, 8, 7, 9, 3}

I want to split the above array from position 2 to position 6 as follows:
{1, 2}
{1, 2, 4}
{1, 2, 4, 6}
{1, 2, 4, 6, 8}
{1, 2, 4, 6, 8, 7}

ciao · Accepted Answer

I shall not further address part 1 beyond the comment by Harry - there are several ways to do this efficiently, but at the core the method you use to calculate the exact probability will blow up when the number of dice / faces grows and it will quickly become unusable.
As for part 2, one method:
buildstartingat= 
  FoldList[Append, #1[[;; #2]], #1[[#2 + 1 ;; #3]]] &;

Using your example:

buildstartingat[{1, 2, 4, 6, 8, 7, 9, 3}, 2, 6]
{{1,2},{1,2,4},{1,2,4,6},{1,2,4,6,8},{1,2,4,6,8,7}}

As for calculating such battle probabilities, one method that will actually work with large cases and is fairly efficient:
firstwinsc[{a_, b_}, {c_, d_}, p_ : Infinity] := Module[{k, l, x, y},
   k = N[CoefficientList[Expand[Sum[x^y/b, {y, b}]^a], x], p];
   l = N[CoefficientList[Expand[Sum[x^y/d, {y, d}]^c], x], p];
   Tr[Rest[k]*PadRight[Most[Accumulate@l], Length@k - 1, 1]]];

Usage is firstwinsc[{number of a dice, faces on a dice},{number of b dice,faces on b dice},precision (optional)]
For example, to calculate the probability A wins rolling 10D20 vs B rolling 20D10:

firstwinsc[{10,20},{20,10},MachinePrecision]//AbsoluteTiming
{0.0023191,0.403326}

Sjoerd Smit · Answer

You can calculate this exactly with OrderDistribution:
Probability[max9D4 > max6D6,
 {
  max9D4 [Distributed] OrderDistribution[{DiscreteUniformDistribution[{1, 4}], 9}, 9],
  max6D6 [Distributed] OrderDistribution[{DiscreteUniformDistribution[{1, 6}], 6}, 6]
  }
 ]
N[%]

44495381/3057647616

0.0145522

Simple MC simulation to check:
nSim = 10^6;
Counts @ MapThread[
  Max[#1] > Max[#2] &,
  {
   RandomInteger[{1, 4}, {nSim, 9}],
   RandomInteger[{1, 6}, {nSim, 6}]
  }
]
Lookup[%, True, 0]/Total[%]
N[%]

<|False -> 985252, True -> 14748|>

3687/250000

0.014748

Edit
If you instead want to use the total of all dice in a throw (instead of the max), we can do the following. First we generate the tuples of throws and tally the totals:
totals9D4 = CountsBy[Tuples[Range[4], 9], Total];
totals6D6 = CountsBy[Tuples[Range[6], 6], Total];

We can convert these counts to probability distributions with EmpiricalDistribution which we can then use in Probability:
Probability[
 throwA > throwB,
 {
  throwA [Distributed] 
   EmpiricalDistribution[Values[totals9D4] -> Keys[totals9D4]],
  throwB [Distributed] 
   EmpiricalDistribution[Values[totals6D6] -> Keys[totals6D6]]
  }
 ]
N[%]

48679795/84934656

0.573144

A quick verification with NProbability:
NProbability[
 Total[Array[throwA, 9]] > Total[Array[throwB, 6]],
 {
  Array[throwA, 9] [Distributed] ProductDistribution[{DiscreteUniformDistribution[{1, 4}], 9}],
  Array[throwB, 6] [Distributed] ProductDistribution[{DiscreteUniformDistribution[{1, 6}], 6}]
  },
  Method -> "MonteCarlo"
]

0.573181

If you need to call Tuples with bigger arguments, I recommend taking a look at my lazyLists package which allows you to iterate over large lists of tuples without holding them all in memory.

How to find all sets of elements smaller than another group

2 Answers

Edit

Add your own answers!

Ask a Question