IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Задача о коммивояжёре, Метод ветвей и границ
сообщение
Сообщение #1


Гость






Простите что создаю тему похожую на многие другие, но метод ветвей и границ я не нашел хотя изначиловал весь поиск...

проблема в следующем: я пишу курсовую на тему решение задачи о коммивояжёре методов метвей и границ...собственно говоря через полтора часа предзащита smile.gif а курсовая не готова...ну да пох...
суть в том что нашел в инете исходник решения, а разобраться не могу...конкретно не понимаю как производиться чтение из файла DPoints (который я должен создать чтобы прога работала) и второй вопрос можно ли какнибудь реализовать чтение матрицы расстояний не из файла а например просто из массива...если да приведите если не сложно примеры...

собственно сам исходник....

Program Salesman_Problem;
{Meтoд вeтвeи и гpaниц}
Uses Crt;
Const
N=9;{} MaxDist=7; TC=14;{Цвет текста}
None=MaxDist+2;{Оценка уже оцененного города}

Type TDist=Record
Enable,goable: Boolean;
Dist: Integer;
end;

Var
Dist :array [0..n,0..n] of TDist;
Marks: array [0..n,0..n] of Integer;
Towns: array [0..n] of Byte;
Temp2: array [0..n+1] of Byte;
pgs: LongInt;
I: Integer;

Points: array[0..n] of Record
x,y: Integer; end;
Cycled: array[0..n,0..n] of Boolean;

Procedure ReadFromFile;
Var DFile: Text; k: Integer; X,Y,t: String[1];
begin
Assign(DFile,'c:\DPoints.txt');
Reset(DFile);
for i:=1 to n do begin
read(DFile,X); Val(X,Points[i].X,k); Read(DFile,t);
read(DFile,Y); Val(Y,Points[i].Y,k); Read(DFile,t);
end;
Close(DFile);
end;

