Задачи коммивояжёра

Размещено на http://www.allbest.ru/

40

Министерство транспорта Российской Федерации

Федеральное агентство железнодорожного транспорта

ГОУ ВПО «Дальневосточный государственный университет путей сообщения»

Кафедра «Системы автоматизированного проектирования»

ЗАДАЧИ КОММИВОЯЖЕРА

Курсовая работа

К.Р.230104.65.03.01.19.000-943

Выполнил

Цыганец Е.И.

Проверил

Тимош П.С.

Хабаровск

2008

Постановка задачи: Система поиска решения задачи коммивояжера. Система должна иметь систему сохранения в файл исходных и входных данных, загрузки из файла входных данных. Графический интерфейс пользователя оснащён возможностями интерактивного изменения данных.

Введение: Хорошо известна следующая задача. Имеется N городов T[0] .. T[N-1]. Расстояние между каждой парой T[i], T[j] определяется длиной соединяющего их отрезка.

система поиск маршрут коммивояжер

где А - матрица расстояний между городами. Необходимо указать кратчайший маршрут, который начинается городом T[0], проходит через города T[1] .. T[n-2] и заканчивается городом T[N-1].

В теоретическом плане задача решается легко: достаточно перебрать все перестановки городов T[1] .. T[n-2] на маршруте и выбрать ту из них, которая доставляет кратчайший путь. Однако этот метод при существующих возможностях ПК дает результат за приемлемое время вычислений (от нескольких секунд до минуты), если N<10. С дальнейшим увеличением N быстродействие комбинаторного метода быстро снижается и его нельзя использовать в практических расчетах.

Среди других методов решения подобных практических задач (к ним, в частности, можно отнести близкую к рассматриваемой задачу коммивояжера) обычно используют единственный альтернативный метод ветвей и границ (МВГ). Считается, что он обеспечивает точное решение за минимальное время вычислений. Метод, действительно, хорошо работает на "учебных" примерах, однако, как показали эксперименты с МВГ на практических (логистических) примерах решения рассматриваемой задачи, его быстродействие сильно зависит от вида матрицы А и в большинстве случаев МВГ не гарантирует результативности в приемлемое время даже при N=15.

При всей известности задачи не удалось ни в научной литературе, ни в Интернет найти быстрых методов, которые позволили бы приближенно решить задачу с достаточной для практики точностью до 10% за приемлемое время.

Ниже рассмотрено несколько сравнительно быстрых приближенных эвристических методов решения задачи, которые удовлетворяют упомянутому условию. Методы реализуют процессы поиска базового маршрута и последующего его улучшения. При их описании использованы терминология теории графов и средства языка Object Pascal среды Delphi.

1 Методы нахождения базового маршрута

Метод 1. («жадный», Greedily). Сначала на графе, образованном матрицей А, отыскивается и включается в маршрут вершина (город) T[k] , которая ближе всех к начальной. Далее отыскивается самая близкая к T[k] из числа еще не включенных в маршрут и т. д. В результате получается приближенное решение задачи - базовый маршрут.

Метод 2 («деревянный», Woody). Сначала в маршрут включаются две вершины начальная T[0] и конечная T[N-1]. Далее отыскивается вершина, которая характеризуется наименьшим расстоянием D(T[i]+T[k]) + D(T[k]+T[j]) -- D(T[i] + T[j]), где i = 0, j = N-1, k - номера еще не включенных в маршрут вершин. Найденная вершина помещается в маршрут (0, k, N-1). На следующем шаге отыскивается вершина L, которая характеризуется наименьшим расстоянием DL от звена (0, k), и вершина M, имеющая наименьшее расстояние DM от звена (k, N-1). Среди L и M выбирается та, которая имеет наименьшее из DL и DM, и включается внутрь своего звена (0, k) или (k, N-1). Пусть это вершина M с номером m. Теперь маршрут состоит из трех звеньев (0, k), (k, m), (m, N-1). Процесс продолжается до тех пор, пока есть не включенные в маршрут вершины.

Метод 3 (простейший, Simply). Промежуточные вершины в маршрут включаются случайным образом. В частности, базовым будет допустимый маршрут G[i] = i.

Маршруты, построенные этими методами, вычисляются с очень высокой скоростью (практически мгновенно). Однако длина этих маршрутов в подавляющем большинстве случаев далека от практически приемлемой. Для этих целей применено несколько методов улучшения базового маршрута.

2 Методы улучшения базового маршрута

Метод 1 (перестановок, Permutations). Совершается последовательный проход по парам соседних вершин всех звеньев с перестановкой этих вершин. Если перестановка уменьшает длину маршрута, то этот маршрут считается текущим. Производятся новые попытки улучшить его тем же методом до тех пор, пока перестановки не дадут эффекта. Далее аналогичным образом выполняются перестановки по трем соседним вершинам из числа тех, которые не попали в число ранее проведенных операций с двумя соседними вершинами (перестановки более широкого диапазона, т. е. по 4 и более, не выполнялись). Эксперименты с графами показали, что процедура улучшения маршрута при помощи перестановок достаточно эффективна и быстродействие ее весьма высоко.

