Beispiele zu Monte-Carlo-Methoden mit Mathematica

Experiment: Berechnung von Π nach reellen Werten (Monta-Carlo, Zufall bei der Gegenstandsauswahl)

Messe bei 10 runden Gegenständen Umfang und Durchmesser. Berechne daraus eine Näherung von Π.

Simmulation: Berechnung von Π

f[x_,y_]:=0 /;(y> Sin[ArcTan[y/x]]);
f[x_,y_]:=1 /;(y<=Sin[ArcTan[y/x]]);
t[k_]:=Table[f[Random[],Random[]],{n,1,10000}];
u[k_]:=4 (Plus@@t[k])/Length[t[k]] //N;
Print[Table[u[k],{k,1,10}]];
Mean[Table[u[k],{k,1,10}]]

Simmulation: Berechnung von Π nach  Buffon (Monte Carlo)

k=100;
p[n_]:={Random[],Random[]};
tp=Table[p[n],{n,1,k}];
α[n_]:=2 Pi Random[];
tα=Table[α[n],{n,1,k}];
q[n_]:=tp[[n]]+0.5 {Sin[tα[[n]]],Cos[tα[[n]]]};
tq=Table[q[n],{n,1,k}];
poi[n_]:=Point[tp[[n]]];
qoi[n_]:=Point[tq[[n]]];
lin[n_]:=Line[{tp[[n]],tq[[n]]}];
Show[Graphics[Prepend[
Union[
Flatten[Table[{poi[n],qoi[n],lin[n]},{n,1,k}]],{Line[{{-0.5,0},{1.5,0}}],Line[{{-0.5,1},{1.5,1}}]}]
,PointSize[0.02]]],AspectRatio->Automatic];

k=1000;
p[n_]:={Random[],Random[]};
tp=Table[p[n],{n,1,k}];  (* Print[tp];  *)
α[n_]:=2 Pi Random[];
tα=Table[α[n],{n,1,k}]; 
q[n_]:=tp[[n]]+0.5 {Cos[tα[[n]]],Sin[tα[[n]]]};
tq=Table[q[n],{n,1,k}]; (* Print[tq]; *)
ty=Table[
{Min[{tp[[n]][[2]],tq[[n]][[2]]}],Max[{tp[[n]][[2]],tq[[n]][[2]]}]},{n,1,k}]; (* Print[ty]; *) 
tw=Table[
{Floor[Min[{tp[[n]][[2]],tq[[n]][[2]]}]],Floor[Max[{tp[[n]]v,tq[[n]][[2]]}]]},{n,1,k}]; (* Print[tw]; *)
tz=Table[
{Floor[Min[{tp[[n]][[2]],tq[[n]][[2]]}]]^2,Floor[Max[{tp[[n]][[2]],tq[[n]][[2]]}]]},{n,1,k}]^2; (* Print[tz];  *)
Print[k/Apply[Plus,Flatten[tz]]//N];
(* Print[{Min[Flatten[ty]],Max[Flatten[ty]]}] *)
poi[n_]:=Point[tp[[n]]];
qoi[n_]:=Point[tq[[n]]];
lin[n_]:=Line[{tp[[n]],tq[[n]]}];
Show[Graphics[Prepend[
Union[
Flatten[Table[{poi[n],qoi[n],lin[n]},{n,1,k}]],{Line[{{-0.5,0},{1.5,0}}],Line[{{-0.5,1},{1.5,1}}]}]
,PointSize[0.02]]],AspectRatio->Automatic];

k=1000;
tabOut=Table[
p[n_]:={Random[],Random[]};
tp=Table[p[n],{n,1,k}];
α[n_]:=2 Pi Random[];
tα=Table[α[n],{n,1,k}]; 
q[n_]:=tp[[n]]+0.5 {Cos[tα[[n]]],Sin[tα[[n]]]};
tq=Table[q[n],{n,1,k}]; 
ty=Table[
{Min[{tp[[n]][[2]],tq[[n]][[2]]}],Max[{tp[[n]][[2]],tq[[n]][[2]]}]},{n,1,k}]; 
tw=Table[
{Floor[Min[{tp[[n]][[2]],tq[[n]][[2]]}]],Floor[Max[{tp[[n]]v,tq[[n]][[2]]}]]},{n,1,k}]; 
tz=Table[
{Floor[Min[{tp[[n]][[2]],tq[[n]][[2]]}]]^2,Floor[Max[{tp[[n]][[2]],tq[[n]][[2]]}]]},{n,1,k}]^2;
k/Apply[Plus,Flatten[tz]]//N,
{u,1,10}];
Print[tabOut];
Print["Mittelwert = ",Apply[Plus,tabOut]/Length[tabOut]];