Wednesday, June 4, 2014

[Delphi] Gauss Naif Method (just for self documentation)

Here the code



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.