Valószínűségszámítás és dinamikus objektumok

(Nehéz fogalmak...)

Dinamikus objektumok

A változó értékek megjelennek

Dynamic[kif]

Dynamic[x]

x=0.5

Kapcsoljuk össze

Slider[Dynamic[x]]

Dynamic[Integrate[Sin[t],{t,-π,x}]]

SetterBar[Dynamic[p],Range[0,1,0.2]]

Dynamic[Plot[Sin[(1-p) x],{x,0,6}]]

Nem lokális

{Slider[Dynamic[x]],Dynamic[x]}

Most már az

{DynamicModule[{x},{Slider[Dynamic[x]],Dynamic[x]}],Dynamic[x]}

x=2

Inicializálás

{DynamicModule[{x=0.5},{Slider[Dynamic[x]],Dynamic[x]}],Dynamic[x]}

Önindító

DynamicModule[{x=1},Dynamic[x=Max[0,x-0.01]]]

DynamicModule[{x=1},{Slider[Dynamic[x]],Dynamic[x=Max[0,x-0.01]]}]

Dynamic[DateString[]]

Update

Dynamic[DateString[],UpdateInterval->1]

{DynamicModule[{p={0,0}},Framed@Graphics[{Locator[Dynamic[p]]},PlotRange->1,PlotLabel->Dynamic[p]]],DynamicModule[{p={0,0}},Framed@Graphics[{Dynamic[Locator[p]]},PlotRange->1,PlotLabel->Dynamic[p]]]}

{InputField[Dynamic[x]],Dynamic[x]}

{,}

{PopupMenu[Dynamic[x],Range[10]],Dynamic[x]}

DynamicModule[{x={0,0}},{Graphics[Locator[Dynamic[x]],PlotRange->1],Dynamic[x]}]

Maradj a körvonalon: kijavítva!

