Алгоритм определения матрицы транзитивного замыкания бинарного отношения.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Grids, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Edit1: TEdit;

StringGrid1: TStringGrid;

StringGrid2: TStringGrid;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var h:integer;

begin

h:=strtoint(Edit1.Text);

h:=h+1;

StringGrid1.Colcount:=h;

StringGrid1.Rowcount:=h;

StringGrid2.Colcount:=h;

StringGrid2.Rowcount:=h;

end;

procedure TForm1.Button2Click(Sender: TObject);

var a:array[1..100,1..100] of integer ;

b:array[1..100,1..100] of integer ;

c:array[1..100,1..100] of integer ;

h,i,j,k,z:integer;

begin

z:=0;

h:=strtoint(Edit1.text);

For i:=1 to h do begin

For j:=1 to h do begin

a[i,j]:= strtoint(StringGrid1.Cells[i,j]);

end;

end;

For i:=1 to h do begin

For j:=1 to h do begin

c[i,j]:=a[i,j];

b[i,j]:=a[i,j];

end;

end;

while z=0 do begin

For i:=1 to h do begin

For j:=1 to h do begin

For k:=1 to h do begin

If (a[i,k]*b[k,j])=1 then begin b[i,j]:=1; break; end;

end;

If c[i,j]>=b[i,j] then z:=1 else z:=0;

end;

end;

For i:=1 to h do begin

For j:=1 to h do begin

If (c[i,j]=0) and (b[i,j]=1) then c[i,j]:=b[i,j];

end;

end;

end;

For i:=1 to h do begin

For j:=1 to h do begin

StringGrid2.Cells[i,j]:=inttostr(c[i,j]);

end;

end;

end;

end.