точки..
PROGRAM F_i_x_C_o_n_t;
label Metka;
const MaxNodes = 5;
Stepen = 10;
type NodePtr = 1..MaxNodes;
Param = 1..Stepen;
Element = 0..1;
AdjMatrix = Array [NodePtr,NodePtr] of Element;
JoinAdj = Array [Param] of AdjMatrix;
var Adj : AdjMatrix; { Матрица смежностей }
AdjN : JoinAdj; { Массив степеней матрицы смежностей }
C : AdjMatrix; { Рабочий массив }
i,j,k: NodePtr; { Параметры циклов }
n,l,m: Param;
{ --------------------------------------------- }
PROCEDURE P_o_w_e_r (n: Integer; A: AdjMatrix;var C: AdjMatrix);
{ Матрица C получает значение n-й степени матрицы A }
var Z : AdjMatrix;
Val : Element;
i,j,k,m: Integer;
BEGIN
C:=A;
For m:=1 to n-1 do
begin
For i:=1 to MaxNodes do
For j:=1 to MaxNodes do
begin
Val:=0;
For k:=1 to MaxNodes do
Val:=Val OR (A[i,k] AND C[k,j]);
Z[i,j]:=Val
end;
C:=Z
end
END;
{ --- }
BEGIN
{ Ввод матрицы смежностей заданного графа }
WriteLn ('Вводите элементы матрицы смежностей по стро-кам:');
For i:= 1 to MaxNodes do
For j:= 1 to MaxNodes do
begin
Write ('Введите Adj[',i,',',j, ']: ');
ReadLn (Adj[i,j])
end;
{ Вычисление степеней матрицы смежностей }
For l:=1 to Stepen do
begin
P_o_w_e_r (l,Adj,C);
For i:= 1 to MaxNodes do
For j:= 1 to MaxNodes do AdjN [l,i,j]:=C[i,j]
end;
Write ('Вводите длину контура: '); ReadLn (n);
{ Отыскание контуров заданной длины }
For m:=2 to n do
begin
For i:=1 to MaxNodes do
If AdjN [m,i,i]=1
{ Вершина i принадлежит контуру длины n }
then
begin
if m=n then
begin
Write ('Вершина ',i,'образует контуры длины ',m, ' с вершинами из множества:{');
For j:=1 to MaxNodes do
begin
If AdjN[m,j,j]=1
{ Вершина j принадлежит }
{ контуру длины m }
then For l:=1 to m do
If (AdjN[l,i,j]=1) AND (m-l>0) AND (AdjN[m-l,j,i]=1)
then
begin
Write (j,' '); GoTo Metka
end;
Metka:
end;
WriteLn ('}')
end;
end;
WriteLn;
end;
readln;
END.
пример матрицы
0 0 1 1 0
0 0 0 1 1
1 0 0 0 1
1 1 0 0 0
0 1 1 0 0
длина цикла - 5