18
\$\begingroup\$

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.

\$\endgroup\$
  • 3
    \$\begingroup\$ Welcome to Programming Puzzles & Code Golf, and nice first challenge! \$\endgroup\$ – Doorknob Nov 6 '16 at 0:55
  • \$\begingroup\$ Would [0.129195, 0.019305, 0.262305, ..., 0.047905] be enough as output or are the [0,0,0], [0,0,1], ... necessary? \$\endgroup\$ – Laikoni Nov 6 '16 at 1:00
  • \$\begingroup\$ @Laikoni That output is fine. The output portion isn't the meat of the problem. \$\endgroup\$ – Mark Johnson Nov 6 '16 at 2:17
  • \$\begingroup\$ Can the output be in reverse order? \$\endgroup\$ – Luis Mendo Nov 6 '16 at 5:07
  • \$\begingroup\$ @LuisMendo Sure, why not. \$\endgroup\$ – Mark Johnson Nov 6 '16 at 5:12

16 Answers 16

8
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ This is neat; I was curious if there was going to be a really short purely functional way of doing this. Do you happen to know C# or F#? I'm curious what the same algorithm in those languages would look like as I'm completely unfamiliar with the Haskell syntax. \$\endgroup\$ – Mark Johnson Nov 6 '16 at 3:44
  • \$\begingroup\$ @MarkJohnson: no, sorry I know neither C# nor F#. \$\endgroup\$ – nimi Nov 6 '16 at 17:06
5
\$\begingroup\$

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 *)
\$\endgroup\$
4
\$\begingroup\$

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)>
\$\endgroup\$
4
\$\begingroup\$

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
\$\endgroup\$
3
\$\begingroup\$

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
\$\endgroup\$
  • 1
    \$\begingroup\$ -a instead of (@a=split/ /,<>)... \$\endgroup\$ – Dada Nov 6 '16 at 1:15
3
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ I'd been working on my own answer to this but I couldn't come up with a neat solution. Great use of expand.grid! I think that apply can operate on data frames as well as matrices, so your code should work without the t(t(...)), which will save you 6 bytes. \$\endgroup\$ – rturnbull Nov 6 '16 at 22:05
  • \$\begingroup\$ @rturnbull Note that t is not related to any data frame but to allow the subtraction of the probability vector from the permutation matrix (with different dimensions). At least one of them is needed due to the way R handles these vectorized operations but I could probably remove the outer transpose and apply the product over columns instead. Will update tomorrow \$\endgroup\$ – Billywob Nov 6 '16 at 22:12
2
\$\begingroup\$

Jelly, 9 bytes

ż@C×þF¥@/

Try it online!

\$\endgroup\$
2
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ Can you make |*//0.55 0.67 0.13-/0 1 into a train? \$\endgroup\$ – Adám Nov 14 '16 at 1:56
2
\$\begingroup\$

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
\$\endgroup\$
1
\$\begingroup\$

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).

\$\endgroup\$
  • 1
    \$\begingroup\$ For >32 items, does C require the "L" literal on the *1*<<n or is that just a C++ thing? \$\endgroup\$ – Mark Johnson Nov 7 '16 at 0:19
  • \$\begingroup\$ @MarkJohnson yes i guess it would require. \$\endgroup\$ – Karl Napf Nov 7 '16 at 9:14
1
\$\begingroup\$

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]
\$\endgroup\$
1
\$\begingroup\$

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.

\$\endgroup\$
  • \$\begingroup\$ How would you run this in a <script></script> block? I'm getting issues with the first "for" being unexpected? \$\endgroup\$ – Mark Johnson Nov 6 '16 at 20:28
  • \$\begingroup\$ @MarkJohnson As long as you're using Firefox 30 or later, it should just work. \$\endgroup\$ – Neil Nov 6 '16 at 20:41
0
\$\begingroup\$

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.

\$\endgroup\$
0
\$\begingroup\$

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) = Ap,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%

\$\endgroup\$
0
\$\begingroup\$

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
\$\endgroup\$
0
\$\begingroup\$

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);
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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