Statistika in verjetnost

Izbire kroglic

V vreči imamo m belih in n črnih kroglic. Naključno izberemo tri kroglice. Kakšna je verjetnost, da so vse enake barve?

Subsets[{Bela, Bela, Bela,Črna, Črna},{3}]

3/5*2/4*1/3

3/5*(2/4*2/3+2/4*2/3)+2/5*3/4*2/3

Table[Črna,{5}]

ClearAll[izbireKroglic]
izbireKroglic[m_,n_,k_]:=Subsets[Join[Table[Bela,{m}],Table[Črna,{n}]],{k}]

izbireKroglic[6,4,3]

Sestavimo še funkcijo, ki izračuna relativno frekvenco danega pogoja:

ClearAll[verjetnost]
verjetnost[lst_,p_]:=((Length[Select[lst,p]])/(Length[lst]))

verjetnost[izbireKroglic[10,4,3],Function[izbira,izbira=={Bela,Bela,Bela}∨izbira=={Črna,Črna,Črna}]]

Verjetnost, da bo črnih več kot belih?

Count[{Bela, Bela, Črna, Črna, Črna}, Črna]

verjetnost[izbireKroglic[5,5,3],Function[izbira,Count[izbira,Črna]>Count[izbira,Bela]]]

S funkcijo verjetnost lahko preizkušamo razne konkretne verjetnosti. Na primer, če izberemo dve števili med 1 in 100, kolikšna je verjetnost, da sta tuji?

verjetnost[
Flatten[Table[{i,j},{i,1,100},{j,1,100}],1],
Function[izbira,GCD@@izbira==1]
]//N

BarChart[
Table[
verjetnost[
Flatten[Table[{i,j},{i,1,n},{j,1,n}],1],
Function[izbira,GCD@@izbira==1]
],{n,2,200,10}]
]

Vprašanje: zakaj potrebujemo Flatten?

Flatten[Table[{i,j},{i,1,5},{j,1,5}],1]

Osnovne funkcije za prikaz podatkov

BarChart[{1,2,50,3,15,40}]

ListPlot[{1,2,50,3,15,40}]

ListLinePlot[{1,2,50,3,15,40}]

Statistične lastnosti praštevil

Kolikšen delež vseh števil 1 do n je praštevil?

Funkcija PrimePi[n] vrne število praštevil do n:

ListLinePlot[Table[PrimePi[n]/n,{n,2,1000}],
AxesOrigin->{0,0}]

