matclass.pas

对矩阵这种数据结构进行变换

unit MatClass;

interface

type
  //关系矩阵类
  TRelMatrix = class
  private
    FCol: integer;
    FRow: integer;

  public
    Matrix: array of array of 0..1;

    property Col: integer read FCol;
    property Row: integer read FRow;

    constructor Create(Row, Col: integer);

    function IsReflexive: boolean;           //自反
    function IsIrreflexive: boolean;         //反自反
    function IsSymmetric: boolean;           //对称
    function IsAsymmetric: boolean;          //非对称
    function IsAntisymmetric: boolean;       //反对称
    function IsTransitive: boolean;          //传递
    function IsEquivalence: boolean;         //等价
    function IsCompatibility: boolean;       //相容
    function IsPartialOrder: boolean;        //偏序
    function IsQuasiOrder: boolean;          //拟序

    function Complement: TRelMatrix;         //互补关系
    function Invertion: TRelMatrix;          //逆关系

    function Identity: TRelMatrix;           //单位矩阵
    function BoolAdd(Mat: TRelMatrix): TRelMatrix;   //布尔加
    function BoolMul(Mat: TRelMatrix): TRelMatrix;   //布尔乘

    function ReflexiveClosure: TRelMatrix;        //自反闭包
    function SymmetricClosure: TRelMatrix;        //对称闭包
    function TransitiveClosure: TRelMatrix;       //传递闭包
  end;

implementation

constructor TRelMatrix.Create(Row, Col: integer);
begin
  FCol:=Col;
  FRow:=Row;
  SetLength(Matrix, Row, Col);
end;

function TRelMatrix.IsReflexive: boolean;
var
  i, j: integer;
  IsEmpty: boolean;
begin
  if FCol<>FRow then
  begin
    result:=false;
    exit;
  end;

  IsEmpty:=true;
  result:=true;
  for i:=0 to FRow-1 do
    for j:=0 to FCol-1 do
    begin
      if Matrix[i, j]<>0 then
      begin
        IsEmpty:=false;
        break;
      end;
    end;
  if IsEmpty then exit;

  for i:=0 to FRow-1 do
  begin
    if Matrix[i, i]=0 then
    begin
      result:=false;
      break;
    end;
  end;
end;

function TRelMatrix.IsIrreflexive: boolean;   
var
  i: integer;
begin
  if FCol<>FRow then
  begin
    result:=false;
    exit;
  end;

  result:=true;
  for i:=0 to FRow-1 do
  begin
    if Matrix[i, i]=1 then
    begin
      result:=false;
      break;
    end;
  end;
end;

function TRelMatrix.IsSymmetric: boolean;   
var
  i, j: integer;
begin
  if FCol<>FRow then
  begin
    result:=false;
    exit;
  end;

  result:=true;
  for i:=1 to FRow-1 do
    for j:=0 to i-1 do
    begin
      if Matrix[i, j]<>Matrix[j, i] then
      begin
        result:=false;
        break;
      end;
    end;
end;

function TRelMatrix.IsAsymmetric: boolean;
var
  i, j: integer;
begin
  if FCol<>FRow then
  begin
    result:=false;
    exit;
  end;

  result:=true;
  for i:=0 to FRow-1 do
    for j:=0 to i do
    begin
      if Matrix[i, j]*Matrix[j, i]<>0 then
      begin
        result:=false;
        break;
      end;
    end;
end;

function TRelMatrix.IsAntisymmetric: boolean;   
var
  i, j: integer;
begin
  if FCol<>FRow then
  begin
    result:=false;
    exit;
  end;

  result:=true;
  for i:=1 to FRow-1 do
    for j:=0 to i-1 do
    begin
      if Matrix[i, j]*Matrix[j, i]<>0 then
      begin
        result:=false;
        break;
      end;
    end;
end;

function TRelMatrix.IsTransitive: boolean;   
var
  i, j, k: integer;
begin
  if FCol<>FRow then
  begin
    result:=false;
    exit;
  end;

  result:=true;
  for i:=1 to FRow-1 do
    for j:=0 to FCol-1 do
    begin
      if Matrix[i, j]=1 then
        for k:=0 to FCol-1 do
        begin
          if (Matrix[j, k]=1) and (Matrix[i, k]=0) then
          begin
            result:=false;
            exit;
          end;
        end;
    end;
