//www.algorytm.org
//Tomasz Lubiński (c)2001
//Algorytmy numeryczne - Algorytm Neville'a
//Oblicza wartosc wielomianu Newtona i Lagrange'a w dowolnm punkcie bez liczenia tych wielomianów

unit Algorytm;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Grids, Buttons;
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    StringGrid1: TStringGrid;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Edit2: TEdit;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    procedure Edit1Change(Sender: TObject);
    procedure w_lewo(Sender: TObject);
    procedure w_prawo(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure do_gory(Sender: TObject);
    procedure na_dol(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  n: Integer;
  prawo: Integer=1;
  gora: Integer=1;
  X: Real;
  MX, MFX: Array of real;

implementation

{$R *.DFM}

function P(i,k: Integer):Real;
begin
if k=0 then P:=MFX[i] Else
 begin
  P:=((X-MX[i-k])*P(i,k-1)-(X-MX[i])*P(i-1,k-1))/(MX[i]-MX[i-k])
 end;
end;

procedure OBLICZ(var blad:Byte);
var i,j: Integer;
begin
for i:=1 to n-1 do    //sprawdzenie czy nie ma dwóch tych samych x
 for j:=i+1 to n do
  if MX[i]=MX[j] then begin blad:=1; exit; end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.ColCount:=1;
StringGrid1.RowCount:=3;
StringGrid1.Cells[0,1]:='Wezel (x[i])';
StringGrid1.Cells[0,2]:='Wartosc (f(x[i]))';
Edit1Change(Form1);
end;

//Zrobienie siatki i ustawienie tablic dynamicznych
procedure TForm1.Edit1Change(Sender: TObject);
var i,j:Integer;
begin
n:=StrToInt(Edit1.Text);
StringGrid1.ColCount:=n+1;
SetLength(MX, n);
SetLength(MFX, n);
for i:=1 to n+1 do for j:=1 to 2 do StringGrid1.Cells[i,j]:='';
for i:=1 to n do StringGrid1.Cells[i,0]:='Wezel '+IntToStr(i);
end;

//Nawigacja
procedure TForm1.w_lewo(Sender: TObject);
begin
if prawo>1 then
 begin
 prawo:=prawo-1;
 StringGrid1.Col:=prawo;
 StringGrid1.Row:=gora;
 end;
end;
procedure TForm1.w_prawo(Sender: TObject);
begin
if prawo<n then
 begin
  prawo:=prawo+1;
  StringGrid1.Col:=prawo;
  StringGrid1.Row:=gora;
 end;
end;
procedure TForm1.do_gory(Sender: TObject);
begin
if gora>1 then
 begin
  gora:=gora-1;
  StringGrid1.Col:=prawo;
  StringGrid1.Row:=gora;
 end;
end;
procedure TForm1.na_dol(Sender: TObject);
begin
if gora<2 then
 begin
  gora:=gora+1;
  StringGrid1.Col:=prawo;
  StringGrid1.Row:=gora;
 end;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
if (ARow>0) and (ACol>0) then
 begin
  prawo:=ACol;   gora:=ARow;
 end;
end;

//wpis
procedure TForm1.Button1Click(Sender: TObject);
var i:Integer;
begin
if gora=1 then Val(Edit2.Text,MX[prawo-1],i);
if gora=2 then Val(Edit2.Text,MFX[prawo-1],i);
if i<>0 then ShowMessage('Blad podczas wpisu') Else StringGrid1.Cells[prawo,gora]:=Edit2.Text;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,j: Integer;
begin
if gora=2 then Val(Edit3.Text,X,i);
if i<>0 then begin ShowMessage('Blad podczas wpisu x'); exit; end;
for i:=0 to n-2 do    //sprawdzenie czy nie ma dwóch tych samych x
 for j:=i+1 to n-1 do
  if MX[i]=MX[j] then begin Label4.Caption:='Blad! Powtarzaja sie wezly (x[i])'; exit; end;
Label4.Caption:='Wartosc w punkcie '+Edit3.Text+' wynosi '+FloatToStr(P(n-1,n-1));
end;

end.