Помощь - Поиск - Пользователи - Календарь
Полная версия: Задача о коммивояжёре
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Гость
Простите что создаю тему похожую на многие другие, но метод ветвей и границ я не нашел хотя изначиловал весь поиск...

проблема в следующем: я пишу курсовую на тему решение задачи о коммивояжёре методов метвей и границ...собственно говоря через полтора часа предзащита 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.
Fastblader
Если что пишите лично...
Danila-mgn
Цитата(Гость @ 11.12.2006 5:49) *

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

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