VPF::[Алгоритм] Задача коммивояжера

Streamline

Дата 6.12.2007, 22:36 (ссылка)

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

Загрузка ...

Новичок

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

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

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

JackYF

Дата 6.12.2007, 23:15 (ссылка)

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

Загрузка ...

полуавантюрист

Профиль
Группа: Участник
Сообщений: 5814
Регистрация: 28.8.2004
Где: страна тысячи озё р

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

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

)

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

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

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

Пожаловаться на меня как модератора можно здесь.

maxim1000

Дата 7.12.2007, 11:24 (ссылка)

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

Загрузка ...

Эксперт

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

Репутация: 24
Всего: 110

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

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

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

qqq

TimoX

Дата 12.12.2007, 13:17 (ссылка)

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

Загрузка ...

Новичок

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

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

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

{$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.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »