< -->
Program ModellingOfRandomProcesses{Моделирование случайных процессов};
{$N+,G+,D-}
Uses Graph, CRT;
const
{ N = 10000;}
{ NColumn = 63;}
NColumn = 100;
const
UserPattern : FillPatternType =
($11, $22, $22, $11, $22, $88, $88, $22);{"Косой пр-к"}
UserPatternX : FillPatternType =
($12, $21, $21, $12, $21, $48, $84, $12);{"?"}
UserPatternS : FillPatternType =
($00, $3C, $42, $30, $0C, $42, $3C, $00);{"S"}
UserPatternM : FillPatternType =
($C6, $AA, $AA, $92, $82, $82, $82, $00);{"M"}
var
seed : Word;
D, R, e : Integer;
N, N1, i, RndSeed : Longint;
OldPattern : FillPatternType;
NDrop : array [0..NColumn] of LongInt;
Medial, Dispers, f1 : Extended;{Среднее}
NMax : Word;
z : Integer{Word};
S, S1 : String;
PBar : Pointer;
ImSz, HMode : Word;
Xmm, Ymm, Xm, Ym, dx : Word;
Pi_, Beta, Lambda, eps, omg : Extended;
{=========== Мышь ==============}
Procedure InitMouse; Assembler;
asm
mov ax, 0
int 33h
end;
Procedure ShowMouse; Assembler;
asm
mov ax, 1
int 33h
end;
Procedure HideMouse; Assembler;
asm
mov ax, 2
int 33h
end;
Function MouseButt : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, bx
end;
Function MouseX : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, cx
end;
Function MouseY : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, dx
end;
{=========--------- Поиск максимального элемента ----------========}
Function Max(Ar : array of LongInt) : Word;
var
Mx : Word;
j : Word;
begin
Mx := 0;
for j := 1 to NColumn do
if Ar[Mx]635-dx) then Xm := 635-dx;
if Ym<17 then Ym := 17;
HideMouse;
ImSz := ImageSize(Xm, Ym, Xm+dx, Ym-15);
GetMem(PBar, ImSz);
GetImage(Xm, Ym, Xm+dx, Ym-15, PBar^);
for i := 1 to dy do
begin
Bar(Xm, Ym, Xm+dx, Ym-i);
Delay(30);
end;
SetColor(DarkGray);
OutTextXY(Xm+2, Ym-11, S);
ShowMouse;
Ym := Ym - 15;
end;
Procedure PopupMenuBar;
const
NStr = 11;
begin
S := '-----------------------------------------';
dx := Length(S)*8+3;
if (Xm>635-dx) then Xm := 635-dx;
if Ym>(470 - 15*NStr) then Ym := (470 - 15*NStr);
HideMouse;
GetFillPattern(OldPattern);
ImSz := ImageSize(Xm, Ym, Xm+dx, Ym+15*NStr);
GetMem(PBar, ImSz);
GetImage(Xm, Ym, Xm+dx, Ym+15*NStr, PBar^);
SetColor(DarkGray);
SetFillStyle(1, DarkGray);
Bar(Xm, Ym, Xm+dx, Ym+15*NStr);
SetFillPattern(UserPatternS, LightGray);
Bar(Xm+2, Ym+2, Xm+dx-1, Ym+15*NStr-1);
SetFillPattern(UserPatternX, Blue);
Bar(Xm+2, Ym+2, Xm+dx-1, Ym+17);
SetFillPattern(OldPattern, White);
SetColor(LightRed);
S1 := 'Моделирование случайных процессов';
OutTextXY(Xm+2, Ym+5, S1);
SetColor(LightGreen);
OutTextXY(Xm+2, Ym+15, S);
SetColor(Yellow);
Str(Lambda:1:5, S1);
S := 'Лямбда = '+S1;
OutTextXY(Xm+2, Ym+30, S);
Str(Beta:1:5, S1);
S := 'Бета = '+S1;
OutTextXY(Xm+2, Ym+45, S);
Str(eps:1:5, S1);
S := 'Хи квадрат = '+S1;
OutTextXY(Xm+2, Ym+60, S);
Str(Medial:1:10, S1);
S := 'Среднее(матем. ожижание) = '+S1;
OutTextXY(Xm+2, Ym+75, S);
Str(Dispers:1:10, S1);
S := 'Дисперсия = '+S1;
OutTextXY(Xm+2, Ym+90, S);
Str(sqrt(Dispers):1:7, S1);
S := 'Корень из дисперсии = '+S1;
OutTextXY(Xm+2, Ym+105, S);
f1 :=F(- Lambda/2+Beta);
Str(f1:1:7, S1);
S := 'F(-Lambda/2+Beta) = '+S1;
OutTextXY(Xm+2, Ym+120, S);
f1 :=F( Lambda/2+Beta);
Str(f1:1:7, S1);
S := 'F(Lambda/2+Beta) = '+S1;
OutTextXY(Xm+2, Ym+135, S);
f1 :=F(Beta);
Str(f1:1:7, S1);
S := 'F(Beta) = '+S1;
OutTextXY(Xm+2, Ym+150, S);
ShowMouse;
end;
{========----- Процедура для вывода подсказок с % -------==========}
Procedure MouseMessages;
const
NStr = 3;
begin
ShowMouse;
While not Keypressed do
begin
While (MouseButt = 0) and not KeyPressed do;
Xmm := MouseX;
Ymm := MouseY;
Xm := Xmm;
Ym := Ymm;
z := Round(1.0*Xmm*(NColumn)/639.0);
if not KeyPressed then
case MouseButt of
1 :
if (Ymm>=Round(470.0-470.0*NDrop[z]/NDrop[NMax])) then
PopupBar;
2 :
if (Ymm NIL then
FreeMem(PBar, ImSz);
Break;
end;
While (MouseButt = 0) and not KeyPressed do;
if KeyPressed then
begin
if PBar <> NIL then
FreeMem(PBar, ImSz);
Break;
end;
HideMouse;
if PBar<>NIL then
PutImage(Xm, Ym, PBar^, NormalPut);
if PBar <> NIL then
FreeMem(PBar, ImSz);
PBar := NIL;
if MouseButt = 3 then DrawHistogram(HMode);
ShowMouse;
end;
HideMouse;
end;
{=============== Основная программа ================}
begin
HMode := 0;
ClrScr;
N := 100000; {Выборка}
Pi_ := Pi;
Beta := 0.1;
Lambda := 1;
Medial := 0.0;
Dispers := 0.0;
eps := 0;
Randomize;{Инициализируем генератор случайных чисел}
RndSeed := RandSeed;
Seed := Lo(RndSeed);
WriteLn('Подождите, идет рассчёт распределения для ', N, ' случайных чисел...');
for i := 0 to NColumn do NDrop[i]:=0;{Обнуляем массив}
for i := 1 to N do
begin
{ z := Round((Random(470)+1)*1.0*NColumn/470.0);{Генератор паскалевский}
{ z := Round(exp(-MyRand1*1.0/65536.0)*NColumn);{Мой генератор случ. слов}
{ z := Round((MyRand1*1.0/65536.0)*NColumn);{Мой генератор случ. слов}
{ z := Round(Random*NColumn);{Генератор случайных действительных чисел}
f1 :=F(Lambda*MyRand1/65536.0 - Lambda/2+Beta);
Medial := Medial + f1;
Dispers := Dispers + sqr(f1);
z := Round((f1+1)*NColumn/2){+(NColumn{+1}{) div 2};{Мой генератор случ. слов}
{ ^ ^ ^ - Лучший генератор из имеющихся здесь}
{ z := Round(F(Lambda*Random - Lambda/2+Beta)*NColumn)+32;{Генератор случайных действительных чисел}
if (z >= 0) and (z<=NColumn) then NDrop[z]:=NDrop[z]+1;
GotoXY(1,2);
if i mod 10000 = 0 then
WriteLn((100*i/N) : 1 : 1, '% ', z);
end;
WriteLn('Поиск максимального элемента...');
NMax := Max(NDrop);
WriteLn('Среднее, дисперсия...');
Medial := Medial/N+Beta;
Dispers := Dispers/N;
WriteLn('Расчёт Хи-квадрат...');
for i := 1 to (NColumn-1) do
begin
omg := OmegaK(i);
eps := eps + sqr((NDrop[i]/N)-omg)/omg;
GotoXY(1, 6);
WriteLn((100*i/NColumn) : 1 : 2, '%; Omega[',i,']=', Omg:1:4, ' N/Nmx=',NDrop[i]/N:1:4,' Хи=', eps :1:4 );
end;
eps := eps * (N);
WriteLn('Хи квадрат равно ', eps:1:5);
{ f1 :=F(-Lambda/2+Beta);
WriteLn(f1:5:5);
f1 :=F(Lambda/2+Beta);
WriteLn(f1:5:5);
f1 :=F(Beta);
WriteLn(f1:5:5);
ReadKey;}
D := Detect; {Инициализируем графику}
InitGraph(D, R, '');
e := GraphResult;
if e <> grOk then {Если ошибка}
begin
WriteLn('Ошибка инициализации графики!');
WriteLn(GraphErrorMsg(e));
ReadKey;
Halt($FFFF);
end;
InitMouse;
DrawHistogram(HMode);
MouseMessages;
CloseGraph;
While KeyPressed do ReadKey;
for i := 0 to NColumn do
Write(NDrop[i] : 4, ' ');
WriteLn;
N1 := 0;
for i := 0 to NColumn do
N1 := N1 + NDrop[i];
WriteLn('Сумма : ', N);
{ WriteLn('Dispers=', Dispers:2:3);
WriteLn('sqrtDispers=', sqrt(Dispers):2:3);}
WriteLn('Максимальный элемент N ', NMax + 1, ' = ', NDrop[NMax]);
WriteLn('Потеряно: ', N-N1, '; ', 100.0*(N-N1)/N : 1 : 2, '%');
ReadKey;
end.
Назад