Скачиваний:
9
Добавлен:
10.05.2015
Размер:
10.69 Кб
Скачать
unit funcs;

INTERFACE
USES Graph;
const
N = 25; {Љ®«-ў® Є а¬ ­®ў}
V = 100; {‚лЎ®аЄ }
Interval = 3.3;
N2 = 25; {Љ®«-ў® Є а¬ ­®ў ®Ўа в­®© дг­ЄжЁЁ}
V2 = 100; {‚лЎ®аЄ  ¤«п Ћ”}
start = 0; {Ќ з «м­ п Ја ­Ёж  ®вбзҐв  дг­ЄжЁЁ}
Accuracy = 0.00001; {’®з­®бвм Ё­вҐЈаЁа®ў ­Ёп}
Var
a,b,c,step:Real; {Џа®бв® ЇҐаҐ¬Ґ­­лҐ}
Ni: Array [0..N] of Real; {Љ®«ЁзҐбвў® Ї®Ї ¤ ­Ё© ў Є а¬ ­л а §­®© иЁаЁ­л}
P: Array [1..N] of Real; {‚Ґа®пв­®бвЁ Ї®Ї ¤ ­Ёп ў Є а¬ ­}
YiAv,Width : Array [0..N] of Real; {ЁаЁ­  Є а¬ ­®ў, Ја ­Ёжл Є а¬ ­®ў
YiAv - “б।­Ґ­­®Ґ Yi (AVerage)}
BorderX: Array [0..N2] of Real; {ѓа ­Ёжл ®Ўа в­®© д-жЁЁ Ї® X}
Kf : Array [1..N] of Real; {‡¤Ґбм Є®нддЁжЁҐ­вл ¬ бив ЎЁа®ў ­Ёп}
Yi2,Yi,M : Array [0..V] of Real; {Џ®«гз Ґ¬ Yi - ‘‚,а бЇаҐ¤Ґ«Ґ­­ п Ї® ­ иҐ¬г § Є®­г}
Xi3KOLp: Array [0..N2] of Integer;{Xi3KOLp - Љ®«ЁзҐбвў® Ї®Ї ¤ ­Ё© ‘‚ ў Є а¬ ­л Ћ”}
Border : Array [0..N] of Real; {ђ ў­®¬Ґа­лҐ Ја ­Ёжл ­ иҐ© дг­ЄжЁЁ, Ў®«ми®©}
Xi3 : Array [0..V2] of Real;
M2 : Array [1..V2] of Real; {‘‚ ¤«п Ћ”}
PAv : Array [1..N] of Real; {‚Ґа®пв­®бвм Ї®Ї ¤ ­Ёп Yi ў Є а¬ ­}
F : Array [1..N+1] of Integer; {Њ ббЁў, ᮤҐа¦ йЁ© Є®«-ў® Ї®Ї ¤ ­Ё© Yi ў Є а¬ ­л}
FMax, Xi3KolPmax,asd : Integer;
Scale,Xi3Old : Real; {Њ бив Ў ¤«п Ја дЁЄ®ў}
High1,HighYi, MaximY: integer;
Low1, LowYi: integer;
Xi3KolPFile,Xi3File,MiFile,M2iFile,YiAvFile, FFile, YiFile : Text;
gran : byte;
{ЏҐаҐ¬Ґ­­лҐ ¤«п § ЇЁбЁ ў д ©«}
Function IntToStr(I: Longint): String;
Function Pow(Numb,Powder_St:real) : Real; {‚®§ўҐ¤Ґ­ЁҐ ў б⥯Ґ­м}
Function GetPocket(Value: Real): LongInt;
Function X2:Real;
Procedure IntGraph;
Procedure GetProbability(SV: Array of Real; Var P: Array of Real);
Procedure Obr(funct:byte); {‡¤Ґбм - M2[i] - нв® Y,   Xi3 - нв® Ї®«гз Ґ¬л© ­ ¬Ё X}
Procedure SquareInt(func:byte); {ЏҐаҐ¤ Ґ¬ ­®¬Ґа дг­ЄжЁЁ}
Procedure Pockets;

IMPLEMENTATION

Function IntToStr(I: Longint): String;
{ Convert any integer type to a string }
var
S: string[11];
begin
Str(I, S);
IntToStr := S;
end;

Function GetPocket(Value: Real): LongInt; {”-жЁп Ї®«г祭Ёп ­®¬Ґа  Є а¬ ­ }
Begin
GetPocket:=Trunc(Value/Step)+1;
End;

Procedure IntGraph; {€­ЁжЁ «Ё§ жЁп Ја дЁЄЁ}
var
grDriver: Integer;
grMode: Integer;
begin
grDriver := Detect;
InitGraph(grDriver, grMode,'d:\Programm\TP71\Bgi'); {Џа®ЇЁб вм Їгвм!!!}
end;
{*************************************************************************}
{
+----------------------------------------------------------------------------------------------------------+
| Џа®жҐ¤га  GetProbability ў®§ўа й Ґв ¬ ббЁў ўҐа®пв­®б⥩ Ї®Ї ¤ ­Ёп ‘‚ |
| ў Є ¦¤л© Ё§ Є а¬ ­®ў. |
+----------------------------------------------------------------------------------------------------------+
}
Procedure GetProbability(SV: Array of Real; Var P: Array of Real);
Var
I: Word;
A: Word;
Begin
For I:=1 to High(P) do P[i]:=0; {ЋЎ­г«пҐ¬ ўбҐ ўҐа®пв­®бвЁ}
For I:=1 to High(Ni) do Ni[i]:=0; {ЋЎ­г«пҐ¬ ўбҐ Є а¬ ­л}

