![]() |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
![]() |
Харди |
![]()
Сообщение
#1
|
Новичок ![]() Группа: Пользователи Сообщений: 10 Репутация: ![]() ![]() ![]() |
Привет! На форуме я нашла решение задачи коммивояжера только методом перебора, а мне необходимо решить ее методом ветвей и границ. Помогите пожалуйста решить. Заранее спасибо.
P.S. Если тема уже рассматривалась, скажите, я поищу еще раз |
![]() ![]() |
Харди |
![]()
Сообщение
#2
|
Новичок ![]() Группа: Пользователи Сообщений: 10 Репутация: ![]() ![]() ![]() |
Спасибо, 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. |
![]() ![]() |
![]() |
Текстовая версия | 23.06.2024 10:13 |