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.