Verilen Olayların Tüm Kombinasyonlarının Olasılığı


18

0.0 ile 1.0 arasında olasılıkları olan bir dizi olay göz önüne alındığında, meydana gelen her bir kombinasyonun olasılığını üretir ve türetir. Seçtiğiniz dilde hangi yapıda olursa olsun bir dizi sayı sağlandığını varsayabilirsiniz.

İşte bir örnek; dizinin kombinasyonlarının uzunluğunun belleğe sığdığını varsayabilirsiniz:

{ 0.55, 0.67, 0.13 }

Program, her bir kombinasyonu ve bu sekansın meydana gelme olasılığını basacaktır. 1, giriş dizisinin o dizinindeki olayın meydana geldiğini ve 0, o olayın meydana gelmediğini belirtir. İstenen çıktı aşağıdadır (İşi yazdırmayı umursamıyorum, bu sadece algoritmanın bilgilendirme amaçlıdır):

[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

Bu sorun teğetsel olarak bir "Kartezyen ürün" hesaplamasıyla ilgilidir.

Unutmayın, bu kod golfüdür, bu yüzden en az bayt içeren kod kazanır.


3
Programlama Bulmacalar ve Kod Golf hoş geldiniz, ve güzel ilk meydan okuma!
Kapı tokmağı

[0.129195, 0.019305, 0.262305, ..., 0.047905]Çıktı olarak yeterli mi yoksa [0,0,0], [0,0,1], ...gerekli mi?
Laikoni

@Laikoni Bu çıktı gayet iyi. Çıktı kısmı sorunun etini değil.
Mark Johnson

Çıktı ters sırada olabilir mi?
Luis Mendo

@LuisMendo Elbette, neden olmasın.
Mark Johnson

Yanıtlar:


8

Haskell, 86 bayt

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

Kullanım örneği:

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

Baytların çoğu çıktı biçimlendirmesi için harcanır. Sadece olasılık vektörüyle ilgileniyorsanız, bu sadece 29 bayttır:

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

Nasıl çalışır:

                    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

Bu temiz; Bunu yapmanın gerçekten kısa bir şekilde tamamen işlevsel bir yolu olup olmayacağını merak ettim. C # veya F # biliyor musunuz? Haskell sözdizimini tamamen bilmediğimden, bu dillerdeki aynı algoritmanın nasıl görüneceğini merak ediyorum.
Mark Johnson

@ MarkJohnson: hayır, üzgünüm ne C # ne de F # bilmiyorum.
nimi

5

Mathematica, 46 45 bayt

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

Bir liste alır. {}Çıktının olduğu boş liste için bile çalışır {1}.

Test durumu:

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

açıklama

Olasılıklar listesi verildi sve bit listesini bile 0"gerçekleşmedi" ifade eden ve 1çarpılan verilir edilecek "meydana geldi" ifade eden, olasılıklar listesini

1 - b - s

imzalamak için. Bunun yerine 0"meydana geldiğini" ve 1" gerçekleşmediğini" belirtirse , bu

b - s

yani biz:

                      {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 bayt

İçin +1 içerir -a

STDIN'de numara verin:

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

çıktılar

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 bayt

TF-|Z}&Z*!p

Girdi, biçimiyle bir sütun vektörüdür [0.55; 0.67; 0.13]

Çevrimiçi deneyin!

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 bayt

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

Okunabilir:

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

Giriş parametrelerinin sayısına eşit olan 0s ve 1s uzunluk kombinasyonlarının tümünün bir listesini oluşturur (örneğin, yukarıdaki örnek için uzunluk 3 olacaktır), sonra her olasılığı hesaplar.

@Dada'ya bu globişlevin ne yapabileceğini gösterdiği için teşekkürler ,% 100 emin olmadığım halde bunu nasıl yaptığımı anlıyorum .

Örnek çıktı:

[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
-ayerine (@a=split/ /,<>)...
Dada

3

R, 72 69 bayt

Stdin'den girdi alır ve olasılıkların bir R-vektörünü döndürür.

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

Düzenleme: Gereksiz bir devrik kaldırıldı, permütasyon matrisi şimdi aşağıdaki bir transpoze versiyonu ve olasılıklar satır-bilge yerine sütun-bilge ürün olarak hesaplanır. Örnek çıktı:

[1] 0.129195 0.157905 0.262305 0.320595 0.019305 0.023595 0.039195 0.047905

Tarafından üretilen permütasyon matrisinin expand.gridaşağıdakileri üretmesi nedeniyle olasılıkların farklı bir sırada olduğunu unutmayın (bu matrisin oluşturulması muhtemelen harici paketler kullanılarak golf edilebilir):

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

İlk olasılık, yukarıdaki matristeki ilk satırın tersine, ikincisi ise tersine çevrilmiş ikinci satırın vb.

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

bunun yerine aşağıdakileri üretir:

[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

Buna kendi cevabım üzerinde çalışıyordum ama düzgün bir çözüm bulamadım. Büyük kullanımı expand.grid! Bu applyveri çerçeveleri yanı sıra matrisler üzerinde çalışabilir düşünüyorum , bu yüzden kodunuz olmadan çalışmalı t(t(...)), hangi 6 bayt kurtaracak.
rturnbull

@rturnbull tHerhangi bir veri çerçevesiyle ilgili olmayan, ancak olasılık vektörünün permütasyon matrisinden (farklı boyutlarda) çıkarılmasına izin veren not. R'nin bu vektörize işlemleri işleme biçimi nedeniyle bunlardan en az biri gereklidir, ancak muhtemelen dış aktarmayı kaldırabilir ve bunun yerine ürünü sütunların üzerine uygulayabilirim. Yarın güncellenecek
Billywob


2

J, 14 bayt

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

kullanım

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

açıklama

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

Eğer yapabilir |*//0.55 0.67 0.13-/0 1bir trene?
Adam

2

Pyth, 10 bayt

*MaVLQ^U2l

Çevrimiçi deneyin: Gösteri

Açıklama:

*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 bayt

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 öğeye kadar çalışır, 64 öğe için + 5 + 1 bayt ( ilk döngüde bildirip long k;ekleyin ).Lk<1L<<N


1
> 32 öğe için C, "L" değişmezini gerektiriyor mu yoksa *1*<<nbu sadece bir C ++ meselesi mi?
Mark Johnson

@ MarkJohnson evet sanırım gerektirirdi.
Karl Napf

1

05AB1E , 8 bayt

<Äæ¹æR+P

Çevrimiçi deneyin!

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

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

Tüm olasılıkların bir dizisini döndürür. Olay dizisini de istiyorsanız, 86 bayt için:

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

Olaylara dize olarak izin verilirse, yalnızca 80 bayt olur:

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/Olasılık asla sıfır olmayacaksa, her çözelti için iki bayt çıkarın .


Bunu bir <script></script>blokta nasıl yürütürdünüz? İlk "için" beklenmedik olmak ile ilgili sorunlar alıyorum?
Mark Johnson

@MarkJohnson Firefox 30 veya üstünü kullandığınız sürece, sadece çalışmalıdır.
Neil

0

Perl 6, 24 19 bayt Latin-1

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

Eski kod:

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

Bu bir işlevdir. Şöyle kullanın:

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

almak:

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

Eski kodun açıklaması:

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

Yeni kod temelde aynıdır, sadece terser sözdizimi kullanılarak:

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

Harita any, daha büyük anyyapılara çarparak , bir döngüye bile gerek kalmadan sorunu düzgün bir şekilde çözen yapılarla dolu bir dizi oluşturur .

Program için en kısa dil değil, ancak sorunun çok doğrudan bir çevirisi.


0

Dyalog APL , 10 bayt

Yeni Çözüm

İndeks kökeni bağımsız. Anonim işlev. Olasılık listesini argüman olarak alır.

∘.×/⊢,¨1-⊢

∘.×/ Kartezyen ürün azaltımı

argüman değerleri

her biri

1-⊢ tamamlayıcı argüman değerleri (lit. one eksi argüman değerleri)

TryAPL çevrimiçi!


Eski Çözüm

⎕IO←0Birçok sistemde varsayılan olanı gerektirir . Olasılık listesi istemleri.

|⎕∘.×.-⊂⍳2

açıklama

| mutlak değeri

giriş, ɑ = [ ɑ ₁  ɑ ₂  ɑ ₃]

∘.×.-değiştirilmiş iç tensör çarpımı, ( ɑ ₁ - b ₁) ⊗ ( ɑ ₂ - b ₂) ⊗ ( ɑ ₃ - b ₃),

⊂⍳2ekteki liste b = [[0 1]]

Matematiksel tanım

As ɑ B içine alınır, bu ölçekleme ve bu nedenle uzunluğuna uzatılmış olan ɑ tüm ifade, bu yüzden, yani 3

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 çevrimiçi!

Notlar (hem eski hem de yeni çözüm için geçerlidir)

Program ve formül herhangi bir sayıda ( n ) değişken için çalışır ve her boyutta 2 boyutlu bir n -boyutlu dizi döndürür . Üç değişken, spesifik bir sonuç olasılığı ile
P ( s , q , r ) = bir p , q , r
ile uygun bir dizi seçilebilir (⊃A)[p;q;r]ile ekstrep q r⌷⊃A

Örneğin P1 1 0⌷⊃|0.55 0.67 0.13∘.×.-⊂⍳2 verir (% 55,% 67, ¬13%) =% 1.9305


0

PHP, 105 97 94 93 87 bayt

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

Şu şekilde çalıştırın:

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

Çıktının küçük endian olduğuna dikkat edin:

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

açıklama

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)

Düzenlemeler

  • Dizeye dönüştürmek yerine bit almak için ikili mantık kullanarak 8 bayt kaydedildi
  • $p1 değerine sıfırlamayı aşağıdakilerin hesaplanmasıyla birleştirerek bir bayt kaydedildi$c
  • $iArttırmak yerine baskı (1) sonucunu ekleyerek bir bayt kaydetti
  • Çıktı sınırlayıcı olarak alt çizgiyi kullanarak bir bayt kaydetti
  • Eksi işaretini sınırlayıcı olarak kullanarak bir bayt kaydetti (negatif şans yok).
  • Kullanılarak 6 bayt Kaydedilen $cyerine$$i

0

C ++ 17, 137 131 129 bayt

#define A autoİlk kez böyle kısa bir makronun her şeyi kaydettiğini bildirerek 6 bayt kaydetme . Önceki #importalanı kullanmak ve silmek için -2 bayt<

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

Tüm olası kombinasyonları doğurur.

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

Kullanımı:

f(0.55, 0.67, 0.13);
Sitemizi kullandığınızda şunları okuyup anladığınızı kabul etmiş olursunuz: Çerez Politikası ve Gizlilik Politikası.
Licensed under cc by-sa 3.0 with attribution required.