SIgor33
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
mozgabyte
не знаю твой это случай или нет (граф гамильтонов цикл)но вот тебе программка (валялась у меня) там что то про твой случай
program Gamilton;
const n=10;
var
v0:integer:=2;
a:array[0..n-1, 0..n-1] of integer:=(
(0,0,0,0,0,1,0,0,0,0),
(0,0,0,0,0,0,1,0,0,0),
(0,1,0,1,0,0,0,1,0,0),
(0,0,1,0,1,0,0,0,1,0),
(1,0,0,1,0,0,0,0,0,1),
(0,0,0,0,0,0,1,0,0,1),
(0,0,0,1,0,0,0,1,0,0),
(0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,0,0,0,0,1),
(0,0,0,0,0,0,0,0,0,0));
c:array[0..n-1] of integer;
path:array[0..n-1] of integer;
procedure print_gamilton_c();
var
p:integer;
begin
for p:=0 to n-1 do write(inttostr(path[p])+' ');
writeLn(inttostr(path[0]));
end;
function gamilton(k:integer):integer;
var
v,gl:integer;
begin
gl:=0;
v:=-1;
while ((v<n-1) and (gl=0)) do begin
inc(v);
if (a[v,path[k-1]]>0) or (a[path[k-1],v]>0) then begin
if (k=n) and (v=v0) then gl:=1
else if (c[v]=-1) then begin
c[v]:=k;
path[k]:=v;
gl:=gamilton(k+1);
if (gl=0) then c[v]:=-1;
end else continue;
end;
end;
result:=gl;
end;
var
j:integer;
begin
writeln('Гамильтонов цикл:');
for j:=0 to n-1 do c[j]:=-1;
path[0]:=v0;
c[v0]:=v0;
if (gamilton(1)>0) then print_gamilton_c else writeln('цикл не найден - нет решений');
end.
|
