Полностью согласен с MrD , что для положительного ответа
во всех случаях, необходимо перебрать N! способов обозначить вершины. (частные эвристики способны во многтх ситуациях
облегчить ответ, однако не способны его полностью исчерпать)
Приведу алгоритм на Delphi;(для графов имеющих 10 вершин)
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
Const
N=10;
type
Graf=array[1..n,1..n] of byte;
Vect=array[1..N] of byte;
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Per:vect;
G1,G2:Graf;
implementation
{$R *.dfm}
Procedure PolnGraf;
var i,j:byte;
Begin
randomize;
for i:=1 to n do begin
for j:=1 to n do begin
{G1[i,j]:=random(2);
G2[i,j]:=random(2);{}
//if i=j then begin G1[i,j]:=1;G2[i,j]:=1;end else begin G1[i,j]:=0;G2[i,j]:=0;end;
G1[i,j]:=0;G2[i,j]:=0;
//G2[i,j]:=G1[i,j];
end;
end;
//G1[3,7]:=1;
j:=random(11);
i:=random(11);
G1[i,j]:=1;
j:=random(11);
i:=random(11);
If (j=0)or (j=6) then j:=4;
G2[j,i]:=1;
{G1[6,7]:=1;
G2[4,8]:=G1[6,7];
{for j:=1 to n do begin
G2[5,j]:=G2[7,j];
G2[7,j]:=G1[5,j];
end;{}
end;
function ProverkaTopologii(l:byte):boolean;
Label 1;
var i,j:byte;
b:boolean;
Begin
b:=true;
for i:=1 to l do begin
for j:=1 to l do begin
if G1[i,j]<>G2[Per[i],Per[j]] then begin
b:=false; goto 1;end;
end;end;
1:
ProverkaTopologii:=b;
end;
Procedure Perestanovka10;
Label 2,1;
var i1,i2,i3,i4,i5,i6,i7,i8,i9,i10:byte;
t:longint;
Begin
t:=0;
for i1:=1 to N do begin Per[1]:=i1; for i2:=1 to N do begin if i1<>i2 then begin Per[2]:=i2; for i3:=1 to n do begin if (I3<>i1) and (I3<>i2) then
begin Per[3]:=i3; for i4:=1 to n do begin if (i4<>i3)and(i4<>i2)and(i4<>i1) then begin Per[4]:=i4; for i5:=1 to n do
begin if (i5<>i1)and(i5<>i2)and(i5<>i3)and(i5<>i4) then begin Per[5]:=I5; for i6:=1 to n do begin if (i6<>i1)and(i6<>i2)and(i6<>i3)and(i6<>i4) and(i6<>i5) then
begin Per[6]:=I6;for i7:=1 to n do begin if (i7<>i1)and(i7<>i2)and(i7<>i3)and(i7<>i4) and(i7<>i5)and(i7<>i6) then begin Per[7]:=I7; for i8:=1 to n do
begin if (i8<>i1)and(i8<>i2)and(i8<>i3)and(i8<>i4) and(i8<>i5)and(i8<>i6)and(i8<>i7) then begin Per[8]:=I8; for i9:=1 to n do begin if (i9<>i1)and(i9<>i2)and(i9<>i3)and(i9<>i4) and(i9<>i5)and(i9<>i6)and(i9<>i7)and(i9<>i8) then
begin Per[9]:=I9;for i10:=1 to n do begin if (i10<>i1)and(i10<>i2)and(i10<>i3)and(i10<>i4) and(i10<>i5)and(i10<>i6)and(i10<>i7)and(i10<>i8)and(i10<>i9) then begin
Per[10]:=I10;
if ProverkaTopologii(n)=true then begin t:=1;goto 2;end;
{Per[10]:=I10;
t:=t+1;
if t=2000000 then begin
Per[10]:=I10;
end;{}
end;end;end;end;end;end;end;end;end;end;end;end;end;end;end;end;end;end;end;
showmessage('Ãðàôû íå èçîìîðôíû');goto 1;
2:for i1:=1 to N do form1.Edit1.Text:=form1.Edit1.Text+' I('+inttostr(i1)+')='+inttostr(Per[i1])+' ,';
1:
end;//êîíåö ïðîöåäóðû
procedure TForm1.Button1Click(Sender: TObject);
begin
form1.Edit1.Text:='';
PolnGraf;
Perestanovka10;
end;
end.