frmmain.pas

模拟退火算法求解TSP问题.求解TSP问题的模拟退火算法

unit frmMain;

interface

uses
    Windows, SysUtils, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, Buttons, ExtCtrls, Grids, ValEdit, IdGlobal;
const
    MaxCityNum = 200;
    GraphRange = 400;
    Epsilon=1E-10;
type
    TIndex = Longint;
    TData = Extended;
    TFormMain = class(TForm)
        Graph: TImage;
        BitBtn1: TBitBtn;
        Info: TMemo;
        ValueList: TValueListEditor;
        Label1: TLabel;
        Label2: TLabel;
        Label3: TLabel;
    BitBtn2: TBitBtn;
        procedure BitBtn1Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    end;
    TPath = record
        City: array[1..MaxCityNum] of TIndex;
        Length: TData;
    end;
    TTSPSA = object
        Stop:Boolean;
        //Input Data
        City: array[1..MaxCityNum] of record
            x, y: TIndex;
        end;
        CityNum: TIndex; // City total number
        DataFile: WideString;

        //Cooling Schedule
        PrimeTemperature: TData; // Prime temperature
        DiminishedRate: TData; // Temperature diminish rate
        MarkovLength: TIndex; // Markov Length
        AIM_Limit: TIndex; // The condition for stopping search
        Diminish_Times_Limit: TIndex; //Used to control the temperature diminishing

        //Processing variable
        InitPath, BestPath: TPath;
        Distance: array[1..MaxCityNum, 1..MaxCityNum] of TData;
        AIM: TIndex;
        Diminish_Times: TIndex;
        Annealing_Times: TIndex;
        Temperature: TData;
        StartTime: Cardinal;
    private
        procedure GenerateData;
        procedure LoadDataFromFile;
        function GenerateNext(CurrentPath: TPath): TPath;
        function CalculateTotalDistance(const CurrentPath: TPath): TData;
        procedure Reverse(var CurrentPath: TPath; x, y: TIndex);
        procedure ShowState(Msg: WideString);
    public
        procedure Initialize(NewCityNum: TIndex);
        procedure SimulateAnealing;
        procedure DrawCurrentPath;
    end;
var
    FormMain: TFormMain;
    TSPSA: TTSPSA;

implementation

{$R *.dfm}

procedure TTSPSA.GenerateData;
var
    i, j: TIndex;
begin
    AssignFile(Output, 'data.txt');
    Rewrite(Output);
    for i := 1 to CityNum do
        with City[i] do
        begin
            x := Trunc(Random * GraphRange);
            y := Trunc(Random * GraphRange);
            Writeln(x, ' ', y);
        end;
    Close(Output);
    for i := 1 to CityNum do
        for j := 1 to CityNum do
            Distance[i, j] := Sqrt(Sqr(City[i].x - City[j].x) + Sqr(City[i].y - City[j].y));
end;

procedure TTSPSA.LoadDataFromFile;
var
    i, j: TIndex;
begin
    AssignFile(Input, DataFile);
    Reset(Input);
    for i := 1 to CityNum do
        with City[i] do
            Readln(x, y);
    Close(Input);
    for i := 1 to CityNum do
        for j := 1 to CityNum do
            Distance[i, j] := Sqrt(Sqr(City[i].x - City[j].x) + Sqr(City[i].y - City[j].y));
end;

procedure TTSPSA.Reverse(var CurrentPath: TPath; x, y: TIndex);
var
    i: TIndex;
    Tmp: TPath;
begin
    Tmp := CurrentPath;
    for i := x to y do
        CurrentPath.City[x + y - i] := Tmp.City[i];
end;

function TTSPSA.GenerateNext(CurrentPath: TPath): TPath;
var
    x, y: TIndex;
begin
    repeat
        x := Random(CityNum) + 1;
        y := Random(CityNum) + 1;
    until x <> y;
    Result := CurrentPath;
    if x < y then
        Reverse(Result, x, y)
    else
    begin
        Reverse(Result, 1, x);
        Reverse(Result, y, CityNum);
    end;
    Result.Length := CalculateTotalDistance(Result);
end;

function TTSPSA.CalculateTotalDistance(const CurrentPath: TPath): TData;
var
    i: TIndex;
begin
    Result := 0;
    for i := 1 to CityNum - 1 do
        Result := Result + Distance[CurrentPath.City[i], CurrentPath.City[i + 1]];
end;

procedure TTSPSA.Initialize(NewCityNum: TIndex);
var
    i: TIndex;
begin
    Randomize;
    CityNum := NewCityNum;
    if DataFile = '' then
        GenerateData
    else
        LoadDataFromFile;

    //Initialize the initial path 1,........,CityNum
    for i := 1 to CityNum do
        BestPath.City[i] := i;
    BestPath.Length := CalculateTotalDistance(BestPath);

    InitPath := BestPath;
    Temperature := PrimeTemperature;
    AIM := 0;
    ShowState('Generating Data...');
    Diminish_Times := 0;
    Annealing_Times := 0;
    StartTime := GetTickCount;
    ShowState('Annealing...');
    Stop:=true;
