Probability of All Combinations of Given Events

Question

Given a sequences of events with probabilities between 0.0 and 1.0, generate and derive the probability of each combination occurring. You may presume that a sequence of numbers is provided in whatever construct your chosen language provides.

Here's an example; you may presume that the length of the sequence's combinations fit into memory:

{ 0.55, 0.67, 0.13 }

The program shall print each combination and the associated probability of that sequence occurring. A 1 shall denote that the event in that index of the input sequence occurred and a 0 shall denote that that event did not occur. The desired output is below (I don't care about printing the work, that's just for informational purposes of the algorithm):

[0,0,0] = (1 - 0.55) * (1-0.67) * (1-0.13) = 0.129195
[0,0,1] = (1 - 0.55) * (1-0.67) * (0.13)   = 0.019305
[0,1,0] = (1 - 0.55) * (0.67)   * (1-0.13) = 0.262305
[0,1,1] = (1 - 0.55) * (0.67)   * (0.13)   = 0.039195
[1,0,0] = (0.55)     * (1-0.67) * (1-0.13) = 0.157905
[1,0,1] = (0.55)     * (1-0.67) * (0.13)   = 0.023595
[1,1,0] = (0.55)     * (0.67)   * (1-0.13) = 0.320595
[1,1,1] = (0.55)     * (0.67)   * (0.13)   = 0.047905

This problem is tangentially related to calculating a "Cartesian product".

Remember, this is code-golf, so the code with the fewest number of bytes wins.

Answer 1

Haskell, 86 bytes

unlines.map(\p->show(fst<$>p)++" = "++show(product$snd<$>p)).mapM(\x->[(0,1-x),(1,x)])

Usage example:

Prelude> putStrLn $ unlines.map(\p->show(fst<$>p)++" = "++show(product$snd<$>p)).mapM(\x->[(0,1-x),(1,x)]) $ [0.55, 0.67, 0.13]
[0,0,0] = 0.12919499999999998
[0,0,1] = 1.9304999999999996e-2
[0,1,0] = 0.262305
[0,1,1] = 3.9195e-2
[1,0,0] = 0.157905
[1,0,1] = 2.3595e-2
[1,1,0] = 0.320595
[1,1,1] = 4.790500000000001e-2

Most of the bytes are spent for output formatting. If you are only interested in the probability vector it's only 29 bytes:

map product.mapM(\x->[1-x,x])

How it works:

                    mapM(\x->[(0,1-x),(1,x)])   -- for each number x in the input
                                                -- list make either the pair (0,1-x)
                                                -- or (1,x). Build a list with
                                                -- all combinations

    map(\p->                    )               -- for each such combination p
          show(fst<$>p)                         -- print the first elements
          ++" = "++                             -- then the string " = "
          show(product$snd<$>p)                 -- then the product of the second
                                                -- elements

unlines                                         -- joins with newlines

Answer 2

Mathematica, 46 45 bytes

(s=#;1##&@@Abs[#-s]&/@{1,0}~Tuples~Length@s)&

Takes a list. Even works for the empty list {}, for which the output is {1}.

Test case:

%[{0.55, 0.67, 0.13}]
{0.129195, 0.019305, 0.262305, 0.039195, 0.157905, 0.023595, 0.320595, 0.047905}

Explanation

Given a list of probabilities s and a list of bits b with 0 denoting "did not occur" and 1 denoting "did occur", the list of probabilities to be multiplied is given by

1 - b - s

up to sign. If instead 0 denotes "did occur" and 1 "did not occur", then this simplifies to

b - s

so we:

                      {1,0}~Tuples~Length@s   (* Generate all possible bit combinations *)
              (#-s)&/@{1,0}~Tuples~Length@s   (* Generate probabilities to be multiplied
                                                  up to sign *)
     1##&@@Abs[#-s]&/@{1,0}~Tuples~Length@s   (* Correct sign and multiply;
                                                 1##& is short for Times *)
(s=#;1##&@@Abs[#-s]&/@{1,0}~Tuples~Length@s)& (* Assign s to first argument of function,
                                                 done separately to avoid clash
                                                 with inner function *)

Answer 3

Perl, 42 40 bytes

Includes +1 for -a

Give numbers on STDIN:

perl -M5.010 combi.pl <<< "0.55 0.67 0.13"

outputs

0.129195
0.019305
0.262305
0.039195
0.157905
0.023595
0.320595
0.047905

combi.pl:

#!/usr/bin/perl -a
$"=")\\*({1-,}";say eval for<({1-,}@F)>

Answer 4

MATL, 12 11 bytes

TF-|Z}&Z*!p

