Nugroho's blog.: "Auto" Gauss Naif in Delphi.

Thursday, April 27, 2017

"Auto" Gauss Naif in Delphi.



After do this in Python, now it's time to bring it back to Delphi, where all of this is started, :)


The heart of code lay on this one

procedure tform1.gauss;
var i,j,k:integer; temp:real;
begin
  for i:=1 to 9 do begin
    for j:= 1 to i do begin
      if t[i,j]<>0 then begin
        temp:=t[i,j];
        for k:= 1 to 10 do begin
          if i=j then
            t[j,k]:=t[j,k]/temp
              else t[i,k]:=t[i,k]/temp - t[j,k];
        end;
      end;
    end;
  end;
  //back subtitution
  for i:=9 downto 1 do begin
    x[i]:=t[i,10];
    for j:=9  downto i do begin
      if i<>j then
        x[i]:=x[i]-x[j]*t[i,j];
    end;
  end;



You could say that it consists of zeroing lower tringle and normalizing the diagonal and then subtituting the value.

There's little failsafe code here, that is if we already have zero cell, don't proceed, or it will gave divided by zero error.




The rest of the code is here.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    Button1: TButton;
    procedure bacaMatrik;
    procedure gauss;
    procedure tulisMatrik;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  t:array[1..9,1..10]of real;
  x:array[1..9]of real;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
begin
  for i:=1 to 9 do begin
    x[i]:=0;
    for j:=1 to 9 do begin
      t[i,j]:=0;
    end;
  end;
  for i:=1 to 9 do begin
    for j:=1 to 9 do begin
      if i=j then begin
        t[i,j]:=-2;
        if j<>1 then t[i,j-1]:=1;
        if j<>9 then t[i,j+1]:=1;
      end;
    end;
    t[i,10]:=1;
  end;
  t[1,10]:=1-100;
  t[9,10]:=1-25;

  tulisMatrik;
end;
procedure tform1.bacaMatrik;
var i,j:integer;
begin
  for i:=1 to 9 do begin
    for j:=1 to 10 do begin
      t[i,j]:=strToFloat(stringgrid1.Cells[j-1,i-1]);
    end;
  end;

end;
procedure tform1.tulisMatrik;
var i,j:integer;
begin
  for i:=1 to 9 do begin
    stringgrid2.Cells[i,0]:=floatToStr(x[i]);
    for j:=1 to 10 do begin
      stringgrid1.Cells[j-1,i-1]:=floatTostr(t[i,j]);
    end;
  end;
  stringgrid2.Cells[0,0]:='100';
  stringgrid2.Cells[10,0]:='25';

end;

procedure tform1.gauss;
var i,j,k:integer; temp:real;
begin
  for i:=1 to 9 do begin
    for j:= 1 to i do begin
      if t[i,j]<>0 then begin
        temp:=t[i,j];
        for k:= 1 to 10 do begin
          if i=j then
            t[j,k]:=t[j,k]/temp
              else t[i,k]:=t[i,k]/temp - t[j,k];
        end;
      end;
    end;
  end;
  //subtitusi balik
  for i:=9 downto 1 do begin
    x[i]:=t[i,10];
    for j:=9  downto i do begin
      if i<>j then
        x[i]:=x[i]-x[j]*t[i,j];
    end;
  end;

end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  bacaMatrik;
  Gauss;
  tulisMatrik;
end;

end.
.

No comments:

323f (5) amp (1) android (12) apple (7) arduino (18) art (1) assembler (21) astina (4) ATTiny (23) blackberry (4) camera (3) canon (2) cerita (2) computer (106) crazyness (11) debian (1) delphi (39) diary (286) flash (8) fortran (6) freebsd (6) google apps script (8) guitar (2) HTML5 (10) IFTTT (7) Instagram (7) internet (12) iOS (5) iPad (6) iPhone (5) java (1) javascript (1) keynote (2) LaTeX (6) lazarus (1) linux (29) lion (15) mac (28) macbook air (8) macbook pro (3) macOS (1) Math (3) mathematica (1) maverick (6) mazda (4) microcontroler (35) mountain lion (2) music (37) netbook (1) nugnux (6) os x (36) php (1) Physicist (29) Picture (3) programming (189) Python (109) S2 (13) software (7) Soliloquy (125) Ubuntu (5) unix (4) Video (8) wayang (3) yosemite (3)