end;

procedure TTSPSA.ShowState(Msg: WideString);
begin
    FormMain.Info.Lines.Strings[0] := 'Number of city: ' + IntToStr(CityNum);
    FormMain.Info.Lines.Strings[1] := 'Initial distance: ' +
        CurrToStr(InitPath.Length);
    FormMain.Info.Lines.Strings[2] := 'Current distance: ' +
        CurrToStr(BestPath.Length);
    FormMain.Info.Lines.Strings[3] := 'Percent decrease: ' +
        CurrToStr(BestPath.Length / InitPath.Length * 100);
    FormMain.Info.Lines.Strings[4] := 'Annealing Times:' +
        IntToStr(Annealing_Times);
    FormMain.Info.Lines.Strings[5] := 'Current Temperature: ' +
        CurrToStr(Temperature);
    if Msg <> '' then
        FormMain.Info.Lines.Add(Msg);
    DrawCurrentPath;
    Application.ProcessMessages;
end;

procedure TTSPSA.SimulateAnealing;
var
    NewPath, CurrentPath: TPath;
    Distinction: TData;
    i: TIndex;
begin
    while not Stop do
    begin
        Inc(Annealing_Times);
        CurrentPath := BestPath;
        for i := 1 to MarkovLength do
        begin
            NewPath := GenerateNext(CurrentPath);
            Distinction := NewPath.Length - CurrentPath.Length;
            if Distinction < 0 then
            begin
                CurrentPath := NewPath;
                Diminish_Times := 0;
                AIM := 0;
            end
            else if Exp(-Distinction / Temperature) > Random then
            begin
                CurrentPath := NewPath;
                Inc(Diminish_Times);
            end
            else
                Inc(Diminish_Times);
            if CurrentPath.Length < BestPath.Length then
                BestPath := CurrentPath;

            if (AIM >= AIM_Limit)or(Temperature<Epsilon) then
            begin
                ShowState('Done in ' + IntToStr(GetTickCount - StartTime) + ' ms, Minimum: ' +
                    CurrToStr(BestPath.Length));
                Exit;
            end;
            if Diminish_Times >= Diminish_Times_Limit then
            begin
                Inc(AIM);
                Break;
            end;
        end;
        Temperature := Temperature * DiminishedRate;
        if Annealing_Times mod 3 = 0 then
            ShowState('');
    end;
end;

procedure TTSPSA.DrawCurrentPath;
var
    i: TIndex;
begin
    with FormMain.Graph do
    begin
        Canvas.Brush.Color := RGB(255, 255, 255);
        Canvas.FillRect(Rect(0, 0, GraphRange, GraphRange));
        Canvas.Brush.Color := RGB(0, 0, 0);
        Canvas.MoveTo(City[BestPath.City[1]].x, City[BestPath.City[1]].y);
        for i := 2 to CityNum do
            Canvas.LineTo(City[BestPath.City[i]].x, City[BestPath.City[i]].y);
        Canvas.LineTo(City[BestPath.City[1]].x, City[BestPath.City[1]].y);
        Canvas.Brush.Color := RGB(255, 0, 255);
        for i := 1 to CityNum do
            Canvas.Ellipse(City[BestPath.City[i]].x - 3, City[BestPath.City[i]].y
                - 3, City[BestPath.City[i]].x + 3, City[BestPath.City[i]].y +
                3);
    end;
end;

procedure TFormMain.BitBtn1Click(Sender: TObject);
begin
    BitBtn1.Enabled := false;
    TSPSA.PrimeTemperature := StrToCurr(ValueList.Values['PrimeTemperature']);
    TSPSA.MarkovLength := StrToInt(ValueList.Values['MarkovLength']);
    TSPSA.DiminishedRate := StrToCurr(ValueList.Values['DiminishedRate']);
    TSPSA.DataFile := Trim(ValueList.Values['DataFile']);
    TSPSA.AIM_Limit := StrToInt(ValueList.Values['AIM_Limit']);
    TSPSA.Diminish_Times_Limit :=
        StrToInt(ValueList.Values['Diminish_Times_Limit']);
    if (TSPSA.DataFile <> '') and not FileExists(TSPSA.DataFile) then
    begin
        ShowMessage('Data file doesn''t exist.');
        BitBtn1.Enabled := true;
        Exit;
    end;
    TSPSA.Initialize(StrToInt(ValueList.Values['CityNum']));
    TSPSA.SimulateAnealing;
    BitBtn1.Enabled := true;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
    Label3.Caption :=
        'TSPSA'#13#10
        + 'The Travelling Salesman Problem by Simulated Annealing'#13#10#13#10
        + 'Version: for the large-scale experiment'#13#10
        + 'Author: Amber - Amber Laboratory (http://adn.cn/)'
end;


procedure TFormMain.BitBtn2Click(Sender: TObject);
begin
    TSPSA.Stop:=not TSPSA.Stop;
    if not TSPSA.Stop then TSPSA.SimulateAnealing;
end;

end.