Метод ветвей и границ, Задача коммивояжера Опции

[Харди]

Привет! На форуме я нашла решение задачи коммивояжера только методом перебора, а мне необходимо решить ее методом ветвей и границ. Помогите пожалуйста решить. Заранее спасибо.
P.S.
Если тема уже рассматривалась, скажите, я поищу еще раз

[volvo]

Харди

Почитай... Я надеюсь, это тебе поможет...
(открывать WinRar-ом)

[Харди]

Вопрос: открыть я открыла, а вот с чтением плоховато. В чем посмотреть лучше?

[volvo]

Харди
Это обычный DOC файл - Word-ом...

[Харди]

просто у меня файл вообще без расширения

[Харди]

и с кодировкой какая-то фигня

[Altair]

А вы может пытаетесь почитать рар файл?
Вы разархивировали?
Word есть? (или все, что читает DOC)

[Харди]

Rar'ом открыла, в папке лежит файл 97 Kb без расширения. Попробовала Word, Блокнот, редактор Far, IE

[volvo]

Харди

папке лежит файл 97 Kb без расширения

Я только что скачал отсюда - после WinRar-а в папке DOC на 967 К

[Altair]

А ясно, вольво там два раза зархивил, то что без расщирения это еще один архив рар!

[Харди]

может у меня версия старая 3.11

[Харди]

да вот это сложности! Спасибо я уже открыла!

[volvo]

Oleg_Z
Харди

Это у меня глюки какие-то :p2: Раньше такого не было ...

[Altair]

Может это форум архивирует второй раз при закачке рара? что-то припоминаю схожую ситуацию, надо проверить будет..

[Харди]

Спасибо, volvo, за файл, только я его уже изучала.
В программе я сделала приведение самой матрицы, а вот с нахождением весов нулей и последующим вычеркиванием соотвествующих стролбца и строки уже сложнее
Я тут нашла один пример: все работает, но ответ не сходится, выдается на 25 больше

Код

const
k=52;
var
n,e,s,z,min,x,y,d,t:integer;
a1,f,i,r,h,c1:array[1..k,1..k] of integer;
v:array[1..2,1..k] of integer;
p:array[1..k] of integer;
a,c:array[1..k,1..k] of integer;
begin
{$I-}
repeat
write('Вв.число городов-');
readln(n);
until (IOresult=0)and(n>0)and(n<26);
writeln('Вв.матрицу расстояний');
for x:=1 to n do
for y:=1 to n do begin
repeat
read(a1[x,y]);
if (a1[x,y]<0)or(IOresult<>0)
then begin writeln('Ошибка ввода!Продолжайте с эл-та[',x,',',y,']');end;
until (a1[x,y]>=0)and(IOresult=0);
end;
for x:=1 to n do
for y:=1 to n do
a[x+1,y+n+1]:=a1[x,y];
for x:=1 to 2*n+2 do begin
writeln;
for y:=1 to 2*n+2 do
end;
for x:=2 to n+1 do
c[1,x]:=1;
for x:=1 to n do
for y:=1 to n do
if a1[x,y]>0 then c[x+1,y+n+1]:=1;
for x:=n+2 to 2*n+1 do
c[x,2*n+2]:=1;
{$I+}
for x:=1 to 2*n+2 do for y:=1 to 2*n+2 do begin f[x,y]:=0;r[x,y]:=0;i[x,y]:=0;end;
for x:=1 to 2*n+2 do
for y:=1 to 2*n+2 do if c[x,y]=0 then h[x,y]:=1;
for x:=1 to 2*n+2 do for y:=1 to 2*n+2 do begin
if f[x,y]<c[x,y] then i[x,y]:=c[x,y];
if f[x,y]>0then r[x,y]:=c[x,y]end;
repeat
min:=32767;
v[1,1]:=1;

