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.