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}

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.

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

How to find all sets of elements smaller than another group

2 Answers

Edit

Add your own answers!

Ask a Question