Ali je torej praštevil približno 15%? Ne, znani izrek pravi, da jih je do n približno (n/(Log[ [n])), torej bi moral biti njihov delež približno (1/(Log[n])):

Show[{
Plot[{(1/(Log[n])),(1/(Log[n]-1.112))},{n,2,1000},PlotStyle->{Orange,Green}],
ListLinePlot[Table[PrimePi[n]/n,{n,2,1000}]]
}]

Za velike n torej delež pada proti 0:

((PrimePi[(10^9)])/(10^9))//N

Kako se obnaša razlika med dvema zaporednima prašteviloma?

Manipulate[Histogram[Table[Prime[n+1]-Prime[n],{n,1,k}],{1}],{k,100,10000,10}]

Zakaj so med stolpci prazni presledki?

Naključni sprehod

Zaporedje celih števil generiramo takole: začnemo v 0, nato pa v vsakem koraku naključno prištejemo bodisi -1 bodisi 0 bodisi 1. Kako  bi prikazali dobljeno zaporedje?

NestList[f,x,4]

ClearAll[sprehod]
sprehod[n_]:=NestList[Function[x,x+RandomInteger[{-1,1}]],0,n]

sprehod[20]

ListLinePlot[sprehod[5000],AxesOrigin->{0,0},AspectRatio->1/5]

Za prikaz statističnih lastnosti bi želeli prikazati več sprehodov hkrati.

ClearAll[sprehodi]
sprehodi[k_]:=
ListLinePlot[
Table[sprehod[1000],{k}],
AxesOrigin->{0,0},
PlotStyle->{{Thin,Gray}}
]

sprehodi[20]

RandomInteger[{-1,1},10]

Histogram[Table[Plus@@RandomInteger[{-1,1},800],{100}]]

Izbira naključne točke

S funkcijo RandomReal lahko izberemo naključno realno število na danem intervalu:

RandomReal[{23, 27}]

Generiramo lahko tudi seznam ali matriko :

RandomReal[{23,27},10]

RandomReal[{-1,1},{5,5}]//MatrixForm

Naključno izbrane točke v enotskem kvadratu:

Graphics[{Line[{{0,0},{1,0},{1,1},{0,1},{0,0}}],PointSize[Small],Point/@RandomReal[{0,1},{5000,2}]}]

Kako generiramo naključno točko v enotskem krogu?

Prvi način: izberemo kot ϕ∈[0,2π] in polmer r∈[0,1]

ClearAll[nakljucna1]
nakljucna1[]:=Module[
{ϕ=RandomReal[{0,2π}],
r=RandomReal[{0,1}]},
{r*Cos[ϕ],r*Sin[ϕ]}
]

Narišimo sliko:

Graphics[{Circle[{0,0},1],PointSize[Small],Table[Point[nakljucna1[]], {3000}]}]

Vidimo, da so točke gostejše bližje središča. S funkcijo Histogram3D lahko prikažemo porazdelitev:

Histogram3D[Table[nakljucna1[],{20000}],Automatic,"Probability"]

Drugi način: izberemo točko (x,y)∈(([-1,1])^2) in jo zavržemo, če je izven kroga.

ClearAll[nakljucna2]
nakljucna2[]:=
Module[{x,y},
Until[
Norm[{x,y}]<=1,
(x=RandomReal[{-1,1}];y=RandomReal[{-1,1}])
];
{x,y}
]

Graphics[{Circle[{0,0},1],PointSize[Small],Table[Point[nakljucna2[]], {10000}]}]

Sedaj so točke razporejene enakomerno.

Histogram3D[Table[nakljucna2[],{20000}],Automatic,"Probability"]

Tretji način: izberemo točko x∈[-1,1] in nato y∈[-(Sqrt[1-(x^2)]),(Sqrt[1-(x^2)])]

ClearAll[nakljucna3]
nakljucna3[]:=
Module[{x,y},
x=RandomReal[{-1,1}];
y=RandomReal[{-(Sqrt[1-(x^2)]),(Sqrt[1-(x^2)])}];
{x,y}
]

Graphics[{Circle[{0,0},1],PointSize[Small],Table[Point[nakljucna3[]], {20000}]}]

Ali so točke razporejene enakomerno?

Histogram3D[Table[nakljucna2[],{10000}],Automatic,"Probability"]

Četrti način: izberemo kot ϕ∈[0,2π] in polmer r∈[0,1], vendar z ustrezno porazdelitvijo r

Kako bi morali izbirati ϕ∈[0,2π] in r∈[0,1], da bi dobili enakomerno porazdelitev po celotnem krogu? Težava je v tem, da je preveč točk pri središču, torej bi morali tam zmanjšati gostoto. Le-to lahko nadzorujemo tako, da r zamenjamo z f[r], kjer je f: [0,1]->[0,1] neka ustrezno izbrana funkcija:

ClearAll[nakljucna4]
nakljucna4[f_]:=Module[
{ϕ=RandomReal[{0,2π}],
r=RandomReal[{0,1}]},
{f[r]*Cos[ϕ],f[r]*Sin[ϕ]}
]

Če uporabimo funkcijo x|->(x^2), je rezultat slabši:

Graphics[{Circle[{0,0},1],PointSize[Small],Table[Point[nakljucna4[x|->(x^2)]], {3000}]}]

Kvadratni koren na videz deluje:

Graphics[{Circle[{0,0},1],PointSize[Small],Table[Point[nakljucna4[x|->(Sqrt[x])]], {10000}]}]

Domača naloga: Kako bi to potrdili z ustreznim izračunom?