end;

function TRelMatrix.IsEquivalence: boolean;
begin
  result:=IsReflexive and IsSymmetric and IsTransitive;
end;

function TRelMatrix.IsCompatibility: boolean;
begin
  result:=IsReflexive and IsTransitive;
end;

function TRelMatrix.IsPartialOrder: boolean;
begin
  result:=IsReflexive and IsAntisymmetric and IsTransitive;
end;

function TRelMatrix.IsQuasiOrder: boolean;
begin
  result:=IsIrreflexive and IsTransitive;
end;

function TRelMatrix.Complement: TRelMatrix;
var
  CompleMat: TRelMatrix;
  i, j: integer;
begin
  CompleMat:= TRelMatrix.Create(FRow, FCol);
  for i:= 0 to FRow-1 do
    for j:= 0 to FCol-1 do
    begin
      CompleMat.Matrix[i, j]:= 1- Matrix[i, j];
    end;
  result:= CompleMat;
end;

function TRelMatrix.Invertion: TRelMatrix;
var
  InverseMat: TRelMatrix;
  i, j: integer;
begin
  InverseMat:= TRelMatrix.Create(FCol, FRow);
  for i:= 0 to FRow-1 do
    for j:= 0 to FCol-1 do
    begin
      InverseMat.Matrix[j, i]:= Matrix[i, j];
    end;
  result:= InverseMat;
end;

function TRelMatrix.Identity: TRelMatrix;
var
  id: TRelMatrix;
  i: integer;
begin
  result:=nil;
  if FCol<>FRow then exit;
  id:= TRelMatrix.Create(FRow, FCol);
  for i:=0 to FRow-1 do
  begin
    Matrix[i, i]:=1;
  end;
  result:=id;
end;

function TRelMatrix.BoolAdd(Mat: TRelMatrix): TRelMatrix;
var
  i, j: integer;
begin
  result:=nil;
  if (FCol<>Mat.Col) or (FRow<>Mat.Row) then exit;
  result:= TRelMatrix.Create(FRow, FCol);
  for i:=0 to FRow-1 do
    for j:=0 to FCol-1 do
    begin
      if (Matrix[i, j]=1) or (Mat.Matrix[i, j]=1) then
        result.Matrix[i,j]:=1;
    end;
end;

function TRelMatrix.BoolMul(Mat: TRelMatrix): TRelMatrix;
var
  i, j: integer;
  {--------function entry----------}
  function entry(i, j: integer): byte;
  var
    k, s: integer;
  begin
    s:=0;
    for k:=0 to FCol-1 do
    begin
      s:=s + Matrix[i, k]* Mat.Matrix[k, j]
    end;
    if s<>0 then result:=1
    else result:=0;
  end;         
  {------------end------------}
begin
  result:=nil;
  if FCol<>Mat.Row then exit;
  result:= TRelMatrix.Create(FRow, Mat.Col);
  for i:=0 to FRow-1 do
    for j:=0 to Mat.Col-1 do
    begin
      if (Matrix[i, j]=1) or (Mat.Matrix[i, j]=1) then
        result.Matrix[i,j]:=entry(i,j);
    end;
end;

function TRelMatrix.ReflexiveClosure: TRelMatrix;
begin
  result:=nil;
  if FCol<>FRow then exit;
  result:= Self.BoolAdd(Self.Identity);
end;

function TRelMatrix.SymmetricClosure: TRelMatrix;
begin
  result:=nil;
  if FCol<>FRow then exit;
  result:= Self.BoolAdd(Self.Invertion);
end;

function TRelMatrix.TransitiveClosure: TRelMatrix;  
var
  i, j, k: integer;
begin
  result:=nil;
  if FCol<>FRow then exit;
  result:=Self;
  
  //Warshall
  for j:= 0 to FCol-1 do
    for i:= 0 to FRow-1 do
      if Matrix[i, j]=1 then
        for k:=0 to FCol-1 do
          if (Matrix[i, k]=1) or (Matrix[j, k]=1) then Matrix[i, k]:=1;
end;

end.