01 семестр / К экзамену-зачёту / Все задачи с экзамена в формате PAS / Alex / SUPER

UNIT Super;

INTERFACE
USES CRT;

TYPE
AR=Array[0..128] of REAL;
q=record
naz:string;
a:string;
god:integer;
end;
knig=array[1..30] of q;
spis=array[1..30] of string;

VAR
j1,p,h1,delta,j,a,b,h, c:REAL;
n1,n,i, z:INTEGER;
y2,y1,y:AR;
in1,in2,sm,s2,del: Real; {­Ё¦­Ё©, ўҐае­Ё© ЇаҐ¤Ґ«л Ё и Ј Ё­вҐЈаЁа®ў ­Ёп}
a1,b1: Integer; {зЁб«® а §ЎЁҐ­Ё©}
k:knig;
s:spis;
w:STRING;
v:integer;

function f(x:real):real;
procedure tab1(a,h:real;n:integer;var yy:ar);
function pram(h:real;n:integer;yy:ar):real;
function smpsn(n:integer ;h:real; y:ar):real;
Function F1(x: Real): Real;
Procedure Tab(h: Real; a1,n: Integer; Var y: ar);
Function Simpson(n: Integer; h: Real; y: ar;var s2:real): Real;
Procedure Nachalo(var a1,b1,n:integer);
Procedure TaskB;
Procedure Escape;



IMPLEMENTATION

function f(x:real):real;
begin f:=x;
end;

procedure tab1(a,h:real;n:integer;var yy:ar);
var x:real;
begin
x:=a;
for i:=0 to n do
begin
yy[i]:=f(x);
x:=x+h;
end;
end;

function pram(h:real;n:integer;yy:ar):real;
var s:real;
begin s:=0;
for i:=0 to n-1 do
s:=s+yy[i];
pram:=h*s;
end;
function smpsn(n:integer ;h:real; y:ar):real;
var s1,s2:real; q:integer;
begin
s1:=0; s2:=0; q:=1;
while q<=(n-1) do begin
s1:=s1+y[q]; q:=q+2
end;
q:=2;
while q<=(n-2) do begin
s2:=s2+y[q]; q:=q+2;
end;
smpsn:=(y[0]+y[n]+4*s1+2*s2)*h/3;
end;

Function F1(x: Real): Real;
Begin
F1:= x*x*x;
End;

Procedure Tab(h: Real; a1,n: Integer; Var y: ar);
Var
i: Integer;
Begin
For i:= 0 To n Do y[i]:= F(a1 + i*h);
End;
{-----------------------------}
Function Simpson(n: Integer; h: Real; y: ar;var s2:real): Real;
Var
i: Integer;
s1,s3: Real;
Begin
s1:= 0;
i:= 1;
While i <= (n-1) Do
Begin
s1:= s1 + y[i];
i:= i + 2;
End;
s3:= 0;
i:= 2;
While i <= (n-2) Do
Begin
s3:= s3 + y[i];
i:= i + 2;
End;
Simpson:= (y[0] + y[n] + 4*s1 + 2*s3)*h/3;s1:=0;
for i:=0 to n-1 do begin s1:=s1+f(a+h/2+i*h);end;
s2:=h*s1;

End;
{-----------------------------}
Procedure Nachalo(var a1,b1,n:integer);
Begin
Writeln(' ‚ўҐ¤ЁвҐ ЇаҐ¤Ґ«л Ё­вҐЈаЁа®ў ­Ёп: ');
Write('a = ');
Readln(a1);
Write('b = ');
Readln(b1);
write('а §ЎЁҐ­Ёп ?');readln(n);
End;
{-----------------------------}
Procedure TaskB;
Var
I1,I2,delta,p: Real;
flag: Boolean;
Begin

write('Ї®ЈаҐи­®бвм ?');readln(p);
h:= Sqrt(Sqrt(p));
n:= Round((b1-a1)/h);
If Odd(n) Then Inc(n);
I1:= F1((b1 - a1)/2)*(b1 - a1);
flag:= true;
While flag Do
Begin
h:= (b1 - a1)/n;
Tab(h,a1,n,y);
I2:= Simpson(n,h,y,s2);
delta:= Abs(I2 - I1)/15;
If delta > p
Then
Begin
n:= 2*n;
I1:= I2;
End
Else flag:= false;
End;
Write(' зЁб«® а §ЎЁҐ­Ё© - n =',n:3);
Writeln(' €­вҐЈа « I =',I2:7:5);
Write('Џ®ЈаҐи­®бвм - delta =',delta:7:5);
End;
{-----------------------------}
Procedure Escape;
Begin
TextBackGround(Red);
TextColor(Yellow);
GotoXY(1,25);
WriteLn;
GotoXY(27,25);
Write(' „«п ўл室  ­ ¦¬ЁвҐ Esc...');
Repeat
Until ReadKey = #27;
TextBackGround(Black);
ClrScr;
TextColor(White);
End;
{-----------------------------}
end.