Вероятность всех комбинаций данных событий


18

Учитывая последовательность событий с вероятностями от 0,0 до 1,0, генерировать и выводить вероятность возникновения каждой комбинации. Вы можете предположить, что последовательность чисел предоставляется в любой конструкции, которую обеспечивает выбранный вами язык.

Вот пример; Вы можете предположить, что длина комбинаций последовательности вписывается в память:

{ 0.55, 0.67, 0.13 }

Программа должна распечатать каждую комбинацию и соответствующую вероятность этой последовательности. 1 означает, что событие в этом индексе входной последовательности произошло, а 0 означает, что это событие не произошло. Ниже приведен желаемый результат (меня не волнует печать работы, это только для информационных целей алгоритма):

[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

Эта проблема косвенно связана с вычислением «декартового произведения».

Помните, это код-гольф, поэтому выигрывает код с наименьшим количеством байтов.


3
Добро пожаловать в Программирование Пазлов и Код Гольф и приятных первых испытаний!
Дверная ручка

Будет [0.129195, 0.019305, 0.262305, ..., 0.047905]достаточно в качестве вывода или [0,0,0], [0,0,1], ...необходимы?
Лайкони

@ Laikoni Этот вывод в порядке. Выходная часть не является основной проблемой.
Марк Джонсон

Может ли вывод быть в обратном порядке?
Луис Мендо

@ LuisMendo Конечно, почему бы и нет.
Марк Джонсон

Ответы:


8

Haskell, 86 байт

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

Пример использования:

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

Большая часть байтов расходуется на форматирование вывода. Если вас интересует только вектор вероятности, это всего лишь 29 байтов:

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

Как это устроено:

                    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

Это аккуратно; Мне было любопытно, будет ли действительно очень короткий, чисто функциональный способ сделать это. Вы случайно не знаете C # или F #? Мне любопытно, как будет выглядеть тот же алгоритм в этих языках, так как я совершенно незнаком с синтаксисом Haskell.
Марк Джонсон

@MarkJohnson: нет, извините, я не знаю ни C #, ни F #.
Nimi

5

Mathematica, 46 45 байт

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

Занимает список. Даже работает для пустого списка {}, для которого вывод {1}.

Прецедент:

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

объяснение

Учитывая список вероятностей sи список битов bс 0обозначением «не произошло» и 1обозначением «действительно произошло», список вероятностей, которые необходимо умножить, задается как

1 - b - s

до подписи. Если вместо этого 0означает «произошло» и 1«не произошло», то это упрощает

b - s

поэтому мы:

                      {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 *)

4

Perl, 42 40 байт

Включает +1 для -a

Дайте цифры на STDIN:

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

выходы

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

4

MATL , 12 11 байт

TF-|Z}&Z*!p

Ввод - это вектор-столбец в формате [0.55; 0.67; 0.13]

Попробуйте онлайн!

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

3

Perl, 116 байт

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

Удобочитаемый:

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

Создает список всех возможных комбинаций длины 0 и 1, равный количеству входных параметров (например, для приведенного выше примера, он будет иметь длину 3), а затем вычисляет каждую вероятность.

Спасибо @Dada за то, что показали мне, на что способна эта globфункция , хотя я не уверен на 100%, что понимаю, как она это делает.

Пример вывода:

[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

1
-aвместо (@a=split/ /,<>)...
Дада

3

R, 72 69 байт

Принимает входные данные из stdin и возвращает R-вектор вероятностей.

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

Изменить: Удалена одна ненужная транспонирование, матрица перестановок теперь является транспонированной версией приведенной ниже, и вероятности рассчитываются как произведение по столбцам, а не по строкам. Пример вывода:

[1] 0.129195 0.157905 0.262305 0.320595 0.019305 0.023595 0.039195 0.047905

Обратите внимание, что вероятности находятся в другом порядке из-за того факта, что сгенерированная матрица перестановок expand.gridвыдает следующее (генерация этой матрицы, вероятно, может быть выполнена с использованием внешних пакетов):

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

Первая вероятность соответствует инвертированному результату первой строки в приведенной выше матрице, а вторая - инвертированной второй строке и т. Д. Форматирование вывода, чтобы увидеть это еще более отчетливо, делает программу более длинной (164 байта):

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="")

который вместо этого производит:

[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

Я работал над собственным ответом на это, но я не мог придумать аккуратное решение. Отличное использование expand.grid! Я думаю, что это applyможет работать как с кадрами данных, так и с матрицами, поэтому ваш код должен работать без того t(t(...)), что сэкономит вам 6 байтов.
rturnbull

@rturnbull Обратите внимание, что tэто не связано с каким-либо фреймом данных, но позволяет вычитать вектор вероятности из матрицы перестановок (с различными измерениями). По крайней мере один из них необходим из-за способа, которым R обрабатывает эти векторизованные операции, но я мог бы, вероятно, удалить внешнюю транспонирование и вместо этого применить продукт над столбцами. Будет обновление завтра
Billywob


2

J, 14 байт

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

использование

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

объяснение

-.([:,*/)/@,.]  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

Вы можете превратить |*//0.55 0.67 0.13-/0 1в поезд?
Адам

2

Pyth, 10 байт

*MaVLQ^U2l

Попробуйте онлайн: демонстрация

Объяснение:

*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

1

C, 110 байтов

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);
 }
}

