Galton deszka
A Galton-deszka egy lejtősen
felállított, egyenlőszárúháromszög alakú deszka, melynek a felső csúcsától az
alaplapja felé golyókat lehet legurítani, melyek az útjukba eső akadályokon 1/2
– 1/2 valószínűséggel térnek el jobbra illetve balra, míg végül kis dobozokban
gyűlnek össze. Ha N darab eltérítési lehetőséggel találkozik, akkor N+1
dobozban gyűlnek össze golyók. Annak valószínűsége, hogy egy golyó a K. csatornába esik: (N alatt a K)/2n, azaz
binomiális eloszlást követ. A nagy számok törvénye szerint, ha N elég nagy,
akkor a binomiális eloszlás a normális eloszláshoz közelít.
Programunk a fent leírt folyamatot
szimulálja. A dobozokba esett golyókat egyre magasabb fehér téglalap jelzi.
Folyamatosan kiírja a középső öt doboz tartalmát, valamint az összes
felhasznált golyó számát. Ha az öt legtöbb golyót tartalmazó doboz valamelyike
tele van, leáll a szimuláció. Közben a program nem állítható meg. A futás
lassítása érdekében, egy
For
L:= 1 To 100 Do Pixels[200,20]:= clBlue;
sort
tartalmaz, melynek paraméterei az aktuális gép sebességéhez illesztendők.
A program startra kész állapotban:
A program futási képe, amikor a 11. doboz tartalma 70 fölé
nőtt:
A futási kép az animáció befejeztével:
A program listája:
unit UGalton;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type
TfmGalton = class(TForm)
btStart: TButton;
btKilepes: TButton;
Procedure Deszka;
Procedure Animacio;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure btStartClick(Sender: TObject);
procedure btKilepesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TGolyo= Class
Fx, Fy, Fr, Fd: Integer;
Fm: Boolean;
Procedure Init(Ix, Iy, Ir: Integer);
Procedure Show;
Procedure Hide;
Procedure MoveRel(X, Y: Integer);
Function Moved: Boolean;
Procedure SetMove;
Function GetX: Integer;
Function GetY: Integer;
Function GetD: Integer;
Procedure SetD(D: Integer);
End;
Const N= 20; M= 32; Dx= 48; Dy= 24; Ex= -400; Ey= 20; R=4;
var
fmGalton: TfmGalton;
Xk, Yk: Integer;
Fg: Array[1..M+1] Of TGolyo;
D: Array[1..N+1] Of Integer;
implementation
{$R *.dfm}
Procedure TGolyo.Init(Ix, Iy, Ir: Integer);
Begin
Fx:= Ix; Fy:= Iy; Fr:= Ir; Fd:= 0; Fm:= False;
End;
Procedure TGolyo.Show;
Begin
With fmGalton.Canvas Do
Begin
Pen.Color:= clWhite;
Brush.Color:= clWhite;
Ellipse(Fx-Fr, Fy-Fr, Fx+Fr, Fy+Fr);
End;
End;
Procedure TGolyo.Hide;
Begin
With fmGalton.Canvas Do
Begin
Pen.Color:= clBlue;
Brush.Color:= clBlue;
Ellipse(Fx-Fr, Fy-Fr, Fx+Fr, Fy+Fr);
End;
End;
Procedure TGolyo.MoveRel(X, Y: Integer);
Begin
Hide; Fx:= Fx + X; Fy:= Fy + Y; Show;
End;
Function TGolyo.Moved: Boolean;
Begin
Moved:= Fm;
End;
Procedure TGolyo.SetMove;
Begin
Fm:= True;
End;
Function TGolyo.GetX: Integer;
Begin
GetX:= Fx;
End;
Function TGolyo.GetY: Integer;
Begin
GetY:= Fy;
End;
Function TGolyo.GetD: Integer;
Begin
GetD:= Fd;
End;
Procedure TGolyo.SetD(D: Integer);
Begin
Fd:= D;
End;
Procedure TfmGalton.Deszka;
Var I, J: Byte;
Ws: String;
Begin
With Canvas Do
Begin
Pen.Color:= clBlue;
Brush.Color:= clBlue;
Rectangle(0,0,2*Xk,2*Yk);
With Pen Do
Begin
Width:= 3;
Color:= clWhite;
End;
MoveTo(Xk-2*R-1,0); LineTo(Xk-2*R-1,6*R); LineTo(6*R,Xk-2*R-1);
MoveTo(Xk+2*R+1,0); LineTo(Xk+2*R+1,6*R); LineTo(2*Xk-6*R,Xk-2*R-1);
With Pen Do
Begin
Width:= 1;
Color:= clRed;
End;
Brush.Color:= clRed;
For I:= 1 To N Do For J:= I To N Do
Begin
If Odd(J) Then
Begin
MoveTo(Dx*(N-I)+Dx*(J Div 2)+Ex,Dy*J+Ey);
LineTo(Dx*(N-I)+Dx*(J Div 2)+Ex-2*R,Dy*J+Ey+2*R);
LineTo(Dx*(N-I)+Dx*(J Div 2)+Ex,Dy*J+Ey+4*R);
LineTo(Dx*(N-I)+Dx*(J Div 2)+Ex+2*R,Dy*J+Ey+2*R);
LineTo(Dx*(N-I)+Dx*(J Div 2)+Ex,Dy*J+Ey);
FloodFill(Dx*(N-I)+Dx*(J Div 2)+Ex,Dy*J+Ey+1,clRed,fsBorder);
End Else
Begin
MoveTo(Dx*(N-I)+Dx*(J Div 2)-Dx Div 2+Ex,Dy*J+Ey);
LineTo(Dx*(N-I)+Dx*(J Div 2)-Dx Div 2+Ex-2*R,Dy*J+Ey+2*R);
LineTo(Dx*(N-I)+Dx*(J Div 2)-Dx Div 2+Ex,Dy*J+Ey+4*R);
LineTo(Dx*(N-I)+Dx*(J Div 2)-Dx Div 2+Ex+2*R,Dy*J+Ey+2*R);
LineTo(Dx*(N-I)+Dx*(J Div 2)-Dx Div 2+Ex,Dy*J+Ey);
FloodFill(Dx*(N-I)+Dx*(J Div 2)-Dx Div 2+Ex,Dy*J+Ey+1,clRed,fsBorder);
End;
End;
Pen.Color:= clWhite;
Brush.Color:= clBlue;
For I:= 1 To N+1 Do
Begin
MoveTo(I*Dx-9*R,(N+2)*Dy-R);
LineTo(I*Dx-9*R,2*Yk-15);
MoveTo(I*Dx+R,(N+2)*Dy-R);
LineTo(I*Dx+R,2*Yk-15);
MoveTo(I*Dx-9*R,2*Yk-15);
LineTo(I*Dx+R,2*Yk-15);
Font.Color:= clBtnFace;
Str(I,Ws); TextOut(I*Dx-5*R, 2*Yk-14, Ws);
End;
With Font Do
Begin
Name:= 'Times New Roman';
Color:= clYellow;
Size:= 30;
Style:= [fsBold,fsUnderLine];
End;
TextOut(100,10,'Galton'); TextOut(2*Xk-200,10,'Deszka');
With Font Do
Begin
Size:= 12;
Name:= 'courier';
Style:= [fsBold];
End;
End;
For I:= 1 To M+1 Do
Begin
Fg[I]:= TGolyo.Create;
Fg[I].Init(Xk,R,R); Fg[1].Show;
End;
Fg[1].SetMove;
End;
procedure TfmGalton.btKilepesClick(Sender: TObject);
begin
Close;
end;
procedure TfmGalton.FormCreate(Sender: TObject);
begin
Xk:= ClientWidth Div 2;
Yk:= ClientHeight Div 2;
Randomize;
end;
Procedure TfmGalton.Animacio;
Var I, K: Byte;
L: LongInt;
S, SM: Word;
Ws: String;
Begin
I:= 1; S:= 0; SM:= 2*Yk-(N+3)*Dy;
Repeat
With Fg[I] Do If Moved Then With Canvas Do
Begin
MoveRel(GetD,1);
If GetY Mod Dy=0 Then
Begin
SetD(1-2*Random(2));
Fg[I+1].SetMove;
End;
If GetY>(N+1)*Dy Then
Begin
K:= ((GetX-5*R) Div Dx)+1; Inc(D[K]);
Brush.Color:= clWhite;
Pen.Color:= ClWhite;
Rectangle((K-1)*Dx+4*R,2*Yk-2-D[K]-12,(K-1)*Dx+Dx,2*Yk-14);
Hide; Init(Xk,R,R); SetMove; Show; Inc(S);
Pen.Color:= clBlue;
Brush.Color:= clBlue;
Font.Color:= clWhite;
Rectangle(100,100,200,210);
Str(S,Ws); TextOut(100,100,'Teljes: '+Ws);
Str(D[ 9],Ws); TextOut(2*Xk-200,100,'D[ 9]: '+Ws);
Str(D[10],Ws); TextOut(2*Xk-200,120,'D[10]: '+Ws);
Str(D[11],Ws); TextOut(2*Xk-200,140,'D[11]: '+Ws);
Str(D[12],Ws); TextOut(2*Xk-200,160,'D[12]: '+Ws);
Str(D[13],Ws); TextOut(2*Xk-200,180,'D[13]: '+Ws);
End;
For L:= 1 To 100 Do Pixels[200,20]:= clBlue;
End;
Inc(I); If I>M Then I:= 1;
Until (D[9]>SM) Or (D[10]>SM) Or
(D[11]>SM) Or (D[12]>SM) Or (D[13]>SM);
For I:= 1 To M+1 Do Fg[I].Hide;
End;
procedure TfmGalton.btStartClick(Sender: TObject);
begin
Animacio;
end;
procedure TfmGalton.FormPaint(Sender: TObject);
begin
Deszka;
end;
end.