A:=High(SV);
For I:=1 to High(SV) do
Begin
A:=GetPocket(SV[I]); {Ђ = Ќ®¬Ґа Є а¬ ­ }
Ni[A]:=Ni[A]+1; {‘зЁв Ґ¬ бЄ®«мЄ® а § Ї®Ї «Ё}
End;
A:=High(P);

For I:=1 to High(P) do
begin
P[I]:=Ni[I]/V; {‚ P § ЇЁблў Ґ¬ ўҐа®пв­®бвЁ Ї®Ї ¤ ­Ёп ў Є а¬ ­}
end;
End;
{+---------------------------------------------------------------------------+
| ”г­ЄжЁп •Ё Єў ¤а в - бзЁв Ґ¬ ҐҐ |
+---------------------------------------------------------------------------+
}
Function X2:Real;
var q:integer;
x:real;
w:real;
begin
X:=0;
for q:=1 to N do
begin
x:=x+sqr(N*PAv[q]-q)/n*PAv[q];
end;
X2:=x;
end;

Function Pow(Numb, Powder_St:real) : Real; {‚®§ўҐ¤Ґ­ЁҐ ў б⥯Ґ­м}
begin
Pow:=exp(Powder_St*Ln(Numb));
end;
{******************* ЊҐв®¤ ®Ўа в­®© дг­ЄжЁЁ *******************************}
Procedure Obr(funct:Byte); {‡¤Ґбм - M2[i] - нв® Y,   Xi3 - нв® Ї®«гз Ґ¬л© ­ ¬Ё X}
Var i,j : Integer; {”г­ЄжЁп - y=x^4, ®Ўа в­ п - x=(y)^1/4}
Begin {”г­ЄжЁп - y=(7*x^6)/3,®Ўа в­ п -x=(3y/7)^1/6}
for i:=1 to V2 do
Begin
case funct of
1: Xi3[i]:=sqrt(sqrt(M2[i])); {(x=y^1/4)}
2: Xi3[i]:=Pow((3*M2[i]/7),(1/6)); {x=(3y/7)^1/6 }
end;
End;
for i:=1 to V2 do {“Ї®а冷稢 Ґ¬}
begin
for j:=1 to V2-1 do
begin
if Xi3[j]>Xi3[j+1] then
begin
Xi3Old:=Xi3[j+1];
Xi3[j+1]:=Xi3[j];
Xi3[j]:=Xi3Old;
end;
end;
end;
End;
{*************************************************************************}
{*----- ‘зЁв Ґ¬ Ё­вҐЈа « Ё иЁаЁ­г Є а¬ ­  в Є, зв®Ўл S Ўл«  ®¤Ё­ Є®ў  -----*}
Procedure SquareInt(func:byte);
var stp,stpOld, s,sOld :real;
w: LongInt;
e: integer;
begin
for e:=1 to N do
Width[e]:=0;
asd:=1;
stp:=0;
s:=0;w:=0;
e:=1;
sOld:=0;
stpOld:=start; {‘зЁв Ґ¬ ®Ўйго Ї«®й ¤м ў § ¤ ­­®¬ Ё­вҐаў «Ґ}
while asd<8 do
begin
if asd=1 then {Џ«®й ¤м ¤«п 1-Ј® ®в१Є }
begin
stp:=0.4;
s:=s+((1.5*stp*stp)/2)-((1.5*stpOld*stpOld)/2);
end
else
if asd=2 then {Џ«®й ¤м ¤«п 2-Ј® ®в१Є }
begin
stpOld :=stp+Accuracy;
stp :=1;
s:=s+(((0.1666667*stp*stp)/2)+0.5334*stp)-
(((0.1666667*stpOld*stpOld)/2)+0.5334*stpOld);
end
else
if asd=3 then {Џ«®й ¤м ¤«п 3-Ј® ®в१Є }
begin
stpOld :=stp+Accuracy;
stp :=1.2;
s:=s+((((-1.5*stp*stp)/2)+2.003*stp))-
((((-1.5*stpOld*stpOld)/2)+2.003*stpOld));
end
else
if asd=4 then {Џ«®й ¤м ¤«п 4-Ј® ®в१Є }
begin
stpOld :=stp+Accuracy;
stp :=2;
s:=s+(0.4*stp)-
(0.4*stpOld);
end
else
if asd=5 then {Џ«®й ¤м ¤«п 5-Ј® ®в१Є }
begin
stpOld :=stp+Accuracy;
stp :=2.4;
s:=s+((((1.75*stp*stp)/2)-3.1*stp))-
((((1.75*stpOld*stpOld)/2)-3.1*stpOld));
end
else
if asd=6 then {Џ«®й ¤м ¤«п 6-Ј® ®в१Є }
begin
stpOld :=stp+Accuracy;
stp :=2.9;
s:=s+((((0.2*stp*stp)/2)+0.62*stp))-
((((0.2*stpOld*stpOld)/2)+0.62*stpOld));
end
else
if asd=7 then {Џ«®й ¤м ¤«п 7-Ј® ®в१Є }
begin
stpOld :=stp+Accuracy;
stp :=3.3;
s:=s+((((-1.75*stp*stp)/2)+6.275*stp))-
((((-1.75*stpOld*stpOld)/2)+6.275*stpOld));
end;
inc(asd);
end;
stp:=0;
sOld:=s/N; {Џ«®й ¤м ®¤­®Ј® Є а¬ ­ }
s:=0;
while stp<=Interval do
begin
stpOld:=stp;
stp:=stp+Accuracy; {‘зЁв Ґ¬ а ў­го Ї«®й ¤м}
if (stp>0) AND (stp<=0.4) then {Џ«®й ¤м ¤«п 1-Ј® ®в१Є }
s:=s+((1.5*stp*stp)/2)-((1.5*stpOld*stpOld)/2)
else
if (stp>0.4) AND (stp<=1) then {Џ«®й ¤м ¤«п 2-Ј® ®в१Є }
s:=s+(((0.1666667*stp*stp)/2)+0.5334*stp)-
(((0.1666667*stpOld*stpOld)/2)+0.5334*stpOld)
else
if (stp>1) AND (stp<=1.2) then {Џ«®й ¤м ¤«п 3-Ј® ®в१Є }
s:=s+((((-1.5*stp*stp)/2)+2.003*stp))-
((((-1.5*stpOld*stpOld)/2)+2.003*stpOld))
else
if (stp>1.2) AND (stp<=2) then {Џ«®й ¤м ¤«п 4-Ј® ®в१Є }
s:=s+(0.4*stp)-(0.4*stpOld)
else
if (stp>2) AND (stp<=2.4) then {Џ«®й ¤м ¤«п 5-Ј® ®в१Є }
s:=s+((((1.75*stp*stp)/2)-3.1*stp))-
((((1.75*stpOld*stpOld)/2)-3.1*stpOld))
else
if (stp>2.4) AND (stp<=2.9) then {Џ«®й ¤м ¤«п 6-Ј® ®в१Є }
s:=s+((((0.2*stp*stp)/2)+0.62*stp))-
((((0.2*stpOld*stpOld)/2)+0.62*stpOld))
else
if (stp>2.9) AND (stp<=Interval) then {Џ«®й ¤м ¤«п 7-Ј® ®в१Є }
s:=s+((((-1.75*stp*stp)/2)+6.275*stp))-
((((-1.75*stpOld*stpOld)/2)+6.275*stpOld));
if s>=sOld then
begin
Width[e]:=stp; {‚лбв ў«пҐ¬ Ја ­Ёжг Є а¬ ­ }
inc(e);
s:=0;
end;
inc(w);
if (w mod 10000)=0 then write('.');
end;
Width[N]:=Interval;
for e:=0 to N-1 do
begin
Kf[e+1]:=Width[e+1]-Width[e]; {‡ ЇЁблў Ґ¬ Є®нддЁжЁҐ­вл ¬ бив ЎЁа®ў ­Ёп}
end;
end;
{*++++++++++++++++++ ‚лбзЁвлў Ґ¬ Yi +++++++++++++++++++++++++++++++*}
{****************** ‘¬®ваЁ¬, ў Є Є®© Є а¬ ­ Ї®Ї «Ё Ё бзЁв Ґ¬ Yi **************}
Procedure Pockets;
var i, a: integer;
b,c,d:real;
begin
for i:=1 to V do
begin
a:=GetPocket(M[i]);
Yi[i]:=Width[a-1]+M[i+1]*Kf[a];
a:=0;
end;
end;
{*************************************************************************}

{**************** Ќ е®¤Ё¬ ¬ ЄбЁ¬г¬ дг­ЄжЁЁ Ї® ®бЁ Y ***********************}
{ Procedure Ymax(funcs:byte);
var x, xOld,y : real;
Begin
x:=0;
xOld:=0;
case funcs of
1 : MaximY:=Round(2*((x-1)*(x-1)*(x-1))-5*x+9);
2 : MaximY:=Round(((x*x*x)/3)+1);
end;
while x<Interval do
begin
xOld:=x;
x:=x+Accuracy;
case funcs of
1 : y:=2*((x-1)*(x-1)*(x-1))-5*x+9;
2 : y:=((x*x*x)/3)+1;
end;
if y>MaximY then MaximY:=Round(y);
end;
End;}
{*************************************************************************}
END.
Соседние файлы в папке GAS
  • #
    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.$$$
  • #
    10.05.20150 б8TP0CE76E.$$$
  • #
    10.05.20154.1 Кб8TP0CED80.$$$
  • #
    10.05.20158.19 Кб9TP0D1302.$$$