unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const n=3;
var
Form1: TForm1;
a:array[1..n,1..n+1]of real;
x:array[1..n]of real;
kotak:array[1..n] of tedit;
implementation
{$R *.dfm}
procedure bacamatrik;
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to n+1 do begin
a[i,j]:=strtofloat(form1.StringGrid1.Cells[j-1,i-1]);
end;end;
end;
procedure tulismatrik;
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to n+1 do begin
form1.StringGrid2.Cells[j-1,i-1]:=floattostr(a[i,j]);
end;end;
end;
procedure naif;
var i,j,k:integer;
simpan:real;
begin
for k:= 1 to n do begin
for i:= k+1 to n do begin
simpan:=a[i,k];
if simpan=0 then begin
end else begin
for j:=k to n+1 do a[i,j]:=a[i,j]/simpan*a[k,k]-a[k,j];
end;
end;
end;
end;
procedure subtitusi;
var i,j:integer;
jml:real;
begin
x[n]:=a[n,n+1]/a[n,n];
for i:=n-1 downto 1 do begin
jml:=0;
for j:=i+1 to n do jml:= jml+a[i,j]*x[j];
x[i]:=(a[i,n+1]-jml)/a[i,i];
end;
end;
procedure buatedit;
var i:integer;
begin
for i:=1 to n do begin
kotak[i]:=tedit.Create(form1);
kotak[i].Left:=300;
kotak[i].Top:=40+30*i;
kotak[i].Parent:=form1;
end;
end;
procedure isiedit;
var i:integer;
begin
for i:=1 to n do kotak[i].Text:=floattostr(x[i]);
end;
procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
begin
randomize;
stringgrid1.RowCount:=n;
stringgrid2.RowCount:=n;
stringgrid1.ColCount:=n+1;
stringgrid2.ColCount:=n+1;
for i:=1 to n do begin
for j:=1 to n+1 do begin
a[i,j]:=random(20)-10;
stringgrid1.Cells[j-1,i-1]:=floattostr(a[i,j]);
end;end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
bacamatrik;
naif;
subtitusi;
tulismatrik;
buatedit;
isiedit;
end;
end.
Pages
▼
Wednesday, June 4, 2014
[Delphi] Gauss Naif Method (just for self documentation)
Here the code
No comments:
Post a Comment