program Lagrange;

uses crt;

 const n=10;

type pole=array[1..n] of real;

var xx,yy: pole;  x,y: real;   i,k,l,mm:byte;

 procedure nacti(m:byte;var aa,bb:pole);

  var d:byte; g,gg:real;

  begin

      for d:=1 to m do begin

          writeln('   Zadej souradnice  ',d,'. bodu:');

          write('   x=');     readln(g);      aa[d]:=g;

          write('   y=');     readln(gg);    bb[d]:=gg;  end;

  end;

procedure tisk(m:byte;aa,bb:pole);

 var t:byte;

 begin  writeln;

 for t:=1 to m do write('    f(',aa[t]:5:3,')=',bb[t]:5:3,'    ');

 writeln; end;

procedure lagran(m:byte; a:real; aa,bb:pole; var ss:real);

 var q,qq:byte; s,j,z:real;

   begin

    ss:=0;

    for q:=1 to m do begin

                     s:=1; j:=1;   z:=0;

                     if q=1 then for qq:=2 to m do begin

                                                s:=s*(a-aa[qq]);

                                                j:=j*(aa[q]-aa[qq])

                                                   end

                            else if q<m then begin

                                             for qq:=1 to q-1 do begin

                                                          s:=s*(a-aa[qq]);

                                                          j:=j*(aa[q]-aa[qq])

                                                                 end;

                                             for qq:=q+1 to m do begin

                                                        s:=s*(a-aa[qq]);

                                                        j:=j*(aa[q]-aa[qq])

                                                                 end

                                             end

                                        else for qq:=1 to m-1 do begin

                                                         s:=s*(a-aa[qq]);

                                                         j:=j*(aa[q]-aa[qq])

                                                                 end;

     z:=((s/j)*bb[q]);   write('   f(x',q,')*l',q,'=',z:5:3,'   '); ss:=ss+z;

                     end;

                     writeln;

   end;

begin clrscr; writeln('   Zadej pocet bodu:      Maximum = ',n);  read(mm);

  writeln('   Zadej x-souradnici hledaneho bodu: ');  readln(x); writeln;

  nacti(mm,xx,yy);   writeln;

  lagran(mm,x,xx,yy,y);

  writeln;   writeln('   Zadane body : ');

  tisk(mm,xx,yy);

  writeln; writeln( '   Hodnota Lagrangeova polynomu L',mm,'(',x:3:2,')  =',y:10:3);

  repeat until keypressed;

end.