Nadesłany przez Andrzej Borucki, 06 grudnia 2011 21: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.
met_najmn_kwadr/LeastSqUnit.pas:
//Metoda najmniejszych kwadratów
//Andrzej Borucki
//www.algorytm.org
unit LeastSqUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
Image: TImage;
procedure FormCreate(Sender: TObject);
private
a,b: real;
public
procedure Calc;
procedure DrawCoord;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TRealPoint = record
x,y: real;
end;
const
Points: array[0..8] of TRealPoint =
((x:2;y:3),(x:4;y:1;),(x:6;y:6),
(x:6;y:4),(x:8;y:3),(x:8;y:5),
(x:11;y:6),(x:14;y:5),(x:14;y:7));
{ TForm1 }
procedure TForm1.Calc;
var
Sx,Sy,Sxx,Sxy: real;
Delta: real;
i,n: integer;
begin
Sx:=0; Sy:=0; Sxx:=0; Sxy:=0;
n:=Length(Points);
for i:=Low(Points) to High(Points) do
with Points[i] do
begin
Sx:=Sx+x;
Sy:=Sy+y;
Sxx:=Sxx+x*x;
Sxy:=Sxy+x*y;
end;
Delta:=Sx*Sx-Sxx*n;
a:=(Sx*Sy-Sxy*n)/Delta;
b:=(Sx*Sxy-Sxx*Sy)/Delta;
end;
{
Standardowa funkcja Trunc obicna zawsze w kierunku zera, potrzebujemy
obicnajacych zawsze w dol lub w gore
}
function TruncDown(f: real): int64;
begin
result:=Trunc(f);
if (result <> f) and (f < 0) then result:=result-1;
end;
function TruncUp(f: real): int64;
begin
result:=Trunc(f);
if (result <> f) and (f > 0) then result:=result+1;
end;
procedure TForm1.DrawCoord;
var
Center: TPoint;
Scale: real;
//funkcje do konwersji na wspolrzedne komponentu image
function imgX(x: real):integer;
begin
result:=round(x*Scale+Center.X);
end;
function imgY(y: real):integer;
begin
result:=round(Center.Y-y*Scale);
end;
var
fromPosX,toPosX: integer;
fromPosY,toPosY: integer;
i: integer;
begin
Center.X:=20;
Center.Y:=Image.Height-20;
Scale:=30;
with Image.Canvas do
begin
MoveTo(0,Center.Y);
LineTo(Image.Width,Center.Y);
MoveTo(Center.X,Image.Height);
LineTo(Center.X,0);
//rysowanie podzialki poziomej
fromPosX:=TruncUp((-Center.X)/Scale);
toPosX:=TruncDown((Image.Width-Center.X)/Scale);
for i:=fromPosX to toPosX do
begin
MoveTo(imgX(i),Center.Y-5);
LineTo(imgX(i),Center.Y+5);
TextOut(imgX(i)-3,Center.Y+2,IntToStr(i));
end;
//rysowanie podzialki pionowej
fromPosY:=TruncUp(-(Image.Height-Center.Y)/Scale);
toPosY:=TruncDown(Center.Y/Scale);
for i:=fromPosY to toPosY do
begin
MoveTo(Center.X-5,imgY(i));
LineTo(Center.X+5,imgY(i));
TextOut(Center.X-10,imgY(i)-6,IntToStr(i));
end;
//rysowanie punktow
for i:=Low(Points) to High(Points) do
with Points[i] do
Ellipse(imgX(X)-2,imgY(Y)-2,imgX(X)+2,imgY(Y)+2);
//rysowanie prostej
MoveTo(imgX(fromPosX-1),imgY(a*(fromPosX-1)+b));
LineTo(imgX(toPosX+1),imgY(a*(toPosX+1)+b));
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Calc;
DrawCoord;
end;
end.

