//www.algorytm.org
//Tomasz Lubiński (c)2001
//Algorytmy numeryczne - Ciąg Sturma
//Oblicza ilość miejsc zerowych wielomianu w danym przedziale

unit Ciag;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Grids, Buttons, Math;
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    StringGrid1: TStringGrid;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    BitBtn3: TBitBtn;
    Edit2: TEdit;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Edit4: TEdit;
    Label8: TLabel;
    procedure Edit1Change(Sender: TObject);
    procedure w_lewo(Sender: TObject);
    procedure w_prawo(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=1;
  A,tmp1,tmp2: Array of real;
  CS: Array of Array of extended;  //tablica zawierająca kolejne wielomiany ciągu Sturma

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<1 then begin ShowMessage('Wielomian musi być conajmniej pierwszego stopnia'); exit; end;
StringGrid1.ColCount:=n+1;
SetLength(A, n+1);
SetLength(CS, n+1, n+1); //część tablicy będzie nie wykorzystana, ale to ułatwi zapis
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;

//Nawigacja
procedure TForm1.w_lewo(Sender: TObject);
begin
if prawo>0 then
 begin
 prawo:=prawo-1;
 StringGrid1.Col:=prawo;
 end;
end;
procedure TForm1.w_prawo(Sender: TObject);
begin
if prawo<n then
 begin
  prawo:=prawo+1;
  StringGrid1.Col:=prawo;
 end;
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,A[n-prawo],i);
if i<>0 then ShowMessage('Blad podczas wpisu') Else StringGrid1.Cells[prawo,1]:=Edit2.Text;
end;

procedure Dziel(i: Integer);
var a,b:Integer;
    tmp: Extended;
begin
SetLength(tmp1, n+3-i);
for a:=0 to n-i+2 do tmp1[a]:=CS[i-2,a];
for a:=0 to 1 do
 begin
  if CS[i-1,n-i+1]=0 then begin ShowMessage('Podany przez Ciebie wielomian ma wielokrotne miejsca zerowe'); exit; end;
  tmp:=tmp1[n-i+2-a]/CS[i-1,n-i+1];                                //odnalezienie ilorazu
  for b:=n-i+2-a downto 1-a do tmp1[b]:=tmp1[b]-tmp*CS[i-1,b-1+a]; //przemnożenie przez iloraz i dodanie do dzilonego wielomianu
 end;
for a:=0 to n-i+1 do CS[i,a]:=-(CS[i-1,n-i+1]*CS[i-1,n-i+1])*tmp1[a]; //Wpisanie wyniku do tablicy zawierającej ciąg Sturma po uprzednim przemnożeniu przez stałą mniejszą od zera
Finalize(tmp1);
end;

function w(k,i:Integer; x:Real):Real;  //algorytm Hornera - obliczanie wartości wielomianu
begin
if k=n then w:=CS[i,k] else w:=w(k+1,i,x)*x+CS[i,k]
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,zm1,zm2: Integer;
    p,k: Real;
begin
Val(Edit3.Text,p,i);
if i<>0 then begin ShowMessage('Źle wpisany początek przedziału'); exit; end;
Val(Edit4.Text,k,i);
if i<>0 then begin ShowMessage('Źle wpisany koniec przedziału'); exit; end;
if k<p then begin ShowMessage('Koniec przedziału jest mniejszy od początku!'); exit; end;
for i:=0 to n do CS[0,i]:=A[i];           //P0(x)=p(x)
for i:=n downto 2 do CS[1,i-1]:=-A[i]*i;  //P1(x)=-p'(x)
CS[1,0]:=-A[1];
for i:=2 to n do Dziel(i);                //pozostałe
SetLength(tmp1, n+1);  zm1:=0;
SetLength(tmp2, n+1);  zm2:=0;
for i:=0 to n do tmp1[i]:=w(0,i,p);     //wartości c.Struma w początku przedziału
for i:=0 to n do tmp2[i]:=w(0,i,k);     //wartości c.Struma w końcu przedziału
for i:=0 to n-1 do if tmp1[i]*tmp1[i+1]<0 then zm1:=zm1+1; //liczba zmian znaku c.Struma w początku przedziału
for i:=0 to n-1 do if tmp2[i]*tmp2[i+1]<0 then zm2:=zm2+1; //liczba zmian znaku c.Struma w końcu przedziału
Label8.Caption:='Liczba zer wielomianu w przedziale <'+FloatToStr(p)+';'+FloatToStr(k)+') wynosi '+IntToStr(zm2-zm1);
end;
end.