Метод 2 (удаление петлей, CrossDeleting). Часто текущий маршрут содержит петли. Например, на рисунке 1 цепочка вершин 5-7-3-8-2-4 образуют петлю. Петля начинается с левой по ходу маршрута вершины отрезка 5-7 и заканчивается правой вершиной отрезка 2-4. Существование петли определяется наличием пересекающихся отрезков маршрута. Если внутреннюю цепочку петли повернуть в противоположном направлении, то есть заменить указанную цепочку на 5-2-8-3-7-4, то петля исчезнет (рисунок 2), а маршрут станет короче. Метод отличается чрезвычайно высоким быстродействием и высокой эффективностью.

Рисунок 1. Маршрут с петлей Рисунок 2. Улучшенный маршрут

Метод 3 (разворот цепочек, ChainTurnings). Как показали эксперименты, отсутствие петлей еще не означает, что процедура разворота цепочек без петлей неэффективна. Для оптимизации текущего маршрута применялась процедура разворота всех возможных цепочек. Метод имеет самое низкое быстродействие в сравнении с другими методами улучшения. Поэтому на практике его применяли для цепочек с числом звеньев не более шести.

Метод 4 (комбинированный, CorrectPath). После нахождения какого-нибудь базового маршрута G к нему применялась комбинированная процедура улучшения по методам 2.1 - 2.3. Хотя метод 2.2 является частным случаем метода 2.3, его все равно применяли из-за высокого быстродействия и способности к эффективному разворота цепочек из любого числа звеньев. Метод имеет код:

procedure CorrectPath(N: Integer; var G: TIntVec; var Path: Integer);

begin

repeat

until not Permutations(N,G) and not ChainTurnings(N,G) and

not CrossDeleting(N,G) and not MoveTops(N,G);

Path:= PathByG(N,G); // расчет длины маршрута

end;

3 Приближенные комбинированные методы нахождения кратчайшего маршрута:

Применив три метода 1.1, 1.2, 1.3 расчета базового маршрута и комбинированный метод 2.4 их улучшения, получили три приближенных метода расчета маршрута:

метод 1:

procedure GreedilyCorrect(N: Integer; var G: TIntVec; var Path: Integer);

begin

Greedily(N,G);

CorrectPath(N,G,Path);

end;

метод 3.2:

procedure WoodyCorrect(N: Integer; var G: TIntVec; var Path: Integer);

begin

Woody(N,G);

CorrectPath(N,G,Path);

end;

и метод 3.3:

procedure SimplyCorrect(N: Integer; var G: TIntVec; var Path: Integer);

begin

Simply(N,G);

CorrectPath(N,G,Path);

end;

В экспериментах с методами 3.1-3.3 установлено, что ни один из них не является предпочтительным. В зависимости от матрицы А лучший результат с равной вероятностью мог дать любой из этих методов (интересно, что даже простейший базовый маршрут G[i] = i после улучшений нередко трансформировался в самый короткий маршрут, что свидетельствует о том, что решение задачи практически не зависит от выбора базового маршрута). Поэтому в качестве рабочего применяли комбинированный метод 3.4 (комбинация всех), суть которого состоит в последовательном применении методов 3.1-3.3 к матрице А с последующим выбором лучшего маршрута среди сформированных этими методами.

Для того чтобы можно было оценить точность приближенной методики разработана рекурсивная процедура (RecoursiveMethod), позволяющая получить точное решение задачи переборным методом. Для повышения быстродействия в процедуру внесены некоторые очевидные эвристические усовершенствования. Процедура позволила получить точное решение за приемлемое для проведения необходимых оценок время (до 5 минут на вариант размещения городов) при N<23.

Для оценки точности метода 3.4 при больших значениях N (N>22) процедуру RecoursiveMethod применить нельзя, поэтому составлена процедура Rand многократного применения метода 3.3 к одной и той же матрице А с различными случайными базовыми маршрутами. Процедура последовательно формирует маршруты до тех пор, пока последний лучший маршрут не повторится 5 раз подряд. Нельзя сказать, что такой способ позволяет найти самый короткий маршрут. Однако результаты работы процедуры дают интуитивную уверенность в том, что сравнение «быстрого» результата с результатом длительной работы метода 3.4 имеет достаточно высокую вероятность корректности за неимением точных методов. Уверенность в этом подкреплена весьма важным выводом, который получен после обработки сотен различных матриц для N<23. Он состоит в полном совпадении результатов, полученных с использованием точной процедуры RecoursiveMethod и приближенной Rand (т. е. для данных N процедура Rand всегда находила точное решение задачи).

