unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Image1: TImage;
Memo1: TMemo;
procedure awal;
procedure datamentah;
procedure plotdata;
procedure regresi;
procedure kuadratis;
procedure plotregresi;
function f(x:real):real;
function fk(x:real):real;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const n=40; skala=3;
var
Form1: TForm1;
x0,y0:integer; x,y:array[-n..n]of real;
a,b:real; c:array[1..3]of real;
matrik:array[1..3,1..4]of real;
implementation
{$R *.dfm}
procedure tform1.kuadratis;
var sxi,sxi2,sxi3,sxi4,syi,syixi,syixi2:real;
i,j,k:integer; jml,simpan:real;
begin
sxi:=0;sxi2:=0;sxi3:=0;sxi4:=0; syi:=0;syixi:=0;syixi2:=0;
{sigma xi} {sigma xi kuadrat} {sigma xi pangkat3} {sigma xi pangkat4}
{sigma yi} {sigma yi*xi} {sigma yi* xi*xi }
for i:=1 to n do begin
sxi:=sxi+x[i]; sxi2:=sxi2+x[i]*x[i];
sxi3:=sxi3+x[i]*x[i]*x[i]; sxi4:=sxi4+x[i]*x[i]*x[i]*x[i];
syi:=syi+y[i]; syixi:=syixi+y[i]*x[i];
syixi2:=syixi2+ y[i]*x[i]*x[i];
end;
{isi matrik}
matrik[1,1]:=n; matrik[1,2]:=sxi;
matrik[1,3]:=sxi2; matrik[1,4]:=syi;
matrik[2,1]:=sxi; matrik[2,2]:=sxi2;
matrik[2,3]:=sxi3; matrik[2,4]:=syixi;
matrik[3,1]:=sxi2; matrik[3,2]:=sxi3;
matrik[3,3]:=sxi4; matrik[3,4]:=syixi2;
{gaus naif}
for k:= 1 to 3 do begin
for i:= k+1 to 3 do begin
simpan:=matrik[i,k];
if simpan=0 then begin end
else begin
for j:=k to 4 do
matrik[i,j]:=
matrik[i,j]/
simpan*
matrik[k,k]-
matrik[k,j];
end;
end;
end;
{subtitusi}
c[3]:=matrik[3,4]/matrik[3,3];for i:=2 downto 1 do begin jml:=0;for j:=i+1
to 3
do jml:=jml+matrik[i,j]*c[j]; c[i]:=(matrik[i,4]-jml)/matrik[i,i];end;
memo1.Lines.Append('c[1] = '+ floattostr(c[1]));
memo1.Lines.Append('c[2] = '+ floattostr(c[2]));
memo1.Lines.Append('c[3] = '+ floattostr(c[3]));
{plot kuadratis}
image1.Canvas.Pen.Color:=clred;
image1.Canvas.MoveTo(x0+round(x[-n]),y0-round(skala*fk(x[-n])));
for i:=-n to n do begin
image1.Canvas.lineto(x0+round(x[i]),y0-round(skala*fk(x[i])));
end;
end;
function tform1.fk(x:real):real;
begin
fk:=c[1]+c[2]*x+c[3]*x*x;
end;
procedure tform1.regresi;
var i:integer; xix,xixx,rx,ry:real;
begin
rx:=0;ry:=0;
for i:=1 to n do begin
rx:=rx+x[i]; ry:=ry+y[i];
end;
rx:=rx/n; ry:=ry/n;
memo1.Lines.Append('rx = '+floattostr(rx)); memo1.Lines.Append('ry = '+floattostr(ry));
xix:=0; xixx:=0;
for i:=1 to n do begin
xix:=xix+(x[i]-rx)*(y[i]-ry); xixx:=xixx+(x[i]-rx)*(x[i]-rx);
end;
b:=xix/xixx; memo1.Lines.Append('b = '+floattostr(b));
a:=ry-b*rx; memo1.Lines.Append('a = '+floattostr(a));
end;
procedure tform1.awal;
begin
randomize; memo1.Text:='';
stringgrid1.Cells[0,0]:='x'; stringgrid1.Cells[1,0]:='y';
stringgrid1.RowCount:=2;
datamentah;
plotdata;
regresi;
plotregresi;
kuadratis;
end;
procedure tform1.plotregresi;
var px,py:real;
begin
px:=-2*n; py:=a+b*(-2*n);
image1.Canvas.pen.Color:=cllime;
image1.Canvas.MoveTo(x0+round(px), y0-skala*round(py));
px:=2*n; py:=a+b*(2*n);
image1.Canvas.lineTo(x0+round(px),y0-skala* round(py));
memo1.Lines.Append('fungsi regresi: y ='+ floattostrf(a,ffGeneral,2,4)+' + '+
floattostrf(b, ffGeneral,2,4)+' x');
end;
procedure tform1.plotdata;
var i:integer;
begin
x0:=round(image1.Width/2); y0:=round(image1.Height/2);
image1.Canvas.MoveTo(0,y0); image1.Canvas.LineTo(image1.Width,y0);
image1.Canvas.MoveTo(x0,0); image1.Canvas.LineTo(x0,image1.Height);
for i:=-n to n do begin
image1.Canvas.Pixels[x0+round(x[i]),y0-round(skala*y[i])]:=clblue;
end;
end;
procedure tform1.datamentah;
var i:integer;
begin
stringgrid1.RowCount:=2*n+1;
for i:=-n to n do begin
x[i]:=i; y[i]:=f(x[i]);
stringgrid1.Cells[0,i+n+1]:=floattostr(x[i]);
stringgrid1.Cells[1,i+n+1]:=floattostr(y[i]);
end;
end;
function tform1.f(x:real):real;
begin
f:=x*x/32+random(20)-10;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
awal;
end;
end.
Pages
▼
Wednesday, June 4, 2014
[Delphi] Linear and Quadratic Regression (just for self documentation)
The code below have the plots and graphs (linear and quadratic regression) included
No comments:
Post a Comment