Поиск целей, циклов в орграфе

program Project11;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  Windows;
 
type mas = array[1..10] of integer;
     matrix=array[1..10] of mas;
     zepi= array[1..100] of mas;
 
var
   TZEP,TZIK: mas;
   MS,MD,ind: matrix;
   MZEP,MPZEP,MZIK,MPZIK: zepi;
   i,j,n,KZEP,m,KPZEP,KZIK,KPZIK: integer;
 
 
procedure SZEP(KV: integer; var ind: matrix; var TZ: mas; var PZ: zepi);
var i,j,t: integer;
begin
     if KV=0 then
        for i:=1 to n do
        begin
             TZ[1]:=i;
             SZEP(1,ind,TZ,PZ);
        end
     else if KV=m+1 then
     begin
          if TZ[1]<>TZ[KV] then begin
             KZEP:=KZEP+1;
             PZ[KZEP]:=TZ;
          end
     end
     else begin
          for i:=1 to n do
              if (ind[TZ[KV],i]=0) and (MS[TZ[KV],i]=1) then
              begin
                   TZ[KV+1]:=i;
                   ind[TZ[KV],i]:=1;
                   SZEP(KV+1,ind,TZ,PZ);
                   ind[TZ[KV],i]:=0;
              end;
     end;
end;
 
procedure SZIK(KV: integer; var ind: matrix; var TZ: mas; var PZ: zepi);
var i,j,t: integer;
begin
     if KV=0 then
        for i:=1 to n do
        begin
             TZ[1]:=i;
             SZIK(1,ind,TZ,PZ);
        end
     else if KV=m+1 then
     begin
          if TZ[1]=TZ[KV] then begin
             KZIK:=KZIK+1;
             PZ[KZIK]:=TZ;
          end
     end
     else begin
          for i:=1 to n do
              if (ind[TZ[KV],i]=0) and (MS[TZ[KV],i]=1) then
              begin
                   TZ[KV+1]:=i;
                   ind[TZ[KV],i]:=1;
                   SZIK(KV+1,ind,TZ,PZ);
                   ind[TZ[KV],i]:=0;
              end;
     end;
end;
 
procedure SPZEP(K: integer; ZEP: zepi; var KP: integer; var PZEP: zepi);
var i,j,t,f: integer;
begin
     for i:=1 to K do
     begin
          f:=0;
          for j:=1 to m do
              for t:=j+1 to m+1 do
                  if ZEP[i,j]=ZEP[i,t] then f:=1;
          if f=0 then begin
             KP:=KP+1;
             PZEP[KP]:=ZEP[i];
          end;
     end;
end;
 
procedure SPZIK(K: integer; ZIK: zepi; var KP: integer; var PZIK: zepi);
var i,j,t,f: integer;
begin
     for i:=1 to K do
     begin
          f:=0;
          for j:=1 to m-1 do
              for t:=j+1 to m do
                  if ZIK[i,j]=ZIK[i,t] then f:=1;
          if f=0 then begin
             KP:=KP+1;
             PZIK[KP]:=ZIK[i];
          end;
     end;
end;
 
begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
     write('Введите количество вершин орграфа*, n=');
     readln(n);
     writeln('Ввод матрицы смежности орграфа*:');
     writeln('Если вершина y достижима из вершины x, то ввести 1, иначе 0');
     for i:=1 to n do
         for j:=1 to n do
              if i<>j then begin
                 write('MS[',i,',',j,']=');
                 readln(MS[i,j]);
              end;
     write('Введите количество ребер для циклов и цепей, m=');
     readln(m);
     for i:=1 to n do
         for j:=1 to n do
             ind[i,j]:=0;
     SZEP(0,ind,TZEP,MZEP);
     SPZEP(KZEP,MZEP,KPZEP,MPZEP);
     for i:=1 to n do
         for j:=1 to n do
             ind[i,j]:=0;
     SZIK(0,ind,TZIK,MZIK);
     SPZIK(KZIK,MZIK,KPZIK,MPZIK);
     writeln;
     writeln('Количество цепей -  ',KZEP);
     writeln;
     writeln('Вывод цепей:');
     for i:=1 to KZEP do
     begin
          write('Цепь №',i,': ');
          for j:=1 to m+1 do
              if j=1 then write(MZEP[i,j]) else write('-',MZEP[i,j]);
          writeln(';');
     end;
     readln;
     writeln('Количество простых цепей -  ',KPZEP);
     writeln;
     writeln('Вывод цепей:');
     for i:=1 to KPZEP do
     begin
          write('Простая цепь №',i,': ');
          for j:=1 to m+1 do
              if j=1 then write(MPZEP[i,j]) else write('-',MPZEP[i,j]);
          writeln(';');
     end;
     readln;
     writeln('Количество циклов - ',KZIK);
     writeln;
     writeln('Вывод циклов:');
     for i:=1 to KZIK do
     begin
          write('Цикл №',i,': ');
          for j:=1 to m+1 do
              if j=1 then write(MZIK[i,j]) else write('-',MZIK[i,j]);
          writeln(';');
     end;
     readln;
     writeln('Количество простых циклов - ',KPZIK);
     writeln;
     writeln('Вывод простых циклов:');
     for i:=1 to KPZIK do
     begin
          write('Простой цикл №',i,': ');
          for j:=1 to m+1 do
              if j=1 then write(MPZIK[i,j]) else write('-',MPZIK[i,j]);
          writeln(';');
     end;
     readln;
     readln;
end.