В качестве примера на рисунке представлен кратчайший маршрут из вершины 0 в вершину 13 (N = 14) для матрицы расстояний, которая показана на рисунке 4.



Рисунок 4. Матрица расстояний

На рисунках 5-10 показаны результаты расчета маршрутов и их протяженности (Комб и Rand) для случайного расположения городов при помощи быстрой процедуры комбинированного метода 3.4 и процедуры Rand. В последней колонке таблиц приведена процентная погрешность метода 3.4, которую рассчитывали по формуле 100 (Комб-Rand)/Комб, %.

Рисунок 8 Рисунок 9 Рисунок 10

В результате экспериментов с несколькими сотнями матриц расстояний для различных N, получены данные, которые свидетельствуют, что независимо от количества N городов погрешность метода 3.4 никогда не превосходила 8% при N<101. Средняя погрешность составила 2%, что вполне приемлемо для практики.

На основании обработки многочисленных расчетных данных получена формула ориентировочной оценки быстродействия метода 3.4. Среднее время t (с) расчета на компьютере с процессором Intel 1400 кратчайшего маршрута с N городами составило

Так, для N = 100 среднее время расчета маршрута составляет 4 секунды. Для практически используемых N<31 это время не превосходит 0,1 с.

Код программы:

unit Unit1;

// Задача.

// Задано количество городов N и координаты этих городов Townes[0]..Townes[N-1].

// Пути между ними определятся отрезками прямых.

// Найти кратчайший путь между Townes[0] и Townes[N-1], который проходит через

// все остальные города.

// Приближенные методы решения этой задачи,

// запрограммированные в Delphi6 Коднянко Владимиром 07.05.06 г.

interface

uses

  Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ExtCtrls,Spin,

  ComCtrls,Buttons,StdCtrls;

