Program lagrange_kiszamito;
uses crt;
const max=50;
type tombt=array[0..max+1] of real;
     tombt2=array[0..max,0..max+1] of real;
var out,out2,f2,a,b:tombt;
    i,j,k:integer;
    m:real;
    n:integer;
    f:tombt2;
    c:char;

procedure pontokbe(Var n:integer;Var a,b:tombt);
var hiba:boolean;
    i,j:integer;
begin
  Repeat
    Write('Kerem az alappontok szamat (1-10): ');
    Readln(n);
  Until n in [1..10];
  n:=n-1;
  for i:=0 to n do
  begin
     repeat
       Write('Kerem az ',i+1,'. alappontot: ');readln(a[i]);
       hiba:=false;
       for j:=0 to i-1 do
         if a[j]=a[i] then hiba:=true;
       if hiba then Writeln('Ilyen mar volt!');
     until not(hiba);
     Write('Kerem az ',i+1,'. helyettesitesi erteket: ');readln(b[i]);
  end;
end;

procedure polinomszorzas(var g,h:tombt);
var i,j:integer;
    a:array[0..2*max] of real;
begin
  for i:=0 to n do a[i]:=0;
  for i:=0 to n do
    for j:=0 to n do
      a[i+j]:=g[i]*h[j]+a[i+j];
  for i:=0 to n do g[i]:=a[i];
end;

function p(const b:tombt;r:real):real;
var k:real;
    i:integer;
begin
  k:=b[n];
  for i:=n-1 downto 0 do k:=k*r+b[i];
  p:=k;
end;

procedure lagrange(Const a,b:tombt;var f:tombt2);
var g,h:tombt;
    i,j,k,l:integer;
    m:real;
begin
  if n=0 then
  begin
    f[n+1,0]:=b[0];
  end
  else
  begin
    for i:=0 to n do
    Begin
      for k:=0 to n do g[k]:=0;
      for k:=0 to n do h[k]:=0;
      if i<>0 then
      begin
        g[0]:=-1*a[0];
        g[1]:=1;
        for j:=1 to n do
        begin
          h[1]:=1;
          h[0]:=-1*a[j];
          if j<>i then polinomszorzas(g,h);
        end;
      end
      else
      begin
        g[0]:=-1*a[1];
        g[1]:=1;
        for j:=2 to n do
        begin
          h[1]:=1;
          h[0]:=-1*a[j];
          polinomszorzas(g,h);
        end;
      end;
      m:=p(g,a[i]);
      for j:=0 to n do f[i,j]:=g[j]/m;

      l:=n;
      while (f[i,l]=0) and (l>1) do dec(l);
      Writeln('A lagrange ',i,'. lepes ');
      write('f',i,'= ');
      for k:=l downto 0 do
      begin
        if f[i,k]>=0 then Write(f[i,k]:7:2,'*x^',k,' ')
                     else Write('(',f[i,k]:7:2,')*x^',k,' ');
        if k>0 then Write('+');
      end;
      writeln;
      readkey;
    end;
    for i:=0 to n do f[n+1,i]:=b[0]*f[0,i];
    for i:=1 to n do
      for j:=0 to n do f[n+1,j]:=f[n+1,j]+b[i]*f[i,j];
  end;

  {kiiratas kezdete}
  k:=n;
  while (f[n+1,k]=0) and (k>1) do dec(k);
  Writeln('A lagrange interpolacios polinom= ');
  Write('f= ');
  for i:=k downto 0 do
  begin
    if f[n+1,i]>=0 then Write(f[n+1,i]:7:2,'*x^',i,' ')
                   else Write('(',f[n+1,i]:7:2,')*x^',i,' ');
    if i>0 then Write('+');
  end;
  writeln;
  readkey;
  {kiiratas vege}
end;

procedure newton(const a,b:tombt;Var f:tombt);
var e,g,h:tombt;
    i,j,o:integer;
    k,l,m:real;
Begin
  for i:=0 to n do f[i]:=0;
  f[0]:=b[0];
  Writeln('A 0. Newton interpolacios polinom:');
  Write('g0= ');
  if f[0]>=0 then Write(f[0]:7:2,'*x^0')
                else Write('(',f[0]:7:2,')*x^0');
  writeln;
  readkey;

  for i:=1 to n do
  Begin
    for j:=0 to n do g[j]:=0;
    for j:=0 to n do h[j]:=0;
    k:=1;
    for j:=0 to i-1 do k:=k*(a[i]-a[j]);
    k:=-1/k;
    m:=p(f,a[i])-b[i];
    g[1]:=1;
    g[0]:=-1*a[0];
    for j:=1 to i-1 do
    begin
      h[1]:=1;
      h[0]:=-1*a[j];
      polinomszorzas(g,h);
    end;
    for j:=0 to n do g[j]:=m*k*g[j];
    for j:=0 to n do f[j]:=f[j]+g[j];
    Writeln('Az ',i,'. Newton interpolacios polinom:');
    write('g',i,'= ');
    o:=n;
    while (f[o]=0) and (o>1) do dec(o);
    for j:=o downto 0 do
    begin
      if f[j]>=0 then Write(f[j]:7:2,'*x^',j,' ')
                else Write('(',f[j]:7:2,')*x^',j,' ');
      if j>0 then Write('+');
    end;
    writeln;
    readkey;
  end;
end;

begin
  pontokbe(n,a,b);
  lagrange(a,b,f);
  writeln;
  newton(a,b,f2);
  for i:=0 to n do
  begin
    out[i]:=f[n+1,i];
    out2[i]:=f2[i];
  end;
  repeat
    writeln;
    write('Behelyettesitesi ertek x:=');readln(m);
    writeln('Lagrange -- p(x)=',p(out,m):2:2);
    writeln('Newton   -- p(x)=',p(out2,m):2:2);
    write('Akarsz £jabb pontot (i/n) ?');
    c:=upcase(readkey);
  until (c<>'I');
  writeln;
end.