Работает до 32 элементов, + 5 + 1 байт для 64 элементов (объявить long k;и добавитьL в первый цикл, чтобы k<1L<<N).


1
Для> 32 элементов, C требует литерал "L" на *1*<<nили это просто C ++?
Марк Джонсон

@MarkJohnson да, я думаю, это потребует.
Карл Напф

1

05AB1E , 8 байтов

<Äæ¹æR+P

Попробуйте онлайн!

 <Äæ¹æ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]

1

JavaScript (Firefox 30-57), 57 байт

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

Возвращает массив всех вероятностей. Если вам тоже нужен массив событий, то для 86 байтов:

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

Если вы допускаете события в виде строки, то это всего лишь 80 байтов:

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

Вычтите два байта для 1/каждого решения, если вероятность никогда не будет равна нулю.


Как бы вы запустили это в <script></script>блоке? У меня проблемы с первым "за", который был неожиданным?
Марк Джонсон

@MarkJohnson Пока вы используете Firefox 30 или более поздней версии, он должен просто работать.
Нил

0

Perl 6, 24 19 байт латиницы-1

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

Старый код:

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

Это функция. Используйте это так:

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

получить:

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

Объяснение старого кода:

[*]          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

Более новый код в основном такой же, только с использованием более короткого синтаксиса:

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

Карта генерирует массив, полный anyконструкций, которые умножаются на большиеany конструкции, аккуратно решая проблему, даже не нуждаясь в цикле.

Не самый короткий язык для программы, но это очень прямой перевод проблемы.


0

Дьялог АПЛ , 10 байт

Новое решение

Индекс происхождения не зависит. Анонимная функция. Принимает список вероятностей в качестве аргумента.

∘.×/⊢,¨1-⊢

∘.×/ Сокращение декартовых произведений

значения аргумента

каждый в паре с

1-⊢ значения аргумента дополнения (горит один минус значения аргумента)

Попробуй APL онлайн!


Старое решение

Требуется ⎕IO←0по умолчанию во многих системах. Запрашивает список вероятностей.

|⎕∘.×.-⊂⍳2

объяснение

| абсолютное значение

вход, ɑ = [ ɑ ₁  ɑ ₂  ɑ ₃]

∘.×.-умноженный модифицированный внутренний тензор, ( ɑ ₁ - b ₁) ⊗ ( ɑ ₂ - b ₂) ⊗ ( ɑ ₃ - b ₃), с

⊂⍳2приложенный список б = [[0 1]]

Математическое определение

Поскольку b заключено, оно является скалярным и, следовательно, распространяется на длину ɑ , а именно 3, поэтому все выражение имеет вид

A = ɑ ( ɑ ₁ - b ) ⊗ ( ɑ b - b ) ⊗ ( ɑ ₃ - b ) │ =

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

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

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

Попробуй APL онлайн!

Примечания (относится как к старому, так и к новому решению)

Программа и формула работает для любого числа ( n ) переменных и возвращает n мерный массив длины 2 в каждом измерении. С тремя переменными вероятность конкретного результата
P ( p , q , r ) = A p , q , r,
которая может быть удобно выбрана из массива с (⊃A)[p;q;r]извлеченным сp q r⌷⊃A

Например, 1 1 0⌷⊃|0.55 0.67 0.13∘.×.-⊂⍳2дает P (55%, 67%, ¬13%) = 1,9305%


0

PHP 105 97 94 93 87 байт

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

Запустите так:

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

Обратите внимание, что выходные данные имеют порядок байтов:

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

объяснение

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

  • Сохранено 8 байтов с помощью двоичной логики, чтобы получить бит вместо преобразования в строку
  • Сохраненный байт путем объединения сброса $p в 1 с вычислением$c
  • Сохраненный байт, добавив результат print (1) в $i вместо увеличения
  • Сохраненный байт с использованием подчеркивания в качестве выходного разделителя
  • Сохраненный байт, используя знак минус в качестве разделителя (нет отрицательных шансов).
  • Сохранено 6 байтов при использовании $cвместо$$i

0

С ++ 17, 137 131 129 байт

Сохранение 6 байтов #define A auto, впервые объявив , что такой короткий макрос сохраняет что-либо. -2 байта для использования #importи удаления места перед<

#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...);}

Создает все возможные комбинации.

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

Использование:

f(0.55, 0.67, 0.13);
Используя наш сайт, вы подтверждаете, что прочитали и поняли нашу Политику в отношении файлов cookie и Политику конфиденциальности.
Licensed under cc by-sa 3.0 with attribution required.