Задача об изоморфизме графов (попытка решения)

Задача:
Даны два графа (ориентированные или неориентированные). Требуется определить, являются ли эти графы изоморфными. (Два графа считаются изоморфными, если они одинаковы и различаются лишь нумерацией вершин).

Прежде всего, отметим, что задачу следует решать для графов, в которых одинаковое количество вершин и ребер, в противном случае результат решения заранее будет отрицательным.
Данный метод решения задачи основан на приведении матриц смежности графов к определенному «состоянию», после чего равенство матриц говорит об изоморфизме данных графов.
Чтобы подойти к конечному «состоянию» матрицы смежности, в ней проводится три последовательных сортировки:
1. Первая сортировка в матрице смежности позволяет объединить в группы вершины по возрастанию количества исходящих ребер. Теперь каждая вершина принадлежит своей группе и не может быть помещена за ее пределы.
2. Вторая сортировка устанавливает отношение порядка между вершинами внутри каждой группы за счет их связей со смежными вершинами.
3. Последняя сортировка позволяет определить окончательное соответствие между вершинами, если таковое не было достигнуто первыми двумя пунктами.
Чтобы данный метод мог быть применен без опасений к ориентированным графам, с этой целью каждое ребро между вершинами графа дополняется обратным («мнимым») в случае его отсутствия. В матрице смежности такое ребро обозначается “–1”, чтобы его можно было отличить от действительных ребер.

Для реализации потребуются следующие структуры:

const nmax=50;
type Tstr = string[nmax];
Trow = record
num:byte;
cnt:byte;
lin:Tstr;
row:array[1..nmax] of shortint;
end;
Tgr = array[1..nmax] of trow;

Var A:array[1..2] of tgr;
n:byte;

Тип Trow содержит поля: num – номер вершины в исходном графе; cnt – количество ребер, исходящих из вершины; lin – характеризует вершины, смежные данной; row – строка матрицы смежности, показывающая исходящие ребра из вершины. Тип Tgr полностью описывает граф и его вершины.
Массив A содержит две матрицы смежности сравниваемых графов, n – количество вершин в каждом графе.

Процедура Init производит ввод данных из файла с подсчетом количества исходящих ребер для каждой вершины.

procedure init;
var j,i,m:integer;
begin
fillchar(a,sizeof(a),0);
readln(n);
for m:=1 to 2 do
for i:=1 to n do
begin
while not eoln do
begin
read(j);
a[m][i].row[j]:=1;
inc(a[m][i].cnt)
end;
a[m][i].num:=i;
readln;
end;
end;

Процедура Addition дополняет граф до неориентированного, если это требуется, производит пересчет количества смежных вершин и заменяет единицы в матрице смежности на числа, равные количеству смежных вершин у той вершины, в которую идет ребро из данной вершины. Знак “–“ у «мнимых» ребер сохраняется.

procedure Addition;
var m,i,j:integer;
begin
for m:=1 to 2 do
begin
for j:=1 to n do
for i:=j to n do
if abs(a[m][i].row[j])<>abs(a[m][j].row[i]) then
if a[m][i].row[j]=0 then
begin
inc(a[m][i].cnt);
a[m][i].row[j]:=-1;
end
else
begin
inc(a[m][j].cnt);
a[m][j].row[i]:=-1;
end;
for j:=1 to n do
for i:=1 to n do
a[m][i].row[j]:=a[m][i].row[j]*a[m][j].cnt;
end;
end;

Функция Lin в графе с номером m для вершины i подсчитывает ее характеристику, состоящую из элементов строки матрицы смежности без нулей. Выбор строкового типа для lin объясняется тем, что строковые переменные имеют свои особенности сравнения и установления отношения порядка.
function Lin(m,i:byte):tstr;
var j:byte;
st:tstr;
begin
st:='';
for j:=1 to n do
if a[m][i].row[j]<>0 then
st:=st+chr(abs(a[m][i].row[j]));
lin:=st;
end;

Функция Less в графе m для вершин с номерами r1 и r2 с одинаковыми характеристиками lin устанавливает отношение порядка по строкам матрицы смежности.

function Less(m,r1,r2:byte):boolean;
var i,sh:byte;
ok:boolean;
begin
i:=0;
repeat
inc(i);
if (i=r2)and(a[m][r1].row[i]=a[m][r2].row[i+1]) then inc(i,2);
until (i>n)or (a[m][r1].row[i]<>a[m][r2].row[i]);
if i=r2 then sh:=1 else sh:=0;
if i<=n then ok:=a[m][r1].row[i]>a[m][r2].row[i+sh]
else ok:=false;
less:=ok;
end;

Процедура Transp в графе m выполняет перенумерацию вершин с номерами r1 и r2. Для равноценного преобразования необходимо поменять местами строки и столбцы с данными номерами.

procedure Transp(m,r1,r2:byte);
var i,s:shortint;
w:trow;
begin
w:=a[m][r1];
a[m][r1]:=a[m][r2];
a[m][r2]:=w;
for i:=1 to n do
begin
s:=a[m][i].row[r1];
a[m][i].row[r1]:=a[m][i].row[r2];
a[m][i].row[r2]:=s;
end;
end;

Процедура Sort выполняет три выше обозначенных пункта сортировки в матрицах смежности сравниваемых графов: первая сортировка по значению cnt; вторая сортировка по значению lin; третья сортировка по возвращаемому значению функции less.

procedure Sort;
var m,i,j,s,e:byte;
begin
for m:=1 to 2 do
begin

{1-й блок}
for i:=n downto 2 do
for j:=2 to i do
if a[m][j].cnt transp(m,j,j-1);

for i:=1 to n do
a[m][i].lin:=lin(m,i);

{2-й блок}
e:=1;
repeat
s:=e;
while a[m][e].cnt=a[m][s].cnt do
inc(e);
for i:=e-1 downto s+1 do
for j:=s+1 to i do
if a[m][j].lin transp(m,j-1,j);
until e>n;

{3-й блок}
for i:=n downto 2 do
for j:=2 to i do
if a[m][j].lin=a[m][j-1].lin then
if less(m,j,j-1) then
transp(m,j-1,j);

end;
end;

Процедура сравнения матриц смежности по завершению сортировки. В случае изоморфизма графов выводится соответствие вершин первого и второго графов.

procedure Compare;
var i,j:integer; ok:boolean;
begin
ok:=true;
for i:=1 to n do
for j:=1 to n do
if a[1][i].row[j]<>a[2][i].row[j] then ok:=false;
if ok then
for i:=1 to n do
writeln(a[1][i].num,' - ',a[2][i].num)
else writeln('Not possible');
end;
Процедура Solve :

procedure Solve;
begin
addition;
sort;
compare;
end;
Таким образом, получается, что временная сложность алгоритма пропорциональна N