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

program slau;
uses crt;
type mas=array[byte] of real;
     mas_pr=array[1..10] of real;
var As,Bs,a,b,c,d,x,h,xs,ys,r:mas;
    l,k,m,i,n,flag,z,w,q,qa,qe,xx,yy:integer;
    xp,yp:mas_pr;
procedure fslau(n:integer;a,b,c,d:mas;var As,Bs,x:mas;var flag,z:integer);
label 1,5;
var i:integer;
    e,alf,bet:real;
begin  n:=n-1;z:=n;
{prymaya progonca}
As[1]:=-c[1]/b[1];
Bs[1]:=d[1]/b[1];
for i:=2 to n-1 do
  begin e:=a[i]*As[i-1]+b[i];
  if e=0 then begin flag:=1;z:=i;goto 1;end;
  As[i]:=-c[i]/e;
  Bs[i]:=(d[i]-a[i]*Bs[i-1])/e;
  end;
{obrathaya progonca}
alf:=a[n]*As[n-1]+b[n];
bet:=d[n]-a[n]*Bs[n-1];
if alf=0 then begin
    if bet=0 then flag:=2 else flag:=3;
    goto 1;
    end;
x[n]:=bet/alf;
for i:=n-1 downto 1 do x[i]:=As[i]*x[i+1]+Bs[i];
1:
end;
procedure pro(s:string;m:integer);
var j:integer;
begin for j:=1 to m do write(s);end;
function spline(mun:integer;u:real):real;
var p,t,f:real;
begin p:=xs[mun-1];
      t:=u-p;
      f:=a[mun]+b[mun]*t+c[mun]*t*t+d[mun]*t*t*t;
      spline:=f;
end;
function numb(n:integer;t:real;xs:mas):integer;
var l:integer;
begin l:=0;
      if t<xs[0] then numb:=1 else
      if t>xs[n] then numb:=n else begin
         repeat l:=l+1
         until ((t>=xs[l-1])and(t<=xs[l])) or (l>=n);
         if (t>=xs[l-1])and(t<=xs[l]) then numb:=l else numb:=0;
         end;
end;
procedure vvod(k:integer;var xp,yp:mas_pr);
var i,xx,yy,m:integer;
begin writeln('‚ўҐ¤ЁвҐ ¬ ббЁў Їа®¬. §­ зҐ­Ё©');
             for i:=1 to k do begin write('x[',i,']=  ');
                 xx:=wherex;yy:=wherey;
                 repeat gotoxy(xx,yy);pro(' ',10);
                        gotoxy(xx,yy);readln(xp[i]);
                        m:=numb(n,xp[i],x);
                 until m>0;
                 yp[i]:=spline(m,xp[i]);
             end;
end;
BEGIN clrscr;
write('‚ўҐ¤ЁвҐ n-  Є®«-ў® ®в१Є®ў');
readln(n);
w:=8;qa:=5;q:=7;qe:=8;
gotoxy(2,5);write('i');gotoxy(2,7);write('X(i)');gotoxy(2,8);write('Y(i)');
for i:=0 to n do begin
  gotoxy(w,qa);write(i);
  gotoxy(w,q);read(xs[i]);
  gotoxy(w,qe);read(ys[i]);
if i<>0 then begin
    h[i]:=xs[i]-xs[i-1];
    r[i]:=(ys[i]-ys[i-1])/h[i];
end;
w:=w+5;
end;
for i:=1 to n-1 do begin
  b[i]:=2*(h[i]+h[i+1]);
  d[i]:=3*(r[i+1]-r[i]);if i<>1 then a[i]:=h[i];
end;
for i:=1 to n-2 do c[i]:=h[i+1];
FSLAU(n,a,b,c,d,As,Bs,x,flag,z);
writeln('&&&&& ',n);
if flag=0 then begin
  for i:=1 to n-1 do begin
    c[i+1]:=x[i];c[1]:=0;c[n+1]:=0;
    end;
  for i:=1 to n do begin
    a[i]:=ys[i-1];
    b[i]:=r[i]-h[i]/3*(c[i+1]+2*c[i]);
    d[i]:=(c[i+1]-c[i])/3*h[i];
  end;
  for i:=1 to n do writeln(a[i]:3:5,' ',b[i]:3:5,' ',c[i]:3:5,' ',d[i]:3:5);
end;
{‚лзЁб«Ґ­Ёп ў Їа®¬. в®зЄ е}
writeln('‚ўҐ¤ЁвҐ Є®«-ў® Їа®¬. §­ зҐ­Ё© (<=10)');
readln(k);
VVod(k,xp,yp);
for i:=1 to k do writeln(' ',yp[i]:3:5,' ');
case flag of
1:writeln('‘Ёб⥬   ­Ґ  аҐи Ґвбп ¬Ґв®¤®¬ Їа®Ј®­ЄЁ');
2:writeln('‘Ёб⥬  Ё¬ҐҐв ЎҐбЄ®­Ґз­® ¬­®Ј® аҐиҐ­Ё©');
3:writeln('‘Ёб⥬         ­Ґ       б®ў¬Ґбв­ ');
end;
readln;
readln;
END.