Приложение 1. Исходный код программы

Исходный код программы

uses Crt;

 

Const

N = 6;

 

Type

//матрица смежности

TAdMatrix = array [1..N, 1..N] of integer;

TLList = array [1..N] of boolean;

TIList = array [1..N] of integer;

Var

Gr: TAdMatrix;

MOT: TIList;

 

//чтение графа из файла

procedure OpenFile(ind: integer; var g: TAdMatrix);

Var

t: text;

i, j, tmp, m: integer;

Begin

assign(t, 'matrix.txt');

reset(t);

for m:=0 to ind do

for i:=1 to n do

for j:=1 to n do

Begin

read(t, tmp);

g[i,j]:=tmp;

end;

close(t);

end;

 

//нахождение короткого цикла

procedure Find_ShortLoop(g: TAdMatrix);

Var

Ch: boolean;

L: TLLIst;

ML: Integer;

MPath: string;

function Row_IsNul(g: TAdMatrix; Row: integer): boolean;

Begin

Result:=True;

for var i:=1 to N do if g[i, Row] <> 0 then Result:=False;

end;

function Col_IsNul(g: TAdMatrix; Col: integer): boolean;

Begin

Result:=True;

for var i:=1 to N do if g[Col, i] <> 0 then Result:=False;

end;

function Matrix_IsNul(g: TAdMatrix): boolean;

Begin

Result:=True;

for var i:=1 to N do if not Row_IsNul(g, i) then Result:=False;

end;

function Row_SetNul(var g: TAdMatrix; Row: integer): boolean;

Begin

Result:= not Row_IsNul(g, Row);

for var i:=1 to N do g[i, Row]:=0;

end;

function Col_SetNul(var g: TAdMatrix; Col: integer): boolean;

Begin

Result:= not Col_IsNul(g, Col);

for var i:=1 to N do g[Col, i]:=0;

end;

//функция возращает

function GetLoopLength(CurV, BaseV: integer; g: TAdMatrix; var L: TLList; CurLength: integer; CurPath: string; A: boolean): integer;

Begin

//если текущая вершина есть начальная вершина, то конец

if (CurV = BaseV) and (not A) then

Begin

IfCurLength < ML then

Begin

ML:=CurLength;

MPath:=CurPath;

end;

Result:=CurLength;

Exit;

end;

//если текущая вершина уже была посещена, то конец

IfL[CurV] then

Begin

Result:=-1;

Exit;

end;

//пометим текущую вершину как посещенную

L[CurV]:=True;

Result:=CurLength;

//перебираем все вершины, смежные с текущей

for var i:=1 to N do

Ifg[CurV, i] <> 0 then

if GetLoopLength(i, BaseV, g, L, CurLength + g[CurV, i], CurPath + '->' + IntToStr(i), false) > 0 then Result:=CurLength + g[CurV, i];

L[CurV]:=False;

end;

Begin

//удалим вершины, от которых циклы не зависят

Ch:=False;

Repeat

Ch:=False;

for var i:=1 to N do

Begin

if Row_IsNul(g, i) then Ch:=Col_SetNul(g, i);

if Col_IsNul(g, i) then Ch:=Row_SetNul(g, i);

end;

until not Ch;

IfMatrix_IsNul(g) then

Begin

writeln('Данный граф ацикличен');

Exit;

end;

//среди оставшихся вершин измеряем длину мнимального цикла

ML:=1000;

for var i:=1 to N do

If notRow_IsNul(g, i) then

GetLoopLength(i, i, g, L, 0, '', true);

delete(MPath, 1, 2);

write('Самый короткий цикл в графе: ', MPath);

writeln(', длина цикла: ', ML);

writeln('');

end;

 

//обход графа в глубину

procedure Share_Deep(g: TAdMatrix; a: integer);

Var

Visited: TLList;

Path: string;

function Row_IsVisited(g: TLList): boolean;

Begin

Result:=True;

for var i:=1 to N do if not g[i] then Result:=False;

end;

procedure DepthSearch(V: integer);

Begin

Path:=Path + '->' + IntToStr(V);

Visited[V]:=True;

for var i:=1 to N do

if (g[V, i] <> 0) and (not Visited[i]) then DepthSearch(i);

end;

Begin

DepthSearch(a);