Скачиваний:
11
Добавлен:
10.05.2015
Размер:
9.75 Кб
Скачать
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.
Соседние файлы в папке GAS
  • #
    10.05.201535 б91.SRL
  • #
    10.05.201537 б91.SRT
  • #
    10.05.201560 Кб1010.REZ
  • #
    10.05.20150 б810.SRT
  • #
    10.05.20159.75 Кб8123.BAK
  • #
    10.05.20159.75 Кб11123.PAS
  • #
    10.05.20152.25 Кб8DEN2.PAS
  • #
    10.05.201526.44 Кб9funcs.o
  • #
    10.05.201510.69 Кб9FUNCS.PAS
  • #
    10.05.20156.48 Кб10funcs.ppu
  • #
    10.05.20150 б8TP0B0F68.$$$