DynamicModule[{p={0,1}},Graphics[{Dashed,Circle[],PointSize[0.1],Locator[Dynamic[p,(p=Normalize[#])&]]},ImageSize->Tiny,PlotRange->1.2]]

Kalkulátorka

DynamicModule[{a=0,b=0,s={{5,30},{1,Infinity}}},Deploy[Style[Panel[Grid[Transpose[{{Style["input a number",Red],Style["input another number",Red],"here is their sum","their difference","their product"},{InputField[Dynamic[a],Number],InputField[Dynamic[b],Number],InputField[Dynamic[a+b],Enabled->False],InputField[Dynamic[a-b],Enabled->False],InputField[Dynamic[a b],Enabled->False]}}],Alignment->Right],ImageMargins->10],DefaultOptions->{InputField->{ContinuousAction->True,FieldSize->s}}]]]

Column[{Dynamic[{Quotient[x,60],Mod[x,60],SetPrecision[10a,2]}],Trigger[Dynamic[x,(a=FractionalPart[#];x=Round[#])&],{0,Infinity}]}]

Speciális csúszka

DynamicModule[{angle=0,p={1,0}},{LocatorPane[Dynamic[p,(angle=ArcTan@@#;p={Cos[angle],Sin[angle]})&],Graphics[{Circle[],Arrowheads[0.15],Arrow[Dynamic[{{0,0},p}]]},ImageSize->Tiny],Appearance->None],Dynamic[angle]}]

Eloszlások

Milyenek vannak?

?B*Distribution

ExponentialDistribution[λ]

PDF[ExponentialDistribution[λ],x]

CDF[ExponentialDistribution[λ],x]

Eloszlások jellemzői

Through[{Mean,Variance,Skewness,Kurtosis}[ExponentialDistribution[λ]]]

CentralMoment[ExponentialDistribution[λ],2]

Esc dist Esc: \[Distributed]

Expectation[(X^(1/2)),X\[Distributed]ExponentialDistribution[λ]]

Expectation[(((x-1))^2)+(E^(-x)),x\[Distributed]NormalDistribution[]]

Független valváltozókra:

Expectation[X+Y,{X\[Distributed]NormalDistribution[μ,1],Y\[Distributed]NormalDistribution[ν,1]}]

Expectation[X Y,{X\[Distributed]NormalDistribution[μ,1],Y\[Distributed]NormalDistribution[ν,1]}]

Expectation[(X^(1/2))+Log[Y],{X\[Distributed]ExponentialDistribution[λ],Y\[Distributed]NormalDistribution[0,1]}]

Expectation[(X^(1/2))+Log[Abs[Y]],{X\[Distributed]ExponentialDistribution[λ],Y\[Distributed]NormalDistribution[0,1]}]

Feltételes várható érték

ClearAll[x]

Esc cond Esc :\[Conditioned]

Expectation[x+(y^2)-(3/10)\[Conditioned](1/2<x<3/4),{x,y}\[Distributed]DirichletDistribution[{1,3,4}]]

Mikor sűrűségfüggény?

f[x_,a_,b_,A_]:=A/(1+a(((x-b))^2))

Integrate[f[x,a,b,A],{x,-∞,+∞},Assumptions->{{a,b,A}∈Reals,a>0}]

ClearAll[a,b,A];
First@Solve[Integrate[f[x,a,b,A],{x,-∞,+∞},Assumptions->{{a,b,A}∈Reals,a>0}]==1,A]

Új eloszlás bevezetése

UpValues, DownValues

g-re vonatkozik

g/:f[g[x_]]:=h[x]

UpValues[g]

??f

UpValues[h]={h[x_]*h[y_]:>htimes[x,y]};

h[a] h[b]

UpSet[lhs,rhs]

Azzal társítja, ami lhs-ben az 1 szinten van.

f[g[x]]=...

f-re vonatkozik

f[g[x]]^=...

g-re vonakozik

square/:area[square]=a^2;
area[rectangle]^=a*b;

Nincs köze Exp-hez

Exp[g[x_]]^:=expg[x]

??Exp

Exp[g[5]]

??g

g/:g[x_]+g[y_]:=gplus[x,y]

?g

g[5]+g[7]

Ha a szokásos módon definiáltuk volna (DownValues), akkor mindne Plus fejű kifejezésnél megnézné, h mi van a hasában.

quat[x_]+quat[y_]^:=quat[x+y]

quat[a]+quat[b]+quat[c]

Kiterjesztjük Plus hatókörét g fejű objektumokra.

Alkalmazás

Hogyan csináljunk üzenetet?

?GeneralizedExtremeValueDistribution

Clear[GeneralizedExtremeValueDistribution,μ,σ,ξ,x];

GeneralizedExtremeValueDistribution::usage="GeneralizedExtremeValueDistribution[μ,σ,ξ] is the generalized extreme value distribution (GEV) with location parameter μ, scale parameter σ, and shape parameter ξ.";

GeneralizedExtremeValueDistribution/:CDF[GeneralizedExtremeValueDistribution[μ_,σ_,ξ_],x_]:=UnitStep[x-μ+(σ/ξ)]Exp[-(((1+((ξ(x-μ) )/σ)))^(-(1/ξ)))];

GeneralizedExtremeValueDistribution/:PDF[GeneralizedExtremeValueDistribution[μ_,σ_,ξ_],x_]=Simplify[D[CDF[GeneralizedExtremeValueDistribution[μ,σ,ξ],x],x]];

GeneralizedExtremeValueDistribution/:Mean[GeneralizedExtremeValueDistribution[μ_,σ_,0]]=μ+σ EulerGamma;

Mean[GeneralizedExtremeValueDistribution[3,1,0]]

De ez nem megy:

Expectation[X,X\[Distributed]GeneralizedExtremeValueDistribution[3,1,0]]

Véletlenszám-generálás

RandomReal, RandomInteger, RandomChoice, SeedRandom[n,Method->""]

Monte Carlo módszerek

RandomReal[{0,1},2]

pi[n_]:=N[4Count[Table[RandomReal[{0,1},2,WorkingPrecision->32],{n}],x_/;Norm[x]<1]/n,16]

pi[55555]

Lépésszámban lineáris.

ListLinePlot[Accumulate[RandomReal[{-1,1},100]],PlotLabel->"Érdemes ismételgetni!"]

Generátorfüggvények

ClearAll[p,k,z];Factor@Sum[PDF[BinomialDistribution[17,p],k](z^k),{k,0,17}]

G[λ_,z_]:=Sum[(((λ^k)(E^(-λ)))/(k!))(z^k),{k,0,+∞}]

G[λ,z]

{D[G[λ,z],{z,1}]/.{z->1},Mean[PoissonDistribution[λ]]}

Ez áttekinthetőbb:

Derivative[0,1][G][λ,1]

Karakterisztikus függvények

CharacteristicFunction[CauchyDistribution[0,1],t]

CharacteristicFunction[NormalDistribution[0,1],t]

CharacteristicFunction[PoissonDistribution[λ],t]/.{t->z/I}

CharacteristicFunction[GeneralizedExtremeValueDistribution[3,1,0],t]

Momentumok

cm[n_]:=D[CharacteristicFunction[NormalDistribution[],t],{t,n}]/(I^n)/.{t->0}

TableForm[{cm/@Range[4],Through[{Mean,Variance, Skewness, Kurtosis}[NormalDistribution[]]]}]

Markov-láncok

Majd, ha lesznek, ez jól jön

MatrixPower, Limit[MatrixPower[P,n],n->+∞]

Elágazó folyamatok (branching process)

NestList[(#/.z->G[λ,z])&,G[λ,z],2]//Simplify

A kihalás valószínűsége:

FindRoot[G[2,z]==z,{z,0}]

Statisztika

Direkt feladatok

({{Adott, →, Kiszám}, {csoport, →, normálosztó}, {függvény, →, inflexiós pont}, {esemény, →, valószínűség}, {diffegy., →, megoldás}})

Alkalmazásoknál inverz feladatokat kell megoldani: adott a második oszlop egy eleme, mit tudunk mondani az első elemről?

Kolmogorov-Szmirnov-próba

Az eloszlásfüggvény definíciója: F(x):=P(X<x).  Nyilván azt várjuk, hogy a mintában az x-nél kisebb elemek relatív gzakorisága közel legyen ehhez az értékhez. Elkészítjük az empiriuks eloszlásfüggvényt, majd összevetjük az igazival. A Kolmogorov-Szmirnov-eloszlás megmondja, hogy mikor kaptunk akkora eltérést, ami már nem hihető.

CDFEmpirical[dat_,x_]:=N[Count[dat,(y_/;y<x)]/Length[dat]];

Plot[CDFEmpirical[{1,1,1,1,5},x],{x,0,6}]

ClearAll[CDFKS];CDFKS[x_,ig_:20]:=(∑_(i=-ig)^ig)(((-1))^i)(E^(-2(i^2)(x^2)));

A good approximation of the Kolmogorov distribution follows. (Otherwise, there are problems around zero.)

K[x_]:=(CDFKS[x,40]+CDFKS[x,41])/2;

crit=x/.FindRoot[K[x]==0.95,{x,2}]

FindRoot[K[x]==0.99,{x,2}]

CDFDiszkrétEgyenletes[{m_,n_},z_]:=Sum[(1/(n-m+1))UnitStep[z-k],{k,m,n}]

Plot[CDFDiszkrétEgyenletes[{1,5},z],{z,0,6}]

ClearAll[KSTest];
KSTest[data_,divisions_,p_:0.95]:=Module[{crit,stat,n=Length[data],lev},
{"Statistics"->(stat=(Sqrt[n])Max[Table[Abs[CDFEmpirical[data,z]-CDFDiszkrétEgyenletes[{1,5},z]],{z,0.5,5.5,(1./divisions)}]]),"Critical"->(crit=x/.FindRoot[K[x]==p,{x,2}]),"Level"->(lev=K[stat]),If[stat<crit,"\nDistribution fitting at a level "<>ToString[100p]<>"%.",TextCell["Distribution not fitting.",CellFrame->True]]}]

KSTest[{1,1,1,1,5},5]

A kis elemszám miatt elfogadjuk. Szokni kell hozzá ☺.

KSTest[{1,1,1,1,1},5]

KSTest[{5,5,5,5,5},5]

KSTest[{5,5,5,5,1},5]

KSTest[{5,5,5,5,1,2,3,2,3,4},5]

KSTest[RandomInteger[{1,3},100],5]

Plot[{CDFEmpirical[{1,1,1,1,5},x],CDFDiszkrétEgyenletes[{1,5},x]},{x,0.5,5.5},Exclusions->Range[5],PlotStyle->Thick,Epilog->{Arrow[{{1.5,0.2},{1.5,0.8}}],Arrow[{{1.5,0.8},{1.5,0.2}}]},PlotLabel->"A nyíl mutatja a maximális eltérést.\n"]

Azután megtalálja az ember készen ezt:

Plot[CDF[DiscreteUniformDistribution[{1,5}],z],{z,0,6}]

Demonstrációk

Hyperlink["Vető Bálinté","http://demonstrations.wolfram.com/TheTrueSelfAvoidingRandomWalkInZ/"]

Házi feladatok

1. Ellenőrző számolás

Számítsuk ki egy λ paraméterű exponenciális eloszlású valószínűségi változó négyzetgyökének sűrűségfüggvényét!

2. Az írogató majom

Ül a billentyűzet előtt, és véletlenszerűen* nyomogatja a billentyűket, a szóközt is. A váltót nem: a nagy- és kisbetűk között nem teszünk különbséget. Kérdés: ha sokáig dolgozik, az előállított szavak (két szóköz határolta részek) hányadrésze lesz értelmes, vagyis lesz benne a szótárban? Hasznos függvények:

RandomChoice

WordData

A ,,véletlenszerűen” arra utal, hogy adott eloszlás szerint. Ki talál olyan, nagyon jó eloszlást, amely sok és sokféle értelmes szót származtat?

3. Lottószámok

Vizsgáljuk meg a lottóhúzásokat (egy részüket stb.) egyenletesség szempontjából a Kolmogorov-Szmirnov-próba segítségével.

4. Görbék rekonstrukciója

Adott egy térgörbe görbülete és torziója, rekonstruáljuk a görbét. Hasznos függvények:

NDSolve(ArrayFlatten, KroneckerProduct)

5. Kettős Pareto-eloszlás

Vezessük be a kettős Pareto-eloszlást új eloszlásként.