uses crt;
const M=3;
var
    n: integer;
    h, b, c: double;
    contrx: array [1..M] of double;
    x,a,y: array [0..100] of ^double;
    ot: char;

function f(x: double): double;
begin
f := 5.5*(exp(1/3*ln(4+x*x)));{вставь свою функцию }
end;

procedure menu;
begin
clrscr;
writeln('1 - Lagrang');
writeln('2 - 1-st Newton');
writeln('3 - 2-nd Newton');
writeln('4 - Exit');
writeln;
write('Select: ');
end;

procedure Control;
var i: double;
    j: byte;
begin
repeat
 clrscr;
for j := 1 to M do
for j := 1 to M do begin
    write('Vvedite new x',j,': ');
    Readln(i);
    if (i >= c) and (i <= b) then contrx[j] := i
    else
	writeln('Znachenie vne otrezka [a,b], tak nelzya!');
readln;
end;
until (i>=c) and (i<=b);
end;

procedure otr;
begin
clrscr;
write('Vvedite new a: ');
Readln(c);
write('Vvedite new b: ');
Readln(b);
end;

function step(x: double;n: word;t: double): double;
var i: word;
    tmp: double;
begin
tmp := 1;
for i := 1 to n do tmp := tmp*(x-(i-1)*t);
step := tmp;
end;

function delta(x:double;n:word;h:double): double;
var tmp: double;
begin
if n = 1 then delta := f(x + h) - f(x)
else begin
     tmp := delta(x,n-1,h);
     delta := delta(x+h,n-1,h) - tmp;
     end;
end;

function fact(x: integer): longint;
var i: word;
    tmp: longint;
begin
tmp := 1;
for i := 1 to x do tmp := tmp*i;
fact := tmp;
end;

procedure Toch;
begin
clrscr;
write('Vvedite n: ');
Readln(n);
end;


procedure Lagrang;
var i,j,k: word;
    tmp1,tmp2,L,tx: double;
begin
clrscr;
otr;
control;
Toch;
for i := 0 to n do begin
    New(x[i]); New(a[i]); New(y[i]);
    x[i]^ := c+(random*h*i); y[i]^ := f(x[i]^);
    end;
writeln;
for k := 1 to M do begin
    L := 0;
    tx := contrx[k];
    tmp1 := 1;
    for j := 0 to n do tmp1 := tmp1*(tx-x[j]^);
    for i := 0 to n do begin
	tmp2 := 1;
	for j := 0 to n do
	      if i <> j then tmp2 := tmp2*(x[i]^-x[j]^);
	a[i]^ :=( tmp1/(tx-x[i]^))/tmp2;
	L := L + a[i]^*y[i]^;
	end;
    writeln;
    writeln('L(x) = ',L:2:3,' f(x) = ',f(tx):2:3,' R(x) = ',tmp1*f(c)/fact(n+1):2:3);
    end;
for i := 0 to n do begin
    Dispose(x[i]); Dispose(a[i]); Dispose(y[i]);
    end;
readln;
end;

procedure Newton1;
var i,k: word;
    tx,q,P: double;
begin
clrscr;
otr;
control;
Toch;
for i := 0 to n do begin
    New(x[i]); New(y[i]);
    x[i]^ := c + i*h; y[i]^ := f(x[i]^);
    end;
for k := 1 to M do begin
    tx := contrx[k];
    q := (tx - x[0]^)/h;
    P := y[0]^;
    for i := 1 to n do begin
	P := P + step(q,i,1)/fact(i)*delta(x[0]^,i,h);
	end;
    writeln;
    writeln('P(x) = ',P:2:3,' f(x) = ',f(tx):2:3,' R(x) = ',step(q,n+1,1)/fact(n+1)*delta(x[0]^,n+1,h):2:3);
    end;
for i := 0 to n do begin
    Dispose(x[i]); Dispose(y[i]);
    end;
readln;
end;

procedure Newton2;
var i,k: word;
    tx,q,P: double;
begin
clrscr;
otr;
control;
Toch;
for i := 0 to n do begin
    New(x[i]); New(y[i]);
    x[i]^ := c + i*h; y[i]^ := f(x[i]^);
    end;
for k := 1 to M do begin
    tx := contrx[k];
    q := (tx - x[n]^)/h;
    P := y[n]^;
    for i := 1 to n do begin
	P := P + (step(q,i,-1)/fact(i))*delta(x[n-i]^,i,h);
	end;
    writeln;
    writeln('P(x) = ',P:2:3,' f(x) = ',f(tx):2:3,' R(x) = ',step(q,n+1,-1)/fact(n+1)*delta(x[0]^,n+1,h):2:3);
    end;
for i := 0 to n do begin
    Dispose(x[i]); Dispose(y[i]);
    end;
readln;
end;


begin
randomize;
c := -2; b := 3;
for n := 1 to M do contrx[n] := random*(b-c) + c;
n := 5; h := (b-c)/n;
repeat
menu;
readln(ot);
case ot of
     '1':Lagrang;
     '2':Newton1;
     '3':Newton2;
     '4':end;
     
until ot = '4';
end.