Поиск максимальной клики графа

program lab6;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  N = 5;

type
  TArray = array[1..N, 1..N] of Integer;
  TSet = set of 1..N;
  TCliq = array[1..100] of TSet;

const
  TestArr: TArray = ((0, 1, 0, 1, 0), (1, 0, 1, 0, 1), (0, 1, 0, 1, 0), (1, 0, 1, 0, 1), (0, 1, 0, 1, 0));

////////////////////////////////////////////////////
//                                                //
//    ВСЁ ЧТО КАСАЕТСЯ ВВОДА МАТРИЦЫ СМЕЖНОСТИ    //
//                                                //
////////////////////////////////////////////////////

procedure InputFromKeyboard(var A: TArray);

var
  i, j, x: Integer;

begin
  x := 2;
  for i := 1 to N - 1 do
    begin
      for j := x to N do
        begin
          Write('A[', i, '][', j, '] = ');
          Readln(A[i,j]);
          A[j, i] := A[i][j];
        end;
      Inc(x);
    end;

  for i := 1 to N do
    A[i][i] := 0;

  Writeln;
end;

procedure RandomInput(var A: TArray);

var
  i, j, k: Integer;

begin
  k := 2;
  for i := 1 to N - 1 do
    begin
      for j := k to N do
        begin
          Randomize;
          A[i,j] := Random(2);
          Writeln('A[', i, '][', j, '] = ', A[i,j]);
          A[j, i] := A[i][j];
        end;
      Inc(k);
    end;

  for i := 1 to N do
    A[i][i] := 0;

  Writeln;
end;

procedure Output(A: TArray);

var
  i, j: Integer;

begin
  for i := 1 to N do
    begin
      for j := 1 to N do
        Write(A[i][j], ' ');
      Writeln;
    end;
  Writeln;
end;

procedure SelectingEnthryMethod(var A: TArray);

var
  EnthryMethod: Integer;

begin
  Writeln('Please select array entry method:'); Writeln;
  Writeln('Enter ''1'' if you prefer random input.');
  Writeln('Enter ''2'' if you prefer input from keyboard.');
  Writeln('Enter ''3'' if you prefer input from constant.'); Writeln;
  Readln(EnthryMethod); Writeln;

  case EnthryMethod of
    1: RandomInput(A);
    2: InputFromKeyboard(A);
    3: begin A := TestArr; Writeln; end;
  end;
end;

////////////////////////////////////////////////////
//                                                //
//             ДЕЙСТВИЯ НАД МАССИВАМИ             //
//                                                //
////////////////////////////////////////////////////

function SetUnion(A, B: TSet): TSet;

begin
  SetUnion := A + B;
end;

function SetIntersection(A, B: TSet): TSet;

begin
  SetIntersection := A * B;
end;

function SetDifference(A, B: TSet): TSet;

begin
  SetDifference := A - B;
end;

////////////////////////////////////////////////////
//                                                //
//     ПРОЦЕДУРЫ ДЛЯ АЛГОРИТМА БРОНА-КЕРБОША      //
//                                                //
////////////////////////////////////////////////////

procedure IsClique(C: TSet; A, B: TSet; var CliqueArray: TCliq);

var
  i: Integer;

begin
  if (A = []) and (B = []) then
    begin
      i := 1;
      while CliqueArray[i] <> [] do
        Inc(i);
      CliqueArray[i] := C;
    end;
end;

function Neighbours(v0: Integer; M: TArray): TSet;

var
  A: TSet;
  d: Integer;

begin
  A := [];
  for d := 1 to N do
    if M[d, v0] = 1 then
      A := A + [d];
  Neighbours := A;
end;

////////////////////////////////////////////////////
//                                                //
//           АЛГОРИТМ БРОНА-КЕРБОША               //
//                                                //
////////////////////////////////////////////////////

procedure BronKerbosh(R: TSet; P: Tset; X: TSet; M: TArray; var ExternalCliqueArr: TCliq);

var
  v: Integer;

begin
  IsClique(R, P, X, ExternalCliqueArr);
  for v := 1 to N do if v in P then
    begin
      BronKerbosh(SetUnion(R, [v]), SetIntersection(P, Neighbours(v, M)), SetIntersection(X, Neighbours(v, M)), M, ExternalCliqueArr);
      P := P - [v];
      X := X + [v];
    end;
end;

////////////////////////////////////////////////////
//                                                //
//    Поиск максимальных клики среди найденных    //
//                                                //
////////////////////////////////////////////////////

procedure CliqueOutput(A: TSet);

var
  q: Integer;

begin
  for q := 1 to N do if q in A then
    Write(q, ' ');
  Writeln;
end;

function CliqSize(A: TSet): Integer;

var
  i, t: Integer;

begin
  t := 0;
  for i := 1 to N do if i in A then
    Inc(t);
  CliqSize := t;
end;

function MaxSz(CliqArray: TCliq): Integer;

var
  Max, i: Integer;

begin
  Max := 0;
  i := 1;
  while (i <= 100) and (CliqArray[i] <> []) do
    begin
      if (CliqSize(CliqArray[i]) > Max) then
        Max := CliqSize(CliqArray[i]);
      Inc(i);
    end;
  MaxSz := Max;
end;

procedure MaxCliquesOutput(CliqueArray: TCliq);

var
  g: Integer;

begin
  for g := 1 to 100 do if CliqSize(CliqueArray[g]) = MaxSz(CliqueArray) then
    CliqueOutput(CliqueArray[g]);
end;

////////////////////////////////////////////////////
//                                                //
//              ОСНОВНАЯ ПРОГРАММА                //
//                                                //
////////////////////////////////////////////////////

var
  Matrix: TArray;
  CompSub, Candidates, NotCandidates: TSet;
  CliqueArray0: TCliq;
  g: Integer;

begin
  SelectingEnthryMethod(Matrix);
  Output(Matrix);

  CompSub := [];
  NotCandidates := [];
  Candidates := [1..N];
  for g := 1 to 100 do
    CliqueArray0[g] := [];

  BronKerbosh(CompSub, Candidates, NotCandidates, Matrix, CliqueArray0);

  MaxCliquesOutput(CliqueArray0);

  Readln;
end.