Procedure FillDist;
Var ix,iy: Byte; dx,dy: LongInt;
Begin
For iy:=1 to n do for ix:=1 to n do begin
{if ix=iy Then begin Dist[ix,iy]:=0; Continue; end;{}
dx:=Points[ix].x-Points[iy].x;
dy:=Points[ix].y-Points[iy].y;
Dist[ix,iy].Dist:=Round(Sqrt(dx*dx+dy*dy));
end;
end;

Procedure ClearMarks;
var ix,iy: Integer;
begin
TextColor(7);
for iy:=1 to n do for ix:=1 to n do Marks[ix,iy]:=None;
end;

Procedure InitCycled;
var ix,iy: Integer;
begin
for iy:=1 to n do for ix:=1 to n do Cycled[ix,iy]:=true;
end;

Procedure Init;
begin
Randomize;
TextBackground(0);
ClrScr;
GotoXY(1,1);
ClearMarks;
InitCycled;
end;

Function HorMin(V,no: Byte): Integer;
var i,res: integer;
begin
res:=32000;
For i:=1 to n do
If (Dist[i,V].Enable) and (Dist[i,V].Dist<res) and (i<>no) Then
res:=Dist[i,V].Dist;
HorMin:=res;
end;

Function VerMin(H,no: Byte): Integer;
var i,res: integer;
begin
res:=32000;
For i:=1 to n do
If (Dist[H,i].Enable) and (Dist[H,i].Dist<res) and (i<>no) Then
res:=Dist[H,i].Dist;
VerMin:=res;
end;

Procedure SetMarks;
{Расставляет оценки каждого ребра графа}
var i,ix,iy: Integer;
begin
For iy:=1 to n do
For ix:=1 to n do
If (Dist[ix,iy].Enable) then Marks[ix,iy]:=
HorMin(iy,ix)+VerMin(ix,iy)-Dist[ix,iy].Dist;
end;

Procedure OutputDist;
Var ix,iy: Integer;
begin
GotoXY(1,4);{}
For iY:=1 to n do begin
For ix:=1 to n do begin
If Not Dist[ix,iy].Enable Then {TextBackground(TC){}
if Dist[ix,iy].goable Then TextBackground(1)
Else TextBackground(TC);
If Dist[ix,iy].Enable Then TextBackground(0);
Write(Dist[ix,iy].Dist,' ');{}
end;
WriteLn;
end;
TextBackground(0);
end;

Function SummTour: Integer;
Var n,res: Integer;
begin
n:={Towns[1]{}1{};
Repeat
res:=res+Dist[Towns[n],n].Dist;
n:=Towns[n]
Until n=1;
SummTour:=res;
end;

Procedure OutPutTour;
Var n: Integer;
begin
n:={Towns[1]{}1{};
Repeat
Write(n{Towns[n]{},'-');
n:=Towns[n]
Until n=1;
WriteLn;
Write('Длина маршрута: ',SummTour);
end;

Procedure OutputMarks;
Var ix,iy: Integer;
begin
GotoXY(1,4);
For iY:=1 to n do begin
For ix:=1 to n do
Write(Marks[ix,iy],' ');{}
WriteLn;
end;
TextBackground(0);
end;

Function GetMaxMarkX: Integer;
{определение максимальной оценки}
Var ix,iy,max,x: Integer;
begin
max:=-32000;
For iy:=1 to n do for ix:=1 to n do
if (Dist[ix,iy].Enable) and (marks[ix,iy]>max) and (ix<>iy) then begin
max:=marks[ix,iy];
x:=ix;
end;
GetMaxMarkX:=x;
end;

Function GetMaxMarkY: Integer;
{определение максимальной оценки}
Var ix,iy,max,y: Integer;
begin
max:=-32000;
For iy:=1 to n do for ix:=1 to n do
if (Dist[ix,iy].Enable) and (marks[ix,iy]>max) and (ix<>iy) then begin
max:=marks[ix,iy];
y:=iy;
end;
GetMaxMarkY:=y;
end;

Procedure DeleteCycle;
Var ix,iy: Integer;
begin
For iy:=1 to n do for ix:=1 to n do
If Cycled[ix,iy]=false Then begin
Dist[ix,iy].Enable:=false;
{Dist[ix,iy].Dist:=0;
Dist[ix,iy].goable:=false;{}
end;
end;

Procedure Estimate;
Var x,y,i: Integer;
begin
SetMarks; x:=GetMaxMarkX; y:=GetMaxMarkY;
for i:=1 to n do Dist[x,i].Enable:=False;
for i:=1 to n do Dist[i,y].Enable:=False;
Dist[y,x].Enable:=False; Dist[x,y].goable:=true;
for i:=1 to n do Cycled[x,i]:=Cycled[y,i];
Cycled[x,y]:=False;Towns[y]:=x;DeleteCycle;
end;

Procedure FindFinal;
var x,y,ix,iy,ind: Integer;
begin
Ind:=0;
for ix:=1 to n do for iy:=1 to n do
if Dist[ix,iy].Enable Then begin
inc(ind); x:=ix; y:=iy; end;
If Ind=1 then begin Dist[x,y].goable:=True;
Towns[y]:=x;Dist[ix,iy].Enable:=False;end;
end;

Function Completed: Boolean;
Var i: Integer; Res: boolean;
begin
res:=true;
For i:=1 to n do res:=res and (Towns[i]<>0);
Completed:=res;
end;

Begin
Init;
Writeln('Поиск оптимального маршрута среди ',n,' городов... Для нового по-');
Writeln('иска нажмите Enter, чтобы выйти нажмите клавишу Esc ');
Writeln;

Repeat
ReadFromFile;
FillDist;

While Not Completed do begin
Estimate;
FindFinal;{}
if keyPressed and (readkey=#27) Then break;
if Keypressed and (readkey<>#27) then begin
For i:=1 to n do Write(Towns[i],'-');
Write(#13);
SetMarks;
{OutPutMarks;{}
OutPutDist;
end;
If N<22 then begin
{OutPutMarks;{}
OutPutDist;{}
end;
end;{}

For i:=1 to n do Write(Towns[i],'-');{}
{WriteLn;
Write('Длина маршрута: ',SummTour);{}

{Repeat Until Keypressed;{}
Until Readkey<>#13{Enter}
end.
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 2)
сообщение
Сообщение #2





Группа: Пользователи
Сообщений: 1
Пол: Мужской
Реальное имя: Dflbv

Репутация: -  0  +


Если что пишите лично...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 3
Пол: Мужской

Репутация: -  0  +


Цитата(Гость @ 11.12.2006 5:49) *

суть в том что нашел в инете исходник решения, а разобраться не могу...конкретно не понимаю как производиться чтение из файла DPoints (который я должен создать чтобы прога работала)

Такая же проблемка.
p.s Сколько по времени,примерно,может длиться подсчёт результата на процессоре Athlon64 3000+ при 2Гб Ram-a?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 30.11.2021 0:04
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name