type

  TForm1 = class(TForm)

    PaBot: TPanel;

    eG: TEdit;

    PaIm: TPanel;

    PaLft: TPanel;

    Splitter1: TSplitter;

    bExit: TButton;

    GroupBox1: TGroupBox;

    bWoody: TButton;

    bGreedily: TButton;

    bSimple: TButton;

    bCombin: TButton;

    GroupBox2: TGroupBox;

    bObhod: TButton;

    Pb1: TProgressBar;

    GroupBox4: TGroupBox;

    Label2: TLabel;

    seN: TSpinEdit;

    Label3: TLabel;

    sePar: TSpinEdit;

    bDefA: TButton;

    Label5: TLabel;

    LCalc: TLabel;

    eP: TEdit;

    Label1: TLabel;

    PageControl1: TPageControl;

    TabSheet1: TTabSheet;

    TabSheet2: TTabSheet;

    Im: TImage;

    stLa: TStaticText;

    Lv: TListView;

    Panel1: TPanel;

    Label4: TLabel;

    stN: TStaticText;

    bMany: TButton;

    bStop: TButton;

    Label6: TLabel;

    seMaxTime: TSpinEdit;

    bRand: TButton;

    TabSheet3: TTabSheet;

    Me: TMemo;

    Button1: TButton;

    Button2: TButton;

    procedure bDefAClick(Sender: TObject);

    procedure bGreedilyClick(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure bObhodClick(Sender: TObject);

    procedure bWoodyClick(Sender: TObject);

    procedure bCombinClick(Sender: TObject);

    procedure bSimpleClick(Sender: TObject);

    procedure bExitClick(Sender: TObject);

    procedure FormActivate(Sender: TObject);

    procedure LCalcClick(Sender: TObject);

    procedure stLaMouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure stLaMouseMove(Sender: TObject; Shift: TShiftState; X,

      Y: Integer);

    procedure stLaMouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure bRandClick(Sender: TObject);

    procedure bStopClick(Sender: TObject);

    procedure bManyClick(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

Const IntSz = SizeOf(Integer);

Type

 TIntVec  = array of Integer;

 TIntMatr = array of TIntVec;

 TPointVec = array of TPoint;

 TDouPoint = Record x,y: Double; end;

var

  Form1: TForm1;

  Townes: TPointVec; // города и их координаты

  a,h: TIntMatr; // матрица расстояний между городами и вспомогательная матрица

  G,b,c,u,GG1,GG2,f: TIntVec; // массив номеров городов (G) и вспомогательные массивы

  La: array of TStaticText;

  n{ // число городов},pMin,pTec,kp,Par,FastMinPath,CorrectPath: Integer; // вспомогательные

  Ratio: TDouPoint;  // масштабы для Image

  ProcessBoo: boolean = false;

  MovePar: boolean = false;

  StX,StY,StMX,StMy: Integer;

implementation

{$R *.dfm}

{$R resfile.res}

procedure TForm1.stLaMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

 stX:= (Sender as TStaticText).Left;

 stY:= (Sender as TStaticText).Top;

 stMX:= Mouse.CursorPos.X;

 stMY:= Mouse.CursorPos.Y;

 MovePar:= true;

end;

procedure TForm1.stLaMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

 if MovePar then

  begin

  (Sender as TStaticText).Left:= stX+Mouse.CursorPos.X-stMX;

  (Sender as TStaticText).Top:= stY+Mouse.CursorPos.Y-stMY;

  end;

end;

procedure TForm1.stLaMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

 MovePar:= false;

end;

procedure TForm1.bStopClick(Sender: TObject);

begin

 ProcessBoo:= false;

end;

function KdnTimeToTime(Secunds: Double): TTime;

 var H,M,S,MS: Word; t1: Integer;

begin

 if Secunds<=0 then

  begin H:=0; m:=0; s:=0; ms:=0; end

 else

  begin

   t1:= Trunc(Secunds);

   MS:= Round(1000*Frac(Secunds));

   H:= t1 div 3600;

   M:= (t1-H*3600) div 60;

   S:= t1-H*3600-M*60;

  end;

 Result:= EncodeTime(h,m,s,MS);

end;

function TimeToKdnTime(t: TTime): Double;

 var H,M,S,MS: Word;

begin

 DecodeTime(t,H,M,S,MS);

 Result:= S+M*60+H*3600+0.001*MS;

end;

Function RealToStr(R: Double; Posle: byte): String;

begin Result:= Trim(Format('%*.*f',[30,Posle,r])); end;

procedure Buttons;

begin

 With Form1 do

  begin

   LCalc.Enabled:= not ProcessBoo and (a<>Nil);

   bDefA.Enabled:= not ProcessBoo;

   bGreedily.Enabled:= not ProcessBoo and (a<>Nil);

   bWoody.Enabled:= not ProcessBoo and (a<>Nil);

   bSimple.Enabled:= not ProcessBoo and (a<>Nil);

   bCombin.Enabled:= not ProcessBoo and (a<>Nil);

   bExit.Enabled:= not ProcessBoo;

   bStop.Enabled:= ProcessBoo;

   bRand.Enabled:= not ProcessBoo and (a<>Nil);

   bObhod.Enabled:= not ProcessBoo and (a<>Nil);

   bMany.Enabled:= not ProcessBoo and (a<>Nil);

   Pb1.Visible:= ProcessBoo;

  end;

end;

procedure NilLa;

 var i: Integer;

begin

 if Length(La)>0 then

  for i:=0 to Length(La)-1 do

   La[i].Free;

 La:= Nil;

end;

Function LPad(s: String; d: Word): String;

{вставляет слева от строки пробелы, добирая ее до длины d}

begin Result:=Format('%*s',[d,s]); end;

procedure OutMatr;

 var i,j: Integer; s: String;

begin

 With Form1.Me do

  begin

   Lines.Clear;

   for i:=0 to n-1 do

    begin

     s:= '';

     for j:=0 to n-1 do

      s:= s+LPad(IntToStr(a[i,j]),4)+' ';

     Lines.Add(s);

    end;

  end;

end;

procedure TForm1.bExitClick(Sender: TObject);

begin

 Close;

end;

procedure TForm1.FormActivate(Sender: TObject);

begin

 Buttons;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 a:= Nil; h:= Nil; b:= Nil; c:= Nil; G:= Nil; f:= Nil; Townes:= Nil; NilLa;

end;

procedure CreateLa;

 var i: Integer;

begin

 With Form1 do

 if n<>Length(La) then

  begin

   NilLa;

   SetLength(La,n);

   for i:=0 to n-1 do

    begin

     La[i]:= TStaticText.Create(PaIm);

     La[i].Parent:= stLa.Parent;

     La[i].BorderStyle:= stLa.BorderStyle;

     if (i>0) and (i<n-1) then La[i].Color:= stLa.Color else La[i].Color:= clAqua;

     La[i].Caption:= ' '+IntToStr(i)+' ';

     La[i].BringToFront;

     La[i].OnMouseDown:= stLa.OnMouseDown;

     La[i].OnMouseUp:= stLa.OnMouseUp;

     La[i].OnMouseMove:= stLa.OnMouseMove;

    end;

  end;

end;

Procedure Curs(i: byte);

begin

 Case i of

  1: Screen.Cursor:= crAppStart;

  else Screen.Cursor:= crDefault;

 end;

 Application.ProcessMessages;

end;

Function CopyRest(s: String; n: Word): String;

{сопирует остаток строки, начиная с n}

begin Result:= Copy(s,n,Length(s)); end;

function DelSymbAll(s: String; Ch: Char): String;

{удаляет символ везде}

 var i: Integer;

begin

 i:= pos(Ch,s);

 while i>0 do

  begin

   Delete(s,i,1);

   i:= pos(Ch,s);

  end;

 Result:= s;

end;

procedure RevInt(var i1,i2: Integer);

 var i: Integer;

begin i:= i1; i1:= i2; i2:=i; end;

procedure SortIntVec(var v: TIntVec);

 var n,i: Integer; L: byte;

begin

 n:= Length(v);

 if (n>1) then

  repeat

   L:=1;

   for i:=0 to n-2 do

    if v[i]>v[i+1] then

     begin RevInt(v[i],v[i+1]); L:=0; end;

  until L=1;

end;

procedure IntVecCopy(v1: TIntVec; var v2: TIntVec);

 var n: Integer;

begin

 n:= Length(v1);

 if Length(v2)<>n then SetLength(v2,n);

 Move(v1[0],v2[0],n*IntSz);

end;

function Dist1(p1,p2: TPoint): Integer;

begin

 if p1.x=p2.x then

  if p1.y=p2.y then

   begin

    Result:=0;

    exit;

   end;

 Result:= Round(Sqrt((p1.X-p2.X)*(p1.X-p2.X)+(p1.Y-p2.Y)*(p1.Y-p2.Y)));

end;

function Dist2(p1,p2: TPoint): Integer;

 var x,y: Integer;

begin

 if p1.x=p2.x then

  if p1.y=p2.y then

   begin

    Result:=0;

    exit;

   end;

 x:= p1.X-p2.X; y:= p1.Y-p2.Y; Result:= x*x+y*y;

end;

procedure DrawLine(Im: TImage; p1,p2: TPoint; Colour: TColor; Fat: byte);

begin

 With Im.Canvas do

  begin

   Pen.Width:= Fat;

   Pen.Color:= Colour;

   MoveTo(p1.x,p1.y);

   LineTo(p2.x,p2.y);

  end;

end;

procedure DrawText(x,y: Integer; s: String);

 var R: TRect;

begin

 With Form1.Im.Canvas do

  begin

   Font.Color := clRed;

   R.Left:= x;R.Top:= y;

   TextOut(R.Left + Font.Size, R.Top + 2,s);

  end;

end;

procedure DefRatios;

 var i: Integer; MaxVal: TPoint;

begin

 With Form1 do

  begin

   MaxVal.X:=0; MaxVal.Y:=0;

   for i:=0 to n-1 do

    begin

     if Townes[i].X>MaxVal.X then MaxVal.X:= Townes[i].X;

     if Townes[i].Y>MaxVal.Y then MaxVal.Y:= Townes[i].Y;

    end;

   Ratio.X:= Im.Width/MaxVal.X*0.9;

   Ratio.Y:= Im.Height/MaxVal.Y*0.9;

  end;

end;

procedure OutLa(i: Integer; x,y: Integer);

begin

 With Form1 do

  begin

   La[i].Left:= x;

   La[i].Top:= y;

  end;

end;

procedure DrawTownes;

 var i: Integer; p: TPoint;

begin

 With Form1 do

  begin

   Im.Picture:= Nil;

   Application.ProcessMessages;

   DefRatios;

   for i:=0 to n-1 do

    begin

     p.X:= Round(Townes[i].X*Ratio.X);

     p.Y:= Round(Townes[i].Y*Ratio.Y);

     DrawLine(Im,p,p,clBlue,7);

     OutLa(i,p.X-10,p.Y+6);

//     DrawText(p.X-10,p.Y+2,IntToStr(i));

    end;

  end;

end;

procedure DrawPaths(g: TIntVec);

 var i: Integer; p1,p2: TPoint;

begin

 With Form1 do

  begin

   for i:=0 to n-2 do

    begin

     p1.X:= Round(Townes[g[i]].X*Ratio.X);

     p1.Y:= Round(Townes[g[i]].Y*Ratio.Y);

     p2.X:= Round(Townes[g[i+1]].X*Ratio.X);

     p2.Y:= Round(Townes[g[i+1]].Y*Ratio.Y);

     DrawLine(Im,p1,p2,clBlack,2);

    end;

  end;

end;

function GStr(G: TIntVec): String;

 var i: Integer;

begin

 Result:='';

 for i:=0 to n-1 do

  Result:= Result+IntToStr(G[i])+'-';

end;

procedure OutOnMap(G: TIntVec; p: Integer; ShowMap: byte);

begin

 if ShowMap=1 then

  begin

   Form1.eG.Text:= GStr(G);

   Form1.eP.Text:= IntToStr(p);

   // Form1.eO.Text:= Comment;

   DrawTownes;

   DrawPaths(G);

   Application.ProcessMessages;

  end;

end;

function LinesAreSect(p11,p21,p12,p22: TPoint): boolean;

// 1-я прямая проходит через p11,p21

// 2-я прямая проходит через p12,p22

 var d,d1,d2: Integer; z1,z2: Double;

begin

 Result:= false;

 d := (p21.x-p11.x)*(p12.y-p22.y)-(p21.y-p11.y)*(p12.x-p22.x);

 d1:= (p12.x-p11.x)*(p12.y-p22.y)-(p12.y-p11.y)*(p12.x-p22.x);

 d2:= (p21.x-p11.x)*(p12.y-p11.y)-(p21.y-p11.y)*(p12.x-p11.x);

 if d<>0 then

  begin

   z1:= d1/d; z2:= d2/d;

   Result:= (z1>0.00001) and (z1<0.99999) and (z2>0.00001) and (z2<0.99999);

  end;

end;

procedure DefTownes;

// размещаем города случайным образом

 var i,j,i1,j1,d,dMax: Integer; p: TPoint;

begin

 With Form1 do

  begin

   n:= seN.Value;

   SetLength(Townes,n);

   Randomize;

   for i:=0 to n-1 do

    begin

     Townes[i].X:= Random(n*12)+20;

     Townes[i].Y:= Random(n*12)+20;

    end;

   // ищем самые удаленные друг от друга города

   dMax:= 0; i1:= 0; j1:=0;

   for i:=0 to n-1 do

    for j:=0 to n-1 do

     if i>j then

      begin

       d:= Dist1(Townes[i],Townes[j]);

       if d>dMax then begin dMax:= d; i1:= i; j1:= j; end;

      end;

   // [0]-первый город, [n-1]-самый дальний город

   p:= Townes[i1]; Townes[i1]:= Townes[n-1]; Townes[n-1]:= p;

   p:= Townes[j1]; Townes[j1]:= Townes[0]; Townes[0]:= p;

   CreateLa; // номера городов, можно передвигать мышью по карте

  end;

end;

procedure DefMatrA_And_MatrH;

 var i,j: Integer;

begin

 With Form1 do

  begin

   SetLength(a,n,n);

   SetLength(h,n,n);

   for i:=0 to n-1 do

    begin

     a[i,i]:=0;

     for j:=i+1 to n-1 do

      begin

       a[i,j]:= Dist1(Townes[i],Townes[j]); a[j,i]:= a[i,j];

       h[i,j]:= a[i,j]; h[j,i]:= a[i,j];

      end;

    end;

   OutMatr;

   SetLength(G,n);

   SetLength(GG1,n); // вспомогательный

   SetLength(GG2,n); // вспомогательный

   SetLength(f,n); // вспомогательный

   for i:=0 to n-1 do

    begin

     SortIntVec(h[i]);

     G[i]:= i;

    end;

   eG.Text:= GStr(G);

   DefRatios;

   DrawTownes;

   end;

end;

procedure TForm1.bDefAClick(Sender: TObject);

begin

 DefTownes;

 DefMatrA_And_MatrH;

 Buttons;

end;

function PathByG(G: TIntVec): Integer;

// путь от начальной до конечной вершин

 var i: Integer;

begin

 Result:=0;

 for i:=0 to n-2 do

  Result:= Result+a[g[i],g[i+1]];

end;

procedure RevIntN(var G: TIntVec; a,b: array of Integer);

// перестановка индексов городов

 var i,x: Integer;

begin

 for i:= 1 to Length(a) do

  begin

   x:= g[a[i-1]]; g[a[i-1]]:= g[b[i-1]]; g[b[i-1]]:= x;

  end;

end;

function Permutations(ShowMap: byte): boolean;

 // перестановки городов с целью минимизации пути

 var i,p: integer; Was,Was2: boolean; e: TIntVec;

 //***************************

 function Vspom: boolean;

 begin

  Result:= false;

  p:= PathByG(G);

  if p<FastMinPath then

   begin

    Result:= true;

    Permutations:= true;

    FastMinPath:= p;

    IntVecCopy(G,e);

    Was:= true;

    Was2:= true;

    if ShowMap=1 then OutOnMap(e,FastMinPath,ShowMap);

   end;

 end;

 //***************************

begin

 Result:= false;

 IntVecCopy(G,e);

 FastMinPath:= PathByG(G);

 repeat

  Was2:= false;

 if n>2 then

 repeat // перестановка по 2

  Was:=false;

  for i:=1 to n-3 do

   begin

    RevInt(G[i],G[i+1]);

    if not Vspom then RevInt(G[i],G[i+1]);

   end;

 until not Was;

 IntVecCopy(e,G);

 if n>3 then

 repeat

  Was:=false;

  // перестановка по 3

  for i:=1 to n-4 do

   begin

    RevIntN(g,[i,i+1,i+2],[i+1,i+2,i]);

     if not Vspom then RevIntN(g,[i,i+1,i+2],[i+1,i+2,i]);

    RevIntN(g,[i,i+1,i+2],[i+2,i,i+1]);

     if not Vspom then RevIntN(g,[i,i+1,i+2],[i+2,i,i+1]);

    RevIntN(g,[i,i+1,i+2],[i+2,i+1,i]);

     if not Vspom then RevIntN(g,[i,i+1,i+2],[i+2,i+1,i]);

    end;

 until not Was;

 IntVecCopy(e,G);

 {

 if n>4 then

 repeat

  Was:=false;

function FindMinPathOnDuga(i1,i2: Integer; var z: Integer): Integer; // z-номер города

 var i,d: Integer;

begin

 Result:= MaxInt; z:=-1;

 for i:= 1 to n-2 do

  if c[i]=0 then

   begin

    d:= a[G[i1],i]+a[i,G[i2]]-a[G[i1],G[i2]];

    if d<Result then

     begin Result:= d; z:= i; end;

   end;

end;

procedure GreedilyPath(ShowMap: byte);

// "жадный" метод расстановки городов

 var i,j,p,L,k,z: Integer; t: TIntVec;

begin

 if a=Nil then exit;

 SetLength(t,n);

 for i:=0 to n-1 do t[i]:=0;

 // самая близкая вершина к 0

 L:=0; // вершина с которой начинаем

 k:=0; // количество

 SetLength(g,n); g[0]:= 0; g[n-1]:= n-1;

 repeat

  Inc(k); // ищем следующую близкую к L

  p:= MaxInt; z:=-1;

  for j:= 1 to n-2 do

   if t[j]=0 then

    if a[L,j]<p then begin z:= j; p:= a[L,j]; end;

   g[k]:= z;

   t[z]:= 1;

   L:=z;

  until k = n-2;

  FastMinPath:= PathByG(G);

  OutOnMap(G,FastMinPath,ShowMap);

  t:= Nil;

end;

procedure TForm1.bGreedilyClick(Sender: TObject);

// жадный

begin

 GreedilyPath(0);

 CorrectRoute(G,1);

end;

procedure InsertToVec(var G: TIntVec; Place,iIns: Integer);

 var a: TIntVec; i: Integer;

begin

 SetLength(a,Length(G));

 a[Place]:= iIns;

 for i:= Place to Length(G)-2 do a[i+1]:= G[i];

 for i:= Place to Length(G)-1 do G[i]:= a[i];

 c[iIns]:=1; // включена

 a:= Nil;

end;

procedure WoodyPath(ShowMap: byte);

// способ расстановки городов по наименьшему уклонению расстояния от вершин дуги

 var i,L,MinAll,Min1,z,k1,z1: Integer;

begin

 SetLength(G,n);

 SetLength(c,n);

 for i:=0 to n-1 do c[i]:=0; // города не включены

 c[0]:= 1; c[n-1]:= 1;

 G[0]:= 0; G[1]:= n-1; // пока одна дуга и 2 города

 for L:= 3 to n do // включаем L-город

  begin

   MinAll:= MaxInt; k1:=0; z1:=0;

   for i:= 1 to L-2 do // по количеству дуг

    begin

     z:=0;

     Min1:= FindMinPathOnDuga(i-1,i,z); // z-номер города

     if Min1<MinAll then

      begin

       MinAll:= Min1;

       k1:= i-1; // на этой дуге наименьшее расстояние

       z1:= z; // этот город

      end;

    end;

   // включаем город z1 внутрь дуги k1, т.е. на место k1+1

   InsertToVec(G,k1+1,z1);

  end;

 z:= PathByG(G);

 OutOnMap(G,z,ShowMap);

end;

procedure TForm1.bWoodyClick(Sender: TObject);

 // деревянный

begin

 WoodyPath(0);

 CorrectRoute(G,1);

end;

procedure SimplePath(ShowMap: byte);

 // простейший

 var i: Integer;

begin

 SetLength(G,n);

 for i:=0 to n-1 do G[i]:=i;

 CorrectRoute(G,ShowMap);

end;

procedure TForm1.bSimpleClick(Sender: TObject);

 // простейший

begin

 SimplePath(1);

end;

procedure CombinAll(var pMin: Integer; Show: byte);

 // комбинация приближенныхе методов с улучшениями

 var p,m: Integer;

begin

 if a=Nil then exit;

 pMin:= MaxInt;

 for m:= 1 to 3 do

  begin

   Case m of

   1:    SimplePath(0);  // простейший

   2:    GreedilyPath(0);  // "жадный"

    else WoodyPath(0); // "деревянный"

    end;

   CorrectRoute(G,0);

   p:= PathByG(G);

   if p<pMin then begin pMin:= p; IntVecCopy(G,u); end;

  end;

 // вывод на карту

 IntVecCopy(u,G); u:= Nil;

 OutOnMap(G,pMin,Show);

end;

procedure TForm1.bCombinClick(Sender: TObject);

 // комбинация приближенныхе методов с улучшениями

begin

 CombinAll(pMin,1);

end;

// ---------- Случайные базовые маршруты и их улучшения ----------------------

function ExistsInIntVec(i: Integer; v: TIntVec): boolean;

 var n,j: Integer;

begin

 Result:= false; n:= Length(v)-1;

 if n>=0 then

  for j:=0 to n do

   if v[j]=i then

    begin Result:= true; exit; end;

end;

procedure CreateRandRoute;

 var i,z: Integer;

begin

 for i:=0 to n-1 do G[i]:= -1;

 G[0]:= 0; G[n-1]:= n-1;

 Randomize;

 for i:=1 to n-2 do

  begin

   repeat

    z:= Random(n-2)+1;

   until not ExistsInIntVec(z,G);

   G[i]:=z;

  end;

end;

procedure OutToTable(InListView: byte; Num,pIsh,pMin,m: Integer; t1,t2: TTime);

 var s: String; k: Integer;

begin

 With Form1.Lv do

  if InListView=1 then

  begin

   Items.Add;

   k:= Items.Count-1;

   Items[k].Caption:= IntToStr(Num);

   Items[k].SubItems.Add(IntToStr(pIsh));

   Items[k].SubItems.Add(IntToStr(pMin));

   if pIsh<>pMin then s:= RealToStr((pIsh-pMin)/pIsh*100,1) else s:='-';

   Items[k].SubItems.Add(s);

   Items[k].SubItems.Add(RealToStr(TimeToKdnTime(t2-t1),1));

   Items[k].SubItems.Add(IntToStr(m));

   Items[k].MakeVisible(true);

  end;

end;

procedure RandMany(Num: Integer; MaxSecTime: Integer; InListView: byte);

 var t1,t2,tMax: TTime; k,m,pMin,pIsh: Integer;

begin

 if not ProcessBoo then exit;

 CombinAll(pMin,1); // быстро все приближенные комбинации

 pIsh:= pMin; // длина по всем комбинациям

 IntVecCopy(G,f);

 tMax:= KdnTimeToTime(MaxSecTime); // максимальное время на вычисления

 t1:= Time; k:=0; m:=0;

 Curs(1);

 With Form1 do

  begin

 repeat

  CreateRandRoute;

  CorrectRoute(G,0);

  if CorrectPath<=pMin then

   begin

    if pMin<>CorrectPath then m:=1 else Inc(m);

    pMin:= CorrectPath;

    Inc(k);

    IntVecCopy(G,f);

    OutOnMap(G,pMin,1);

    eP.Text:= IntToStr(pMin)+' '

             +IntToStr(k)+'; '

             +IntToStr(m);

   end;

  Application.ProcessMessages;

 until not ProcessBoo or (Time-t1>tMax) or (m=5);

 t2:= Time;

 IntVecCopy(f,G);

 OutToTable(InListView,Num,pIsh,pMin,m,t1,t2);

 Curs(0);

 end;

end;

procedure TForm1.bRandClick(Sender: TObject);

begin

 ProcessBoo:= true;

 Buttons;

 RandMany(1,180,0);

 ProcessBoo:= false;

 Buttons;

end;

procedure TForm1.bManyClick(Sender: TObject);

 var i: Integer;

begin

 // статистические расчеты с выводом в ListView

 stN.Caption:= ' '+IntToStr(seN.Value)+' ';

 Lv.Items.Clear;

 ProcessBoo:= true;

 Buttons;

 for i:=1 to 12 do

  begin

   // новая матрица

   DefTownes;

   DefMatrA_And_MatrH;

   // расчет варианта

   RandMany(i,seMaxTime.Value,1);

  end;

 ProcessBoo:= false;

 Buttons;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

int I, J;

  for (I = 1; I < Desk->ColCount; I++)

    for (J = 1; J < Desk->RowCount; J++)

         Memo1->Lines->Add(Desk->Cells[I][J]);

 SaveDialog1->FileName=Put ;

if (SaveDialog1->Execute())end;

 Put=SaveDialog1->FileName  ;

 Memo1->Lines->SaveToFile(Put);

                           end;

else

 Memo1->Clear();

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

OpenDialog1->FileName=Put ;

if (OpenDialog1->Execute())

 Put=OpenDialog1->FileName  ;

 Memo1->Lines->LoadFromFile(Put);

                           begin

else

 Memo1->Clear();

     AnsiString g("O");

for (int i=0; i<8; i++)

  for(int j=0; j<8;j++)

    if (Memo1->Lines->operator [](i*8+j) == g )

        Desk->Cells[i+1][j+1] = g;

    else Desk->Cells[i+1][j+1]=' ';

  begin

end;

end.

Размещено на http://www.allbest.ru/