Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Центр помощи > [Алгоритм] Задача коммивояжера

Автор: Streamline 6.12.2007, 22:36

Sabj, Напишите плс код на паскале - в качестве матрицы задается массив N*N.
Я предпологаю решить так - алгоритмом флойда формирем полную матрицу, затем полным перебором ищем пути .. у кого какие идеи ??

Автор: JackYF 6.12.2007, 23:15

Цитата(Streamline @ 6.12.2007, 22:36

)

Напишите плс код на паскале

в Центр Помощи. В алгоритмах этой теме делать нечего.

Автор: maxim1000 7.12.2007, 11:24

Для домашних заданий, курсовых, существует "Центр Помощи".

Тема перенесена!

Автор: TimoX 12.12.2007, 13:17

Я бы предложил простой полный рекурсивный перебор.
Рабочий код выложен далее.

{$o-}
Var
a:array [1..20,1..20] of longint;
ans,t,l:array [1..20] of longint;
n,i,j,answ:longint;

Procedure Rec(x,k,s:longint);
Var
   i:longint;

Begin
  if s>answ then exit;
  t[k]:=x;
  if (k=n+1) and (s>0) then
     Begin
       if s<answ
          Then Begin
                answ:=s;
                ans:=t;
               End;
       exit;
     End;

  inc(l[x]);

  if (k=n) and (a[x,1]>0) then
       Rec(1,k+1,s+a[x,1])
  else
  for i:=1 to n do
   if (a[x,i]>0) and (l[i]=0) then Rec(i,k+1,s+a[x,i]);

  dec(l[x]);
End;

BEGIN
assign(input,'input.txt');reset(input);
assign(output,'output.txt');rewrite(output);
   read(n);
   fillchar(a,sizeof(a),0);
   fillchar(l,sizeof(l),0);
   answ:=1000000;

   for i:=2 to n do
    for j:=1 to n do
          read(a[i,j]);

   Rec(1,1,0);

   writeln(answ);
   for i:=1 to n do write(ans[i],' '); writeln(ans[n+1]);
close(input);
close(output);
End.