Nadesłany przez Tomasz Lubiński, 08 sierpnia 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
nevill_d/Algorytm.pas:
//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.