unit Metoda;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Grids, Buttons, Math;
type
tablica = array of extended;
TForm1 = class(TForm)
Edit1: TEdit;
StringGrid1: TStringGrid;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
Label3: TLabel;
Edit3: TEdit;
Label4: TLabel;
Label5: TLabel;
Edit4: TEdit;
Label8: TLabel;
Edit5: TEdit;
Label6: TLabel;
procedure Edit1Change(Sender: TObject);
procedure FormCreate(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;
MX: Array of extended;
st1,st2: integer;
x,x1,ak,ak1:extended;
e: extended=0.00000001;
tabf1: tablica;
tabf2: tablica;
tabPom1 : tablica;
tabPom2 : array of extended;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.ColCount:=1;
StringGrid1.RowCount:=2;
Edit1Change(Form1);
end;
//Zrobienie siatki i ustawienie tablic dynamicznych
procedure TForm1.Edit1Change(Sender: TObject);
var i:Integer;
begin
n:=StrToInt(Edit1.Text);
if n<2 then begin ShowMessage('Wielomian musi być conajmniej dgugiego stopnia'); exit; end;
StringGrid1.ColCount:=n+1;
SetLength(MX, n+1);
for i:=0 to n+1 do StringGrid1.Cells[i,1]:='';
for i:=0 to n do StringGrid1.Cells[i,0]:='x^'+IntToStr(n-i);
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
prawo:=ACol;
end;
//wpis
procedure TForm1.Button1Click(Sender: TObject);
var i:Integer;
begin
Val(Edit2.Text,MX[n-prawo],i);
if i<>0 then ShowMessage('Blad podczas wpisu') Else StringGrid1.Cells[prawo,1]:=Edit2.Text;
end;
function fHornera(tabAn: array of extended; x1: extended) : extended;
var
tabW: array of extended; //pomocnicza tab dla Wn w alg. Hornera
i: integer;
begin
SetLength(tabW,n+1);
if Length(tabAn)=(n-1) then
ShowMessage('BOOO!!!!');
for i:=n downto 0 do
begin
if (i=n) then
tabW[i]:=tabAn[i]
else
tabW[i]:=tabW[i+1]*x1+tabAn[i];
end;
result:=tabW[0];
end;
function pochodna(f: array of extended; x:integer):tablica;
var
f1: tablica;
i: integer;
begin
setLength(f1,x);
i:=0;
for i:=x downto 1 do
begin
f1[i-1]:=i*f[i];
end;
result:=f1;
end;
procedure TForm1.Button2Click(Sender: TObject);
var i: Integer;
l,p: extended;
begin
try
Val(Edit3.Text,l,i);
if i<>0 then begin ShowMessage('Źle wpisany początek przedziału'); exit; end;
Val(Edit4.Text,p,i);
if i<>0 then begin ShowMessage('Źle wpisany koniec przedziału'); exit; end;
if p<l then begin ShowMessage('Koniec przedziału jest mniejszy od początku!'); exit; end;
{
if(fHornera(MX,l)*fHornera(MX,p))>0 then
begin
writeln('!Funkcja nie spelnia zalozenia: f(a)*f(b) < 0 ');
qut();
end;
}
st1:=n-1;
st2:=n-2;
SetLength(tabPom1,st1+1);
SetLength(tabPom2,st2+1);
SetLength(tabf1,st1+1);
SetLength(tabf2,st2+1);
tabf1:=pochodna(MX,n);
for i:=0 to n-1 do
tabPom1[i]:=tabf1[i];
tabf2:=pochodna(tabPom1,st1);
for i:=0 to n-2 do
tabPom2[i]:=tabf2[i];
ak:=fHornera(MX,l);
ak1:=fHornera(tabPom2,l);
if ( ak*ak1 > 0 ) then
x:=l
else
x:=p;
while (abs(fHornera(MX,x))>e) do
begin
ak :=fHornera(MX,x);
ak1:=fHornera(tabPom1,x);
x1:=x-(ak/ak1);
x:=x1;
end;
except
on EZeroDivide do showmessage('dzielenie przez 0');
end;
Label8.Caption:='Dokładny pierwiastek wynosi '+FloatToStr(x);
end;
end.