Добавил:
Kurume
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:ОНИ / Гуменюк А.С / Цифровое моделирование систем передачи данных / GAS / 123
.PAS USES CRT, Graph;
Type
TTable=Array [0..2500] of Real;
Const
e =0.00001; {в®з®бвм}
Var
RealDistr:TTable;{ђҐ «м®Ґ а бЇаҐ¤Ґ«ҐЁҐ}
RealDist:TTable;{‚бЇ®¬®Ј ⥫м п в Ў«Ёж ¤«п Ї®бв஥Ёп ॠ« а бЇ}
X, Y, Step:Real;{„«п ®ЇаҐ¤Ґ«ҐЁп Ја Ёж "Є а¬ ®ў"}
I,Pn:LongInt;
F:Text; {” ©« ¤«п १г«мв в®ў}
FileName: String; {€¬п д ©« १г«мв в®ў}
Vn:Integer; {Є®«-ў® "Є а¬ ®ў" ЇаЁ ®в®Ўа ¦ҐЁЁ}
K:Integer; {Љ®«ЁзҐбвў® Є а¬ ®ў}
V:LongInt; {‚Ґ«ЁзЁ ўлЎ®аЄЁ}
Imin, {ЌЁ¦пп Ја Ёж ЁвҐаў « }
Imax: Real; {‚Ґаепп Ја Ёж ЁвҐаў « }
Fmin, {ЊЁ § п д-жЁЁ}
Fmax: Real; {Њ Єб § з д-жЁЁ}
P: Real; {Џ«®й ¤м Ї®¤ ЄаЁў®©}
X2: Real; {‚Ґ«ЁзЁ "•Ё" Єў ¤а в}
Pocket01: Real; {ЁаЁ "Є а¬ " ¤«п ЁвҐаў « (Ћ 1)}
Table: TTable; {‚бЇ®¬®Ј ⥫м п в Ў«Ёж ¤«п Ї®бв஥Ёп ‘‚}
Function InvFunc(x:Real):Real;
Begin
InvFunc:=sqrt(8*x);
End;
{Function Inte_l(x:Real; n:Byte):Real;
{§ 票Ґ ЁвҐЈа « }
{Begin
Case n Of
1:Inte_l:=(sqr(x)/2)+(6*x);
2:Inte_l:=(3/4)*(GetPow(x,4));
3:Inte_l:=sqr(x)/8;
End;
End;}
Function GetPow(a,b:Real):Real;
Var
Res:Real;
sign:Integer;
Begin
If a=0 then Res:=0 else If a=1 then Res:=1 else
Res:=exp(b*ln(a));
If b<0 then Res:=1/Res;
GetPow:=Res;
End;
Function Inte_l(x:Real; n:Byte):Real;
{§ 票Ґ ЁвҐЈа « }
Begin
Case n Of
1:Inte_l:=(sqr(x)/2)+(6*x);
2:Inte_l:=(3/4)*(GetPow(x,4));
3:Inte_l:=sqr(x)/8;
End;
End;
Function Func(x:Real; n:Byte):Real;
Begin
Case n Of
1:Func:=x+6;
2:Func:=3*GetPow(x,3);
3:Func:=sqr(x)/8;
End;
End;
Function GetPocket(x:Real):Integer; {®¬Ґа "Є а¬ "}
Var
Value:Integer;
Begin
Value:=Trunc(X/Pocket01);
If Value>=K Then GetPocket:=K else GetPocket:=Value+1;
End;
{
{ Procedure DoGen(n:Byte);{ѓҐҐа в®а зЁбҐ« ¤«п n-®© дгЄжЁЁ}
{ Begin
{ InBeg(n);
{ textcolor(2);
{ Writeln(#10#13' ѓҐҐаЁа㥬 ўлЎ®аЄг Ё§ ',V,' б«гз ©ле зЁбҐ« ¤«п ',n,'-© д-жЁЁ ');
{ textcolor(3);
{ Write(' [ ‚ Їа®жҐбᥠўлЇ®«ҐЁп ]');
{ Assign(F, FileName+'.rez');
{ ReWnte(F);
{ For I =1 to V Do
{ Begin
{ X:=Random; {Xi - а ў®¬Ґа® а бЇаҐ¤Ґ«Ґ п ‘‚ (Ћ..1)}
{ If n<>3 then
{ begin
{ Pn:=GetPocket(X); {Ќ®¬Ґа "Є а¬ "}
{ Y:=RandNum(Pn,GetScale(Pn),Random);
{ end
{ else Y:=InvFunc(X);
{ WriteLn(F,Y:10:8);
{ End;
{ Close(F);
{ End;
}
Procedure ZeroMas(Var A:TTable; Count:Integer); {®Ўг«ҐЁҐ ¬ ббЁў }
Var
I:Integer;
Begin
For I:=1 to Count Do A[i]:=0;
End;
Function GetScale(N:Integer):Real;{Є®нддЁжЁҐв ¬ бив ЎЁа®ў Ёп}
{N - Ќ®¬Ґа Є а¬ }
Begin
If N=1 then GetScale:=Table[N]-Imin else
GetScale:=Table[N]-Table[N-1];
End;
Function RandNum(a,b,c:Real):Real; {‚®§ўа й Ґв ЁбЄ®¬го ‘‚}
{a -®¬Ґа Є а¬ ; b - Є®нддЁжЁҐв ¬ бив ЎЁа®ў Ёп; б - Xi+1;}
Begin
If a=1 then a:=Imin else a:=Table[Trunc(a)-1];
RandNum:=a+(b*c);
End;
Function Min(n:Byte):Real;
Var
a,x,y:Real;
Begin
a:=Func(Imin,n);
X:=Imin;
While X<=Imax Do
Begin
X:=X+e;
Y:=Func(X,n);
If Y<a then a:=Y;
End;
Min:=a;
End;
Function Max(n:Byte):Real;
Var
a,x,y:Real;
Begin
a:=Func(Imin, n);
X:=Imin;
While X<=Imax Do
Begin
X:=X+e; Y:=Func(X, n);
If Y>a then a:=Y;
End;
Max:=a;
End;
Procedure InBeg(n:Byte);
Label V1;
Begin
Write(' ‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® "Є а¬ ®ў": ');
ReadLn(K);
Vn:=K;
V1:
ZeroMas(Table,K);
Write(' ‚ўҐ¤ЁвҐ ўҐ«ЁзЁг ўлЎ®аЄЁ: ');
ReadLn(V);
If n=3 then
begin
Table[0]:=Imin;
for i:=1 to K do Table[I]:=Table[I-1]+((2.83)/K);
Exit;
end;
ReadLn(Imax);
Pocket01:=1/K;
P:=Inte_l(Imax,n)-Inte_l(Imin,n); {Џ«®й ¤м Ї®¤ ЄаЁў®© ўбҐ¬ ЁвҐаў «Ґ}
P:=P/K;
X:=Imin;
Step:=0;
I:=0;
Writeln;
While X<=Imax Do
Begin
Y:=Inte_l(X,n);
Step:=Step+e;
Y:=Inte_l(X+Step,n)-Y;
If Y>=P then
begin
Inc(I);
Write(' '#13' ЋЇаҐ¤Ґ«Ґ иЁаЁ ',i,'-ro "Є а¬ ".');
X:=X+Step;
Table[I]:=X; {‘®еа Ё«Ё Џа ўго Ја Ёжг "Є а¬ "}
Step:=0;
end;
End;
WriteLn;
End;
Procedure DoGen(n:Byte);{ѓҐҐа в®а зЁбҐ« ¤«п n-®© дгЄжЁЁ}
Begin
InBeg(n);
textcolor(2);
Writeln(#10#13' ѓҐҐаЁа㥬 ўлЎ®аЄг Ё§ ',V,' б«гз ©ле зЁбҐ« ¤«п ',n,'-© д-жЁЁ ');
textcolor(3);
Write(' [ ‚ Їа®жҐбᥠўлЇ®«ҐЁп ]');
Assign(F, FileName+'.rez');
ReWrite(F);
For I:=1 to V Do
Begin
X:=Random; {Xi - а ў®¬Ґа® а бЇаҐ¤Ґ«Ґ п ‘‚ (Ћ..1)}
If n<>3 then
begin
Pn:=GetPocket(X); {Ќ®¬Ґа "Є а¬ "}
Y:=RandNum(Pn,GetScale(Pn),Random);
end
else Y:=InvFunc(X);
WriteLn(F,Y:10:8);
End;
Close(F);
End;
Procedure Work(n:Byte);
Var
st:String;
Begin
Case n Of
1:st:='ЇҐаў®©';
2:st:='ўв®а®©';
3:st:='ваҐв쥩';
End;
textcolor(4);
Write(#10' €¬п д ©« १г«мв в®ў ¤«п ',st,' дгЄжЁЁ:');
ReadLn(FileName);
DoGen(n);
textcolor(5);
Write(#13' [‚лЇ®«Ґ®] '#13);
textcolor(6);
Fmin:=Min(n);
WriteLn(#10#10#13' ЊЁЁ¬ «м®Ґ § 票Ґ дгЄжЁЁ (',Imin:6:4,'..',Imax:6:4,'):',Fmin:10:8);
Fmax:=Max(n);
textcolor(7);
WriteLn(#10' Њ ЄбЁ¬ «м®Ґ § 票Ґ дгЄжЁЁ (',Imin:6:4,'..',Imax:6:4,'):',Fmax:10:8);
End;
Procedure Srting(n:Byte);
Var
f1,f2:Text;
Step,a:Real;
X:Real;
I:Word;
K,u:LongInt;
Function GetPocketREal(x:Real):Integer; {‚®§ўа й Ґв®¬Ґа "Є а¬ "}
Var
Value:Integer;
Begin
Value:=Trunc(X/Step);
GetPocketREal:=Value+1;
End;
Begin
If n=3 then Step:=(2.83)/Vn else Step:=(Imax-Imin)/Vn;
Assign(f1, FileName+'.rez');
Assign(F2, FileName+'.srt');
ReSet(F1);
ReWrite(f2);
ZeroMas(RealDistr,Vn);
a:=0;
TextColor(15);
u:=0;
For I:=1 to Vn Do
Begin
Write('.');
ReSet(f1);
K:=0;
While Not Eof(f1) Do
Begin
ReadLn(f1,X);
If n<>3 then
begin
If GetPocketREal(X)=I then Inc(K);
end
else
begin
If X<=a then Inc(K);
end;
End;
a:=a+step;
WriteLn(F2,K);
Close(f1);
RealDistr[I]:=K;
End;
Close(f2);
TextColor(7);
End;
Procedure Sorting(n:Byte);
Var
F1, f3:Text;
Step, a:Real;
X:Real;
I:Word;
K,u:LongInt;
Function GetPocketunREal(x:Real;ii:integer):Integer;
Var
Value:Integer;
Begin
if x<Table[1] then
begin
GetPocketunREal:=1;
exit;
end
else
Begin
for Value:= 1 to ii do
Begin
if x>Table[ Value] Then continue
else
Begin
GetPocketunREal:=Value;
exit;
end;
End;
End;
End;
Begin
Step:=(Imax-Imin)/Vn;
If n=3 then Step:=(2.83)/Vn;
Assign(f1, FileName+'.rez');
Assign(f3, FileName+'.srl');
ReSet(f1);
ReWrite(f3);
ZeroMas(RealDist, Vn);
a:=0;
TextColor(15);
u:=0;
For I:=1 to Vn Do
Begin
ReSet(f1);
K:=0;
While Not Eof(f1) Do
Begin
ReadLn(f1,X);
If GetPocketunREal(X,Vn)=I then Inc(K);
End;
a:=a+step;
WriteLn(F3,K);
Close(f1);
RealDist[I]:=K;
End;
Close(f3);
TextColor(7);
End;
Function GetHeSqr(n:byte):Real; {•Ё Єў ¤а в}
Var
P, X: Real;
F1,f2: Text;
m:LongInt;
i:integer;
Begin
Assign(F1, FileName+'.srl');
ReSet(F1);
X:=0;
p:=0;
i:=1;
if n<>3 then
While Not EOF(F1) Do
Begin
ReadLn(F1,m);
P:=1/K;
X:=X+sqr(m-V*p)/(V*p);
m:=0;
End
else
While Not EOF(F1) Do
Begin
ReadLn(F1, m);
P:=abs(func(Table[i],n)-func(table[i-1],n));
X:=X+sqr(m-V*p)/(V*p);
m:=0;
inc(i);
End;
Close(F1);
GetHeSqr:=X;
End;
Function GetLyambda(n:byte):Real; {‹п¬¤ }
Var
f3:Text;
LI:Integer;
D,bi,NewReal,AnyReal:Real;
Begin
Assign(f3,FileName+'.lam');
ReWrite(f3);
D:=0;
AnyReal:=0;
If n=3 then
Begin
For LI:=1 to K Do
Begin
AnyReal:=AnyReal+RealDist[li];
NewReal:=AnyReal*(1/V);
bi:=abs(func(Table[li],n)-NewReal);
WriteLn(F3, bi:6:4);
If bi>D then D:=bi;
bi:=0;
End;
End
else
Begin
For LI:=1 to K Do
Begin
AnyReal:=AnyReal+RealDist[li];
NewReal:=(1/V)*AnyReal;
bi:=abs(inte_l(Table[li],n)-NewReal);
WriteLn(F3, bi:6:4);
If bi>D then D:=bi;
bi:=0;
End;
End;
Close(F3);
GetLyambda:=D*sqrt(V);
End;
Procedure Draw(n:Byte);
Var
GraphicDriver,GraphicMode:Integer;
ScaleX,ScaleY,Fmax2:Real;
Begin
WriteLn(#10' Џ®¤Ј®в®ўЄ ¤ ле.');
textcolor(7);
Write(' [ ‚лЇ®«пҐвбп');
Srting(n);
Sorting(n);
textcolor(8);
Write(#13' [ђҐ§г«мв в] ');
textcolor(10);
Writeln(#10#13'XЁ Єў ¤а в:',GetHeSqr(n):10:8,' ‹п¬¤ ! :',GetLyambda(n):10:8);
TextColor(135);
ReadKey;
TextColor(7);
GraphicDriver:=Detect;
InitGraph(GraphicDriver,GraphicMode,'D:\TP\BGI');
Fmax:=Max(n);
ScaleX:=GetMaxX/Imax;
ScaleY:=(GetMaxY-70)/Fmax;
Fmax2:=Fmax;
setbkcolor(15);
SetLineStyle(0,0,3);
SetColor(Black);
Line(0,0,0,GetMaxY);
Line(0,GetmaxY,GetMaxX,GetMaxY);
SetColor(4);
SetLineStyle(0,0,3);
MoveTo(Trunc(ScaleX*Imin),479-Trunc(ScaleY*Func(Imin,n)));
For I:=1 to K Do
Begin
LineTo(Trunc(ScaleX*Table[i]),479-Trunc(ScaleY*Func(Table[i],n)));
MoveTo(Trunc(ScaleX*Table[i]), 479-Trunc(ScaleY*Func(Table[i],n)));
End;
Fmax:=RealDistr[0];
For I:=1 to Vn Do If RealDistr[I]>Fmax then Fmax:=RealDistr[I];
ScaleX:=GetMaxX/Vn;
ScaleY:=(GetMaxY-70)/Fmax;
SetColor(Blue);
SetLineStyle(0,0,1);
MoveTo(0,479);
For I:=1 to Vn Do
Begin
SetFillStyle(0,9);
Bar3D(Trunc(ScaleX*(I-1)),479-Trunc(ScaleY*RealDistr[i]),Trunc(ScaleX*(I)),GetMaxY,0,TopOn)
End;
SetColor(5);
ScaleX:=GetMaxX/Imax;
ScaleY:=(GetMaxY-70)/Fmax2;
SetColor(4);
SetLineStyle(1,0,3);
MoveTo(Trunc(ScaleX*Imin),479-Trunc(ScaleY*Func(Imin,n)));
For I:=1 to K Do
Begin
LineTo(Trunc(ScaleX*Table[i]),479-Trunc(ScaleY*Func(Table[i],n)));
MoveTo(Trunc(ScaleX*Table[i]),479-Trunc(ScaleY*Func(Table[i],n)));
End;
ReadLn;
CloseGraph;
End;
Label New;
Const
Yes = ['г','Y','','Ќ'];
No = ['n','N','в','’'];
Var
Key: Char;
Begin
New:
ClrScr;
RANDOMIZE;
Imin:=0;
Imax:=0.16;
Work(1);
Draw(1);
Imin:=0;
Imax:=1.07;
Work(2);
Draw(2);
Imin:=0;
Imax:=2.83;
Work(3);
Draw(3);
Write(#10#10' Џа®¤®«¦ вм а Ў®вг б Їа®Ја ¬¬®©? [Y/N]:');
Repeat Key:=ReadKey Until (Key in Yes) or (Key in No);
If Key in Yes then
Begin
Write('Y');
GoTo New;
End else Write('N');
End.
Type
TTable=Array [0..2500] of Real;
Const
e =0.00001; {в®з®бвм}
Var
RealDistr:TTable;{ђҐ «м®Ґ а бЇаҐ¤Ґ«ҐЁҐ}
RealDist:TTable;{‚бЇ®¬®Ј ⥫м п в Ў«Ёж ¤«п Ї®бв஥Ёп ॠ« а бЇ}
X, Y, Step:Real;{„«п ®ЇаҐ¤Ґ«ҐЁп Ја Ёж "Є а¬ ®ў"}
I,Pn:LongInt;
F:Text; {” ©« ¤«п १г«мв в®ў}
FileName: String; {€¬п д ©« १г«мв в®ў}
Vn:Integer; {Є®«-ў® "Є а¬ ®ў" ЇаЁ ®в®Ўа ¦ҐЁЁ}
K:Integer; {Љ®«ЁзҐбвў® Є а¬ ®ў}
V:LongInt; {‚Ґ«ЁзЁ ўлЎ®аЄЁ}
Imin, {ЌЁ¦пп Ја Ёж ЁвҐаў « }
Imax: Real; {‚Ґаепп Ја Ёж ЁвҐаў « }
Fmin, {ЊЁ § п д-жЁЁ}
Fmax: Real; {Њ Єб § з д-жЁЁ}
P: Real; {Џ«®й ¤м Ї®¤ ЄаЁў®©}
X2: Real; {‚Ґ«ЁзЁ "•Ё" Єў ¤а в}
Pocket01: Real; {ЁаЁ "Є а¬ " ¤«п ЁвҐаў « (Ћ 1)}
Table: TTable; {‚бЇ®¬®Ј ⥫м п в Ў«Ёж ¤«п Ї®бв஥Ёп ‘‚}
Function InvFunc(x:Real):Real;
Begin
InvFunc:=sqrt(8*x);
End;
{Function Inte_l(x:Real; n:Byte):Real;
{§ 票Ґ ЁвҐЈа « }
{Begin
Case n Of
1:Inte_l:=(sqr(x)/2)+(6*x);
2:Inte_l:=(3/4)*(GetPow(x,4));
3:Inte_l:=sqr(x)/8;
End;
End;}
Function GetPow(a,b:Real):Real;
Var
Res:Real;
sign:Integer;
Begin
If a=0 then Res:=0 else If a=1 then Res:=1 else
Res:=exp(b*ln(a));
If b<0 then Res:=1/Res;
GetPow:=Res;
End;
Function Inte_l(x:Real; n:Byte):Real;
{§ 票Ґ ЁвҐЈа « }
Begin
Case n Of
1:Inte_l:=(sqr(x)/2)+(6*x);
2:Inte_l:=(3/4)*(GetPow(x,4));
3:Inte_l:=sqr(x)/8;
End;
End;
Function Func(x:Real; n:Byte):Real;
Begin
Case n Of
1:Func:=x+6;
2:Func:=3*GetPow(x,3);
3:Func:=sqr(x)/8;
End;
End;
Function GetPocket(x:Real):Integer; {®¬Ґа "Є а¬ "}
Var
Value:Integer;
Begin
Value:=Trunc(X/Pocket01);
If Value>=K Then GetPocket:=K else GetPocket:=Value+1;
End;
{
{ Procedure DoGen(n:Byte);{ѓҐҐа в®а зЁбҐ« ¤«п n-®© дгЄжЁЁ}
{ Begin
{ InBeg(n);
{ textcolor(2);
{ Writeln(#10#13' ѓҐҐаЁа㥬 ўлЎ®аЄг Ё§ ',V,' б«гз ©ле зЁбҐ« ¤«п ',n,'-© д-жЁЁ ');
{ textcolor(3);
{ Write(' [ ‚ Їа®жҐбᥠўлЇ®«ҐЁп ]');
{ Assign(F, FileName+'.rez');
{ ReWnte(F);
{ For I =1 to V Do
{ Begin
{ X:=Random; {Xi - а ў®¬Ґа® а бЇаҐ¤Ґ«Ґ п ‘‚ (Ћ..1)}
{ If n<>3 then
{ begin
{ Pn:=GetPocket(X); {Ќ®¬Ґа "Є а¬ "}
{ Y:=RandNum(Pn,GetScale(Pn),Random);
{ end
{ else Y:=InvFunc(X);
{ WriteLn(F,Y:10:8);
{ End;
{ Close(F);
{ End;
}
Procedure ZeroMas(Var A:TTable; Count:Integer); {®Ўг«ҐЁҐ ¬ ббЁў }
Var
I:Integer;
Begin
For I:=1 to Count Do A[i]:=0;
End;
Function GetScale(N:Integer):Real;{Є®нддЁжЁҐв ¬ бив ЎЁа®ў Ёп}
{N - Ќ®¬Ґа Є а¬ }
Begin
If N=1 then GetScale:=Table[N]-Imin else
GetScale:=Table[N]-Table[N-1];
End;
Function RandNum(a,b,c:Real):Real; {‚®§ўа й Ґв ЁбЄ®¬го ‘‚}
{a -®¬Ґа Є а¬ ; b - Є®нддЁжЁҐв ¬ бив ЎЁа®ў Ёп; б - Xi+1;}
Begin
If a=1 then a:=Imin else a:=Table[Trunc(a)-1];
RandNum:=a+(b*c);
End;
Function Min(n:Byte):Real;
Var
a,x,y:Real;
Begin
a:=Func(Imin,n);
X:=Imin;
While X<=Imax Do
Begin
X:=X+e;
Y:=Func(X,n);
If Y<a then a:=Y;
End;
Min:=a;
End;
Function Max(n:Byte):Real;
Var
a,x,y:Real;
Begin
a:=Func(Imin, n);
X:=Imin;
While X<=Imax Do
Begin
X:=X+e; Y:=Func(X, n);
If Y>a then a:=Y;
End;
Max:=a;
End;
Procedure InBeg(n:Byte);
Label V1;
Begin
Write(' ‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® "Є а¬ ®ў": ');
ReadLn(K);
Vn:=K;
V1:
ZeroMas(Table,K);
Write(' ‚ўҐ¤ЁвҐ ўҐ«ЁзЁг ўлЎ®аЄЁ: ');
ReadLn(V);
If n=3 then
begin
Table[0]:=Imin;
for i:=1 to K do Table[I]:=Table[I-1]+((2.83)/K);
Exit;
end;
ReadLn(Imax);
Pocket01:=1/K;
P:=Inte_l(Imax,n)-Inte_l(Imin,n); {Џ«®й ¤м Ї®¤ ЄаЁў®© ўбҐ¬ ЁвҐаў «Ґ}
P:=P/K;
X:=Imin;
Step:=0;
I:=0;
Writeln;
While X<=Imax Do
Begin
Y:=Inte_l(X,n);
Step:=Step+e;
Y:=Inte_l(X+Step,n)-Y;
If Y>=P then
begin
Inc(I);
Write(' '#13' ЋЇаҐ¤Ґ«Ґ иЁаЁ ',i,'-ro "Є а¬ ".');
X:=X+Step;
Table[I]:=X; {‘®еа Ё«Ё Џа ўго Ја Ёжг "Є а¬ "}
Step:=0;
end;
End;
WriteLn;
End;
Procedure DoGen(n:Byte);{ѓҐҐа в®а зЁбҐ« ¤«п n-®© дгЄжЁЁ}
Begin
InBeg(n);
textcolor(2);
Writeln(#10#13' ѓҐҐаЁа㥬 ўлЎ®аЄг Ё§ ',V,' б«гз ©ле зЁбҐ« ¤«п ',n,'-© д-жЁЁ ');
textcolor(3);
Write(' [ ‚ Їа®жҐбᥠўлЇ®«ҐЁп ]');
Assign(F, FileName+'.rez');
ReWrite(F);
For I:=1 to V Do
Begin
X:=Random; {Xi - а ў®¬Ґа® а бЇаҐ¤Ґ«Ґ п ‘‚ (Ћ..1)}
If n<>3 then
begin
Pn:=GetPocket(X); {Ќ®¬Ґа "Є а¬ "}
Y:=RandNum(Pn,GetScale(Pn),Random);
end
else Y:=InvFunc(X);
WriteLn(F,Y:10:8);
End;
Close(F);
End;
Procedure Work(n:Byte);
Var
st:String;
Begin
Case n Of
1:st:='ЇҐаў®©';
2:st:='ўв®а®©';
3:st:='ваҐв쥩';
End;
textcolor(4);
Write(#10' €¬п д ©« १г«мв в®ў ¤«п ',st,' дгЄжЁЁ:');
ReadLn(FileName);
DoGen(n);
textcolor(5);
Write(#13' [‚лЇ®«Ґ®] '#13);
textcolor(6);
Fmin:=Min(n);
WriteLn(#10#10#13' ЊЁЁ¬ «м®Ґ § 票Ґ дгЄжЁЁ (',Imin:6:4,'..',Imax:6:4,'):',Fmin:10:8);
Fmax:=Max(n);
textcolor(7);
WriteLn(#10' Њ ЄбЁ¬ «м®Ґ § 票Ґ дгЄжЁЁ (',Imin:6:4,'..',Imax:6:4,'):',Fmax:10:8);
End;
Procedure Srting(n:Byte);
Var
f1,f2:Text;
Step,a:Real;
X:Real;
I:Word;
K,u:LongInt;
Function GetPocketREal(x:Real):Integer; {‚®§ўа й Ґв®¬Ґа "Є а¬ "}
Var
Value:Integer;
Begin
Value:=Trunc(X/Step);
GetPocketREal:=Value+1;
End;
Begin
If n=3 then Step:=(2.83)/Vn else Step:=(Imax-Imin)/Vn;
Assign(f1, FileName+'.rez');
Assign(F2, FileName+'.srt');
ReSet(F1);
ReWrite(f2);
ZeroMas(RealDistr,Vn);
a:=0;
TextColor(15);
u:=0;
For I:=1 to Vn Do
Begin
Write('.');
ReSet(f1);
K:=0;
While Not Eof(f1) Do
Begin
ReadLn(f1,X);
If n<>3 then
begin
If GetPocketREal(X)=I then Inc(K);
end
else
begin
If X<=a then Inc(K);
end;
End;
a:=a+step;
WriteLn(F2,K);
Close(f1);
RealDistr[I]:=K;
End;
Close(f2);
TextColor(7);
End;
Procedure Sorting(n:Byte);
Var
F1, f3:Text;
Step, a:Real;
X:Real;
I:Word;
K,u:LongInt;
Function GetPocketunREal(x:Real;ii:integer):Integer;
Var
Value:Integer;
Begin
if x<Table[1] then
begin
GetPocketunREal:=1;
exit;
end
else
Begin
for Value:= 1 to ii do
Begin
if x>Table[ Value] Then continue
else
Begin
GetPocketunREal:=Value;
exit;
end;
End;
End;
End;
Begin
Step:=(Imax-Imin)/Vn;
If n=3 then Step:=(2.83)/Vn;
Assign(f1, FileName+'.rez');
Assign(f3, FileName+'.srl');
ReSet(f1);
ReWrite(f3);
ZeroMas(RealDist, Vn);
a:=0;
TextColor(15);
u:=0;
For I:=1 to Vn Do
Begin
ReSet(f1);
K:=0;
While Not Eof(f1) Do
Begin
ReadLn(f1,X);
If GetPocketunREal(X,Vn)=I then Inc(K);
End;
a:=a+step;
WriteLn(F3,K);
Close(f1);
RealDist[I]:=K;
End;
Close(f3);
TextColor(7);
End;
Function GetHeSqr(n:byte):Real; {•Ё Єў ¤а в}
Var
P, X: Real;
F1,f2: Text;
m:LongInt;
i:integer;
Begin
Assign(F1, FileName+'.srl');
ReSet(F1);
X:=0;
p:=0;
i:=1;
if n<>3 then
While Not EOF(F1) Do
Begin
ReadLn(F1,m);
P:=1/K;
X:=X+sqr(m-V*p)/(V*p);
m:=0;
End
else
While Not EOF(F1) Do
Begin
ReadLn(F1, m);
P:=abs(func(Table[i],n)-func(table[i-1],n));
X:=X+sqr(m-V*p)/(V*p);
m:=0;
inc(i);
End;
Close(F1);
GetHeSqr:=X;
End;
Function GetLyambda(n:byte):Real; {‹п¬¤ }
Var
f3:Text;
LI:Integer;
D,bi,NewReal,AnyReal:Real;
Begin
Assign(f3,FileName+'.lam');
ReWrite(f3);
D:=0;
AnyReal:=0;
If n=3 then
Begin
For LI:=1 to K Do
Begin
AnyReal:=AnyReal+RealDist[li];
NewReal:=AnyReal*(1/V);
bi:=abs(func(Table[li],n)-NewReal);
WriteLn(F3, bi:6:4);
If bi>D then D:=bi;
bi:=0;
End;
End
else
Begin
For LI:=1 to K Do
Begin
AnyReal:=AnyReal+RealDist[li];
NewReal:=(1/V)*AnyReal;
bi:=abs(inte_l(Table[li],n)-NewReal);
WriteLn(F3, bi:6:4);
If bi>D then D:=bi;
bi:=0;
End;
End;
Close(F3);
GetLyambda:=D*sqrt(V);
End;
Procedure Draw(n:Byte);
Var
GraphicDriver,GraphicMode:Integer;
ScaleX,ScaleY,Fmax2:Real;
Begin
WriteLn(#10' Џ®¤Ј®в®ўЄ ¤ ле.');
textcolor(7);
Write(' [ ‚лЇ®«пҐвбп');
Srting(n);
Sorting(n);
textcolor(8);
Write(#13' [ђҐ§г«мв в] ');
textcolor(10);
Writeln(#10#13'XЁ Єў ¤а в:',GetHeSqr(n):10:8,' ‹п¬¤ ! :',GetLyambda(n):10:8);
TextColor(135);
ReadKey;
TextColor(7);
GraphicDriver:=Detect;
InitGraph(GraphicDriver,GraphicMode,'D:\TP\BGI');
Fmax:=Max(n);
ScaleX:=GetMaxX/Imax;
ScaleY:=(GetMaxY-70)/Fmax;
Fmax2:=Fmax;
setbkcolor(15);
SetLineStyle(0,0,3);
SetColor(Black);
Line(0,0,0,GetMaxY);
Line(0,GetmaxY,GetMaxX,GetMaxY);
SetColor(4);
SetLineStyle(0,0,3);
MoveTo(Trunc(ScaleX*Imin),479-Trunc(ScaleY*Func(Imin,n)));
For I:=1 to K Do
Begin
LineTo(Trunc(ScaleX*Table[i]),479-Trunc(ScaleY*Func(Table[i],n)));
MoveTo(Trunc(ScaleX*Table[i]), 479-Trunc(ScaleY*Func(Table[i],n)));
End;
Fmax:=RealDistr[0];
For I:=1 to Vn Do If RealDistr[I]>Fmax then Fmax:=RealDistr[I];
ScaleX:=GetMaxX/Vn;
ScaleY:=(GetMaxY-70)/Fmax;
SetColor(Blue);
SetLineStyle(0,0,1);
MoveTo(0,479);
For I:=1 to Vn Do
Begin
SetFillStyle(0,9);
Bar3D(Trunc(ScaleX*(I-1)),479-Trunc(ScaleY*RealDistr[i]),Trunc(ScaleX*(I)),GetMaxY,0,TopOn)
End;
SetColor(5);
ScaleX:=GetMaxX/Imax;
ScaleY:=(GetMaxY-70)/Fmax2;
SetColor(4);
SetLineStyle(1,0,3);
MoveTo(Trunc(ScaleX*Imin),479-Trunc(ScaleY*Func(Imin,n)));
For I:=1 to K Do
Begin
LineTo(Trunc(ScaleX*Table[i]),479-Trunc(ScaleY*Func(Table[i],n)));
MoveTo(Trunc(ScaleX*Table[i]),479-Trunc(ScaleY*Func(Table[i],n)));
End;
ReadLn;
CloseGraph;
End;
Label New;
Const
Yes = ['г','Y','','Ќ'];
No = ['n','N','в','’'];
Var
Key: Char;
Begin
New:
ClrScr;
RANDOMIZE;
Imin:=0;
Imax:=0.16;
Work(1);
Draw(1);
Imin:=0;
Imax:=1.07;
Work(2);
Draw(2);
Imin:=0;
Imax:=2.83;
Work(3);
Draw(3);
Write(#10#10' Џа®¤®«¦ вм а Ў®вг б Їа®Ја ¬¬®©? [Y/N]:');
Repeat Key:=ReadKey Until (Key in Yes) or (Key in No);
If Key in Yes then
Begin
Write('Y');
GoTo New;
End else Write('N');
End.
Соседние файлы в папке GAS