Input is a column vector, with the format [0.55; 0.67; 0.13]

Try it online!

TF    % Push [1, 0]
-     % Subtract from implicit input (column array), with broadcast. Gives a 2-col
      % matrix where the first column is the input minus 1 and the second is the input
|     % Absolute value
Z}    % Split the matrix into its rows
&Z*   % Cartesian product of all resulting. This gives a matrix as result, with each
      % "combination" on a different row
!p    % Product of each row. Implicitly display

Answer 5

Perl, 116 bytes

for(glob"{0,1}"x(@a=split/ /,<>)){@c=split//;$d=1;$d*=@c[$_]?$a[$_]:1-$a[$_]for 0..$#a;say"[".join(",",@c)."] = $d"}

Readable:

for(glob"{0,1}"x(@a=split/ /,<>)){
    @c=split//;
    $d=1;$d*=@c[$_]?$a[$_]:1-$a[$_]for 0..$#a;
    say"[".join(",",@c)."] = $d"
}

Creates a list of all possible combinations of 0s and 1s of length equal to the number of input parameters (e.g., for the example above, it would be of length 3), then calculates each probability.

Thanks to @Dada for showing me what the glob function can do, even though I'm not 100% sure I understand how it does that.

Sample output:

[0,0,0] = 0.129195
[0,0,1] = 0.019305
[0,1,0] = 0.262305
[0,1,1] = 0.039195
[1,0,0] = 0.157905
[1,0,1] = 0.023595
[1,1,0] = 0.320595
[1,1,1] = 0.047905

Answer 6

R, 72 69 bytes

Takes input from stdin and returns an R-vector of probabilities.

apply(abs(t(expand.grid(rep(list(1:0),length(x<-scan())))-x)),1,prod)

Edit: Removed one unnecessary transpose, the permutation matrix is now the transposed version of the one below and the probabilities are calculated as the column-wise product rather than row-wise. Example output:

[1] 0.129195 0.157905 0.262305 0.320595 0.019305 0.023595 0.039195 0.047905

Note that the probabilities are in a different order due to the fact that the permutation-matrix generated by expand.grid produces the following (generation of this matrix can probably be golfed using external packages):

1    1    1    1
2    0    1    1
3    1    0    1
4    0    0    1
5    1    1    0
6    0    1    0
7    1    0    0
8    0    0    0

The first probability corresponds to the inverted outcome of the first row in the above matrix and the second to the inverted second row etc. Formatting output to see this even more clearly makes the program longer (164 bytes):

m=expand.grid(rep(list(1:0),length(x<-scan())))
cat(paste0("[",apply(abs(m-1),1,function(x)paste0(x,collapse=",")),"] = ",apply(abs(t(t(m)-x)),1,prod),"\n"),sep="")

which instead produces:

[0,0,0] = 0.129195
[1,0,0] = 0.157905
[0,1,0] = 0.262305
[1,1,0] = 0.320595
[0,0,1] = 0.019305
[1,0,1] = 0.023595
[0,1,1] = 0.039195
[1,1,1] = 0.047905

Answer 7

Jelly, 9 bytes

ż@C×þF¥@/

Try it online!

Answer 8

J, 14 bytes

-.([:,*/)/@,.]

Usage

   f =: -.([:,*/)/@,.]
   f 0.55 0.67 0.13
0.129195 0.019305 0.262305 0.039195 0.157905 0.023595 0.320595 0.047905

Explanation

-.([:,*/)/@,.]  Input: array P
-.              Complement (1-x) for each x in P
             ]  Identity, get P
           ,.   Interleave to make pairs [(1-x), x]
  (     )/@     Reduce from right-to-left by
      */          Forming the multiplication table
   [:,            Flattening the result

Answer 9

Pyth, 10 bytes

*MaVLQ^U2l

Try it online: Demonstration

Explanation:

*MaVLQ^U2lQ   implicit Q at the end (Q = input list)
      ^U2lQ   repeated Cartesian product of [0, 1] with itself length(Q)-times
              this gives all combinations of 0s and 1s
  aVLQ        absolute difference between these 0-1-vectors with Q
*M            fold the vectors by multiplication

Answer 10

C, 110 bytes

i,k;f(float* a,int n){for(k=0;k<1<<n;++k){float p=1;for(i=0;i<n;++i)p*=k&(1<<i)?a[i]:1-a[i];printf("%f,",p);}}

Ungolfed:

i,k;f(float* a,int n){ 
 for(k=0; k<1<<n; ++k){
  float p=1;
  for (i=0; i<n; ++i)
   p*=k&(1<<i)?a[i]:1-a[i];
  printf("%f,",p);
 }
}

Works up to 32 items, +5+1 bytes for 64 items (declare long k; and add L in the first loop so that k<1L<<N).

Answer 11

05AB1E, 8 bytes

<Äæ¹æR+P

Try it online!

 <Äæ¹æR+P  # Main link (Input is [.1,.2])
 ###########
 <Ä        # Invert input, take the abs value.
           # Stack is [.9,.8]
   æ¹æ     # Powerset of both inverted and original arrays.
           # Stack is [[],[.1],[.2],[.1,.2]],[[],[.9],[.8],[.9,.8]]
      R+   # Reverse original array, add arrays together.
           # Stack is [.9,.8],[.1,.8],[.2,.9],[.1,.2]
        P  # For each sub array, push product.
           # Final Result: [0.02, 0.18, 0.08, 0.72]
           # E.G.          [  11,   10,   01,   00]

Answer 12

JavaScript (Firefox 30-57), 57 bytes

f=([p,...a])=>1/p?[for(q of[1-p,p])for(b of f(a))q*b]:[1]

Returns an array of all the probabilities. If you want the array of events too, then for 86 bytes:

f=([p,...a])=>1/p?[for(e of'01')for(b of f(a))[[+e,...b[0]],(+e?p:1-p)*b[1]]]:[[[],1]]

If you're allowed the events as a string, then it's only 80 bytes:

f=([p,...a])=>1/p?[for(e of'01')for(b of f(a))[e+b[0],(+e?p:1-p)*b[1]]]:[['',1]]

Subtract two bytes for 1/ for each solution if the probability is never going to be zero.

Answer 13

Perl 6, 24 19 bytes of Latin-1

{[*] 1 «-»@_ «|»@_}

Older code:

{[*] map {1-$^a|$^a},@_}

This is a function. Use it like this:

{[*] 1 «-»@_ «|»@_}(0.55, 0.67, 0.13)

to get:

any(any(any(0.129195, 0.019305), any(0.262305, 0.039195)), any(any(0.157905, 0.023595), any(0.320595, 0.047905)))

Explanation of the older code:

[*]          multiply together all array elements
map          but first transform each element via
{1-$^a|$^a}  considering both 1 minus the value and the value
,@_          of the function input

The newer code is basically the same, just using terser syntax:

[*]          multiply together all array elements
1 «-»@_      of the array formed by subtracting the argument from 1
«|»@_        pointwise considering both that and the original array

The map generates an array full of any constructs, which multiply into larger any constructs, neatly solving the problem without even needing a loop.

Not the shortest language for the program, but it's a very direct translation of the problem.

Answer 14

Dyalog APL, 10 bytes

New Solution

Index origin independent. Anonymous function. Takes probabilities list as argument.

∘.×/⊢,¨1-⊢

∘.×/ The Cartesian product reduction over

⊢ the argument values

,¨ each paired up with

1-⊢ the complement argument values (lit. one minus the argument values)

TryAPL online!

---

Old Solution

Requires ⎕IO←0 which is default on many systems. Prompts for probabilities' list.

|⎕∘.×.-⊂⍳2

Explanation

| absolute value of

⎕ the input, ɑ = [ɑ₁ ɑ₂ ɑ₃]

∘.×.- modified inner tensor multiplied, (ɑ₁ – b₁) ⊗ (ɑ₂ – b₂) ⊗ (ɑ₃ – b₃), with

⊂⍳2 the enclosed list b = [[0 1]]

Mathematical definition

As b is enclosed, it is scalar, and therefore extended to the length of ɑ, namely 3, so the entire expression is

 A = │(ɑ₁ – b) ⊗ (ɑ₂ – b) ⊗ (ɑ₃ – b)│ =

 │(ɑ₁ – [0,1]) ⊗ (ɑ₂ – [0,1]) ⊗ (ɑ₃ – [0,1])│ =

 │[ɑ₁,ɑ₁ – 1] ⊗ [ɑ₂, ɑ₂ – 1] ⊗ [ɑ₃,ɑ₃ – 1]│ =

 ⎢ ⎡ ⎡  ɑ₁ɑ₂ɑ₃  ⎤ ⎡  ɑ₁ɑ₂(ɑ₃-1)  ⎤ ⎤ ⎥
 ⎢ ⎢ ⎣  ɑ₁(ɑ₂-1)ɑ₃  ⎦ ⎣  ɑ₁(ɑ₂-1)(ɑ₃-1)  ⎦ ⎥ ⎥
 ⎢ ⎢ ⎡  (ɑ₁-1)ɑ₂ɑ₃  ⎤ ⎡  (ɑ₁-1)ɑ₂(ɑ₃-1)  ⎤ ⎥ ⎥
 ⎢ ⎣ ⎣(ɑ₁-1)(ɑ₂-1)ɑ₃⎦ ⎣(ɑ₁-1)(ɑ₂-1)(ɑ₃-1)⎦ ⎦ ⎥

TryAPL online!

Notes (applies to both old and new solution)

The program and formula works for any number (n) of variables, and returns an n-dimensional array of length 2 in every dimension. With three variables, the probability of a specific outcome
 P(p,q,r) = A_p,q,r
which can conveniently be selected from the array with (⊃A)[p;q;r] extracted with p q r⌷⊃A

E.g. 1 1 0⌷⊃|0.55 0.67 0.13∘.×.-⊂⍳2 gives P(55%, 67%, ¬13%) = 1.9305%

Answer 15

PHP, 105 97 94 93 87 bytes

for(;$i<2**$c=count($a=$argv)-$p=1;$i+=print-abs($p))for(;$c;)$p*=$a[$c--]-!($i>>$c&1);

Run like this:

php -r 'for(;$i<2**$c=count($a=$argv)-$p=1;$i+=print-abs($p))for(;$c;)$p*=$a[$c--]-!($i>>$c&1);' -- .55 .67 .13 2>/dev/null;echo
> -0.129195-0.157905-0.262305-0.320595-0.019305-0.023595-0.039195-0.047905

Note that the output is little endian:

[0,0,0]
[1,0,0]
[0,1,0]
[1,1,0]
[0,0,1]
[1,0,1]
[0,1,1]
[1,1,1]

Explanation

for(
  ;
  $i<2**$c=                 # Iterate over possible combinations: 2^c,
    count($a=$argv)-$p=1;   #   where c is input length -p (set p to 1)
  $i+=print-abs($p)         # Increment i and print product after each
)                           #   iteration, dash separated
  for(
     ;
     $c;                    # Iterate over input ($c..0)
  )
    $p*=                    # Multiply the product by difference between:
      $a[$c--]-             # - The $c-th item of the input.
      !($i>>$c&1);          # - The $c-th bit of `$i`, negated (1 or 0)

Tweaks

• Saved 8 bytes by using binary logic to get bit instead of converting to string
• Saved a byte by combining the resetting of $p to 1 with computation of $c
• Saved a byte by adding the result of print (1) to $i instead of incrementing
• Saved a byte by using underscore as output delimiter
• Saved a byte by using minus sign as delimiter (there are no negative chances).
• Saved 6 bytes by using $c instead of $$i

Answer 16

C++17, 137 131 129 bytes

Saving 6 bytes by declaring #define A auto, first time that such a short macro saves anything. -2 bytes for using #import and deleting the space before <

#import<iostream>
#define A auto
A g(A r){std::cout<<r<<",";}A g(A r,A x,A...p){g(x*r,p...);g(r-x*r,p...);}A f(A...p){g(1,p...);}

Spawns all possible combinations.

Ungolfed:

//base case to print the result
int g(auto r){std::cout << r << ",";}

//extract item from parameter pack
int g(auto r, auto x, auto... p) {
 g(x*r,p...);    //multiply with temp result and call with tail
 g(r-x*r,p...);  //same as above for (1-x)
}

//start of recursion, setting temp result to 1
int f(auto...p){g(1,p...);}

Usage:

f(0.55, 0.67, 0.13);