for t:=1 to 2*n+2 do begin
if v[1,x]=1 then h[x,y]:=1;
for x:=1 to 2*n+2 do begin
if v[1,x]=1 then h[x,y]:=1;
for z:=1 to 2*n+2 do
for x:=1 to 2*n+2 do
for y:=1 to 2*n+2 do
if h[x,y]=0 then begin
if (i[x,y]>0)and(v[1,x]<>0)and(v[1,y]=0) then begin v[1,y]:=1;v[2,y]:=x;end;
if (r[x,y]>0)and(v[1,y]<>0)and(v[1,x]=0) then begin v[1,x]:=-1;v[2,x]:=y;end;
end;
y:=2*n+2;
x:=v[2,2*n+2];
while x<>0 do begin
if (i[x,y]>0)and(i[x,y]<min)and(v[1,y]=1) then min:=i[x,y];
if (r[y,x]>0)and(r[y,x]<min)and(v[1,y]=-1) then min:=r[y,x];
y:=x;
x:=v[2,y];
end;
y:=2*n+2;
x:=v[2,2*n+2];
while x<>0 do begin
if (v[1,y]=1) then begin i[x,y]:=i[x,y]-min;r[x,y]:=r[x,y]+min;f[x,y]:=f[x,y]+min;
end;
if (v[1,y]=-1) then begin i[y,x]:=i[y,x]+min;r[y,x]:=r[y,x]-min;f[y,x]:=f[y,x]-min;
end;
y:=x;
x:=v[2,y];
end;
for x:=1 to 2*n+2 do begin
v[1,x]:=0;v[2,x]:=0;
if v[1,x]=1 then h[x,y]:=1;
end;
end;
end;
until min=32767;
for x:=1 to 2*n+2 do d:=d+f[1,x];
{-------------------------------------------}
for x:=1 to 2*n+2 do for y:=1 to 2*n+2 do begin f[x,y]:=0;r[x,y]:=0;i[x,y]:=0;end;
{$I-}
s:=d;
d:=0;
repeat
for x:=1 to 2*n+2 do for y:=1 to 2*n+2 do begin
if (f[x,y]<c[x,y])and(p[y]-p[x]=a[x,y]) then i[x,y]:=c[x,y];
if (f[x,y]>0)and(p[y]-p[x]=a[x,y]) then r[x,y]:=c[x,y]end;
min:=32767;
v[1,1]:=1;
for z:=1 to 2*n+2 do
for x:=1 to 2*n+2 do
for y:=1 to 2*n+2 do
if h[x,y]=0 then begin
if (i[x,y]>0)and(v[1,x]<>0)and(v[1,y]=0) then begin v[1,y]:=1;v[2,y]:=x;end;
if (r[x,y]>0)and(v[1,y]<>0)and(v[1,x]=0) then begin v[1,x]:=-1;v[2,x]:=y;end;
end;
y:=2*n+2;
x:=v[2,2*n+2];
while x<>0 do begin
if (i[x,y]>0)and(i[x,y]<min)and(v[1,y]=1) then min:=i[x,y];
if (r[y,x]>0)and(r[y,x]<min)and(v[1,y]=-1) then min:=r[y,x];
y:=x;
x:=v[2,y];d:=1;
end;
if (d=1)and(min<s) then e:=1;
if (d=1)and(min>=s)then e:=-1;
if e=1 then begin s:=s-min;for x:=1 to 2*n+2 do p[x]:=0;end;
if e=-1 then begin min:=s;s:=0;for x:=1 to 2*n+2 do p[x]:=0;end;
d:=0;e:=0;
y:=2*n+2;
x:=v[2,2*n+2];
while x<>0 do begin
if v[1,y]=1 then  begin i[x,y]:=i[x,y]-min;r[x,y]:=r[x,y]+min;end;
if v[1,y]=-1 then begin i[y,x]:=i[y,x]+min;r[y,x]:=r[y,x]-min;end;
f[x,y]:=r[x,y];
y:=x;
x:=v[2,y];
end;
for x:=1 to 2*n+2 do if v[1,x]=0 then p[x]:=p[x]+1;
for x:=1 to 2*n+2 do begin
v[1,x]:=0;v[2,x]:=0;end;
until s=0;
write('Матрица расстояний:');
for x:=1 to 2*n+2 do begin
writeln;
for y:=1 to 2*n+2 do begin
s:=s+a[x,y]*f[x,y];
write(f[x,y]:3);
end;end;
writeln;
write('длина пути-',s);
readln;readln;
end.

[volvo]

Харди
Что это? Эта программа по-моему должна быть в 3 раза короче ...

[Харди]

наверное, на симплекс-метод, например, намного меньше.
коммивояжер даже в ручном методе очень много вычислений
посмотреть бы пример программы, может стало бы понятнее

[Гость_Харди]

Кто-нибудь может мне помочь с этой задачей? Ручной метод есть, а вот с программной реализацией полный аут

[volvo]

Харди
Держите работающую программу метода ветвей и границ (она требует входной файл, я прикреплю его следующим сообщением)

[volvo]

Формат входного файла:

<число вершин>
<вес ребра из вершины 1 в вершину 1> <вес ребра из 1 из 2> ... <вес ребра из 1 в n>
<вес ребра из 2 в 1>                <вес ребра из 2 из 2> ... <вес ребра из 2 в n>
...
<вес ребра из n в 1>                <вес ребра из n из 2> ... <вес ребра из n в n>

А вот пример файла с данными для программы...
 input.zip ( 171 байт ) Кол-во скачиваний: 2746


Сообщение отредактировано: volvo - 13.05.2005 17:52