VPF::И сново о Гамильтоновых графах

IvanoffAndrey

Дата 14.10.2006, 21:54 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 157
Регистрация: 8.7.2006
Где: СГАУ

Репутация: нет
Всего: 2

Здравствуйте.
Работаю в области изображения графов.
Встала задача найти в нем гамильтонов цикл.
Ниже представлена программа на паскале ищущая все Г.Ц. в графе.

Код


program All_HCP;
const MaxVer=30;
type
  t=1..60;
  a=set of t;

var
     New:boolean;
     AdjMat: array [1..MaxVer,1..MaxVer]of BOOLEAN;
     Stack:array[1..MaxVer] of integer;
     f_out:text;
     i,j,n:integer;
     SET1:a;
     y,y1:char;
     name,name1:string;

Procedure ENTER;
var
   f_input:text;
   w: char;
   Ass:string;
   i1,j1,k: integer;
   f_konec:boolean;
   s:string[11];
begin
   if ParamCount>=1 then name:=ParamStr(1) else
   begin
    Write('Enter input File: ');
    readln(name);
   end;
   assign(f_input,name);
   {$I-}reset(f_input);{$I+}
   If IOResult <>0 then
   begin
       writeln('Error hile opening file: ',name);
       Halt(1);
   end;

   for i:=1 to MaxVer do
     for j:=1 to MaxVer do
       AdjMat[i,j]:=false;


   i:=1;
     readln(f_input);
     readln(f_input);
     readln(f_input);
     readln(f_input,s,N);
     readln(f_input);
     readln(f_input);
     k:=1;
     f_konec:=false;
     repeat
       read(f_input,i1);
       if i1<>-1 then begin
         readln(f_input,j1);
         AdjMat[i1,j1]:=true;
         AdjMat[j1,i1]:=true;
       end else f_konec:=true;
       inc(k);
     until (f_konec);
     close(f_input);
   end;

Procedure GAMI(k:integer;Set1:a);
var i,j:integer;
exits:boolean;
begin
 for i:=1 to N do begin
    if (not(i in Set1)) and (AdjMat[Stack[k-1],i]) then
       begin
        Stack[k]:=i;
        If k<N then Gami(k+1,Set1+[i]);
        if (k=N) and (AdjMat[Stack[k],1])then
           begin
             if New then
             begin
                writeln(f_out,'      Gamilton Circle');
                writeln(f_out);
             end;
             new:=false;
             write(f_out,'       ');
             for j:=1 to N do begin
               write(Stack[j]:2,' -- ');
               write(f_out,Stack[j]:2,'  -- ');
             end;
             writeln(f_out,'1');exits:=true;
           end;
      end;
      if exits then exit;
end;
end;

BEGIN
    Set1:=[1];
    Stack[1]:=1;
    New:=true;
    Enter;
    name1:=name;
    i:=Pos('.',name);
    if i<>0 then Delete(name1,i,Length(name1)-i+1);
    name1:=name1+'c.sol';
    assign(f_out,name1);
    {$I-}rewrite(F_Out); {$I+}
    if IOResult <> 0 then Halt(1);
    Gami(2,Set1);
    if new then write(f_out,'No Circle!!!');
    close(f_out);
end.
END.

Взята из книги А.Д.Плотникова Дискретная математика.
Я нашел граф о котором данная программа говорит, что в нет Г.Ц., а он етсь.
Вот этот граф:
NAME FILE: 28.GRH
COOMENT: RANDOM GRAPH
DIMENSION:
7
EDGE_DATA_FORMAT: EDGE_LIST
EDGE_DATA_SECTIONS
  1  2
  1  4
  2  3
  2  4
  2  6
  3  4
  3  6
  3  7
  4  5
  4  6
  4  7
  6  7
-1
EOF
Прошу помоч с данной ситуацией.  :stena

Отмена тревоги. Этот граф реально не гамильтонов. Но все равно корректность программы под вопросом.
Тогда как объсянить ситуацию, что теорема Хаватала по этой моей программе говорит, что он гамильтонов.

Код


Enter(Matrix,SfName);
   for i:=1 to N do ArrVer[i]:=0;
   for i:=1 to N do begin
       for j:=1 to N do begin
           if Matrix[i,j]=1 then ArrVer[i]:=ArrVer[i]+1;
       end;
   end;
   Sort(ArrVer,1,N);
   for k:=1 to (N div 2) do
      If (not(ArrVer[k]<=k))or(ArrVer[n-k]>=(n-k))then inc(con)
      else  begin
        Label2.Caption :='Условие не выполнено';
        exit;
      end;
      if con=N div 2 then Label2.Caption :='Условие выполнено';

Это сообщение отредактировал(а) IvanoffAndrey - 14.9.2007, 14:15

--------------------

Размерность пространства есть число Pi и в каждой точке вселенной оно стремиться к этому числу.