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

[Харди]

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

[Харди]

Спасибо, 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.