2
$\begingroup$

Suppose that I have a function

prob[n_] := Table[Subscript[p, i], {i, 1, n}]

that generates tuples with n entries that correspond to probabilities. What I would like to do is write a function prob[n_,eps_] that for a given n ≥ 2 and eps (with 0 < eps ≤ 0.10) generates all tuples (including permutations of elements in the tuple) that "differ by eps" (explained below) and satisfy

a) 0 ≤ p_i ≤ 1 for each individual probability in the tuple

b) \sum_i p_i = 1, i.e. the probabilities in the tuple sum to 1

What I mean with "differ by eps" is that, for example, for n=3 and eps=0.10 the list of generated tuples should look like {1,0,0}, {0.9,0.1,0}, {0.9,0,0.1}, {0.8,0.2,0}, {0.8,0.1,0.1},{0.8,0,0.2}, etc.

I suspect that this can be done using another Table[] and/or maybe Map[]. I have tried things like this

prob[n_, \[Epsilon]_] := Map[Table[# &, {x, 0, 1, \[Epsilon]}], Table[Subscript[p, i], {i, 1, n}]]

but of course here Mathematica does not know what "x" is (and also the sum criterion is not implemented).

Any help on this would be much appreciated.

Edit: To clarify what the desired output should be. For n=2, eps=0.1, the function should produce

n2out = {{1, 0}, {0.9, 0.1}, {0.8, 0.2}, {0.7, 0.3}, {0.6, 0.4}, {0.5,
 0.5}, {0.4, 0.6}, {0.3, 0.7}, {0.2, 0.8}, {0.1, 0.9}, {0, 1}};

For n=3 and eps=0.1, the function should produce

n3out = {{1, 0, 0}, {0.9, 0.1, 0}, {0.9, 0, 0.1}, {0.8, 0.2, 0}, {0.8,
 0.1, 0.1}, {0.8, 0, 0.2}, {0.7, 0.3, 0}, {0.7, 0.2, 0.1}, {0.7, 
0.1, 0.2}, {0.7, 0, 0.3}, {0.6, 0.4, 0}, {0.6, 0.3, 0.1}, {0.6, 
0.2, 0.2}, {0.6, 0.1, 0.3}, {0.6, 0, 0.4}, {0.5, 0.5, 0}, {0.5, 
0.4, 0.1}, {0.5, 0.3, 0.2}, {0.5, 0.2, 0.3}, {0.5, 0.1, 
0.4}, {0.5, 0, 0.5}, {0.4, 0.6, 0}, {0.4, 0.5, 0.1}, {0.4, 0.4, 
0.2}, {0.4, 0.3, 0.3}, {0.4, 0.2, 0.4}, {0.4, 0.1, 0.5}, {0.4, 0, 
0.6}, {0.3, 0.7, 0}, {0.3, 0.6, 0.1}, {0.3, 0.5, 0.2}, {0.3, 0.4, 
0.3}, {0.3, 0.3, 0.4}, {0.3, 0.2, 0.5}, {0.3, 0.1, 0.6}, {0.3, 0, 
0.7}, {0.2, 0.8, 0}, {0.2, 0.7, 0.1}, {0.2, 0.6, 0.2}, {0.2, 0.5, 
0.3}, {0.2, 0.4, 0.4}, {0.2, 0.3, 0.5}, {0.2, 0.2, 0.6}, {0.2, 
0.1, 0.7}, {0.2, 0, 0.8}, {0.1, 0.9, 0}, {0.1, 0.8, 0.1}, {0.1, 
0.7, 0.2}, {0.1, 0.6, 0.3}, {0.1, 0.5, 0.4}, {0.1, 0.4, 
0.5}, {0.1, 0.3, 0.6}, {0.1, 0.2, 0.7}, {0.1, 0.1, 0.8}, {0.1, 0, 
0.9}, {0, 1, 0}, {0, 0.9, 0.1}, {0, 0.8, 0.2}, {0, 0.7, 0.3}, {0, 
0.6, 0.4}, {0, 0.5, 0.5}, {0, 0.4, 0.6}, {0, 0.3, 0.7}, {0, 0.2, 
0.8}, {0, 0.1, 0.9}, {0, 0, 1}};

The answer provided by lericr seems to do the trick, but if there are other (possibly more convenient) ways of doing it I'd still be very keen to hear about them.

$\endgroup$
0

3 Answers 3

3
$\begingroup$

If we make the simplifying assumption that eps is of the form 1/n for some integer n, then we can re-conceive of the problem as integer partitions of n (which we then re-scale).

prob[count_, scale_Integer?Positive] := 
  Catenate[Permutations[PadRight[#, count]] & /@ IntegerPartitions[scale, count]]/scale

Usage:

prob[3, 10]
(* {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}, ..., {3/10, 2/5, 3/10}, {3/10, 3/10, 2/5}} *)
$\endgroup$
1
  • $\begingroup$ Yes, this is what I was looking for. Thank you! $\endgroup$ Nov 15, 2023 at 1:00
4
$\begingroup$

I hope I understand correctly what you want.

First we must round 1/n to get an integer: no. Then we can use "IntegerPartitions" to get n-tuples that sum to no. Then we take all permutations of these tuples. Finally we divide by no:

prob[n_, eps_] := Module[{no = Round[1/eps]},
  t = Permutations /@ IntegerPartitions[no, {3}];
  t = Flatten[t, 1];
  t/no // N
  ]

Here is a test of this:

prob[3, 0.1]

{{0.8, 0.1, 0.1}, {0.1, 0.8, 0.1}, {0.1, 0.1, 0.8}, {0.7, 0.2, 
  0.1}, {0.7, 0.1, 0.2}, {0.2, 0.7, 0.1}, {0.2, 0.1, 0.7}, {0.1, 0.7, 
  0.2}, {0.1, 0.2, 0.7}, {0.6, 0.3, 0.1}, {0.6, 0.1, 0.3}, {0.3, 0.6, 
  0.1}, {0.3, 0.1, 0.6}, {0.1, 0.6, 0.3}, {0.1, 0.3, 0.6}, {0.6, 0.2, 
  0.2}, {0.2, 0.6, 0.2}, {0.2, 0.2, 0.6}, {0.5, 0.4, 0.1}, {0.5, 0.1, 
  0.4}, {0.4, 0.5, 0.1}, {0.4, 0.1, 0.5}, {0.1, 0.5, 0.4}, {0.1, 0.4, 
  0.5}, {0.5, 0.3, 0.2}, {0.5, 0.2, 0.3}, {0.3, 0.5, 0.2}, {0.3, 0.2, 
  0.5}, {0.2, 0.5, 0.3}, {0.2, 0.3, 0.5}, {0.4, 0.4, 0.2}, {0.4, 0.2, 
  0.4}, {0.2, 0.4, 0.4}, {0.4, 0.3, 0.3}, {0.3, 0.4, 0.3}, {0.3, 0.3, 
  0.4}}

Addendum

To include entries like {1,0,0} and {0.9,0.1,0} we need to change "IntegerPartition":

prob[n_, eps_] := 
 Module[{no = Round[1/eps]},  
  t = Permutations /@ IntegerPartitions[no, {3}, Range[0, no]];
  t = Flatten[t, 1];
  t/no // N]

prob[3, 0.1]

{{1., 0., 0.}, {0., 1., 0.}, {0., 0., 1.}, {0.9, 0.1, 0.}, {0.9, 0., 
  0.1}, {0.1, 0.9, 0.}, {0.1, 0., 0.9}, {0., 0.9, 0.1}, {0., 0.1, 
  0.9}, {0.8, 0.2, 0.}, {0.8, 0., 0.2}, {0.2, 0.8, 0.}, {0.2, 0., 
  0.8}, {0., 0.8, 0.2}, {0., 0.2, 0.8}, {0.8, 0.1, 0.1}, {0.1, 0.8, 
  0.1}, {0.1, 0.1, 0.8}, {0.7, 0.3, 0.}, {0.7, 0., 0.3}, {0.3, 0.7, 
  0.}, {0.3, 0., 0.7}, {0., 0.7, 0.3}, {0., 0.3, 0.7}, {0.7, 0.2, 
  0.1}, {0.7, 0.1, 0.2}, {0.2, 0.7, 0.1}, {0.2, 0.1, 0.7}, {0.1, 0.7, 
  0.2}, {0.1, 0.2, 0.7}, {0.6, 0.4, 0.}, {0.6, 0., 0.4}, {0.4, 0.6, 
  0.}, {0.4, 0., 0.6}, {0., 0.6, 0.4}, {0., 0.4, 0.6}, {0.6, 0.3, 
  0.1}, {0.6, 0.1, 0.3}, {0.3, 0.6, 0.1}, {0.3, 0.1, 0.6}, {0.1, 0.6, 
  0.3}, {0.1, 0.3, 0.6}, {0.6, 0.2, 0.2}, {0.2, 0.6, 0.2}, {0.2, 0.2, 
  0.6}, {0.5, 0.5, 0.}, {0.5, 0., 0.5}, {0., 0.5, 0.5}, {0.5, 0.4, 
  0.1}, {0.5, 0.1, 0.4}, {0.4, 0.5, 0.1}, {0.4, 0.1, 0.5}, {0.1, 0.5, 
  0.4}, {0.1, 0.4, 0.5}, {0.5, 0.3, 0.2}, {0.5, 0.2, 0.3}, {0.3, 0.5, 
  0.2}, {0.3, 0.2, 0.5}, {0.2, 0.5, 0.3}, {0.2, 0.3, 0.5}, {0.4, 0.4, 
  0.2}, {0.4, 0.2, 0.4}, {0.2, 0.4, 0.4}, {0.4, 0.3, 0.3}, {0.3, 0.4, 
  0.3}, {0.3, 0.3, 0.4}}
$\endgroup$
3
  • $\begingroup$ Thanks, but this is not quite what I was looking for. For example, this list does not include entries of the form {1,0.9,0},{1,0,0.9}, etc.; I've edited my original post to clarify the desired output. I will play around with the suggestions provided here some more, but it seems that the solution provided by lericr does exactly that. $\endgroup$ Nov 15, 2023 at 1:02
  • $\begingroup$ I added a part that includes tuples like {1,0,0}, {0.9,0.1,0}.. $\endgroup$ Nov 15, 2023 at 10:53
  • $\begingroup$ Thanks! This works as intended. $\endgroup$ Nov 17, 2023 at 1:52
1
$\begingroup$

FrobeniusSolve

prb[n_, eps_] := N @ eps  FrobeniusSolve[Table[1, n], Ceiling[1/eps]]

prb[2, .1]
{{0., 1.}, {0.1, 0.9}, {0.2, 0.8}, {0.3, 0.7}, {0.4, 0.6},   
 {0.5, 0.5}, {0.6, 0.4}, {0.7, 0.3}, {0.8, 0.2}, {0.9, 0.1}, {1., 0.}}
prb[2, .2]
{{0., 1.}, {0.2, 0.8}, {0.4, 0.6}, {0.6, 0.4}, {0.8, 0.2}, {1., 0.}}
prb[3, .2]
{{0., 0., 1.}, {0., 0.2, 0.8}, {0., 0.4, 0.6}, {0., 0.6, 0.4},   
 {0., 0.8, 0.2}, {0., 1., 0.}, {0.2, 0., 0.8}, {0.2, 0.2, 0.6},   
 {0.2, 0.4, 0.4}, {0.2, 0.6, 0.2}, {0.2, 0.8, 0.},   
 {0.4, 0., 0.6}, {0.4, 0.2, 0.4}, {0.4, 0.4, 0.2},   
 {0.4, 0.6, 0.}, {0.6, 0., 0.4}, {0.6, 0.2, 0.2}, {0.6, 0.4, 0.},  
 {0.8, 0., 0.2}, {0.8, 0.2, 0.}, {1., 0., 0.}}

IntegerPartitions + Permutations

prb2[n_, eps_] := Module[{m = Round[1/eps]}, 
  eps  Apply[Join] @ Map[Permutations] @ IntegerPartitions[m, {n}, Range[0, m]]]

Examples:

prb2[2, .2]
 {{1., 0.}, {0., 1.}, {0.8, 0.2}, {0.2, 0.8}, {0.6, 0.4}, {0.4, 0.6}}
prb2[2, .1]
 {{1., 0.}, {0., 1.}, {0.9, 0.1}, {0.1, 0.9}, {0.8, 0.2},  
  {0.2, 0.8}, {0.7, 0.3}, {0.3, 0.7}, {0.6, 0.4}, {0.4, 0.6}, {0.5, 0.5}}
prb2[3, .2]
 {{1., 0., 0.}, {0., 1., 0.}, {0., 0., 1.}, {0.8, 0.2, 0.},  
  {0.8, 0., 0.2}, {0.2, 0.8, 0.}, {0.2, 0., 0.8},   
  {0., 0.8, 0.2}, {0., 0.2, 0.8}, {0.6, 0.4, 0.},   
  {0.6, 0., 0.4}, {0.4, 0.6, 0.}, {0.4, 0., 0.6},   
  {0., 0.6, 0.4}, {0., 0.4, 0.6}, {0.6, 0.2, 0.2},   
  {0.2, 0.6, 0.2}, {0.2, 0.2, 0.6}, {0.4, 0.4, 0.2},   
  {0.4, 0.2, 0.4}, {0.2, 0.4, 0.4}}
$\endgroup$
1
  • $\begingroup$ This is very nice. Thank you! $\endgroup$ Nov 15, 2023 at 9:35

Your Answer

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

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