perl语言编写模拟退火算法 求解TSP问题

      使用启发式算法就求解旅行商（TSP）问题是一种现在较常使用的算法，但大多启发式算法程序都是用C或JAVA编写的，还很少有看到用perl编写的源码，所以有些使用Perl的朋友常常为找不到模板而发愁。我是一名在校学生，正好趁最近在学习模拟退火算法，并且喜欢用Perl语言编写，我把写好的程序张贴出来晒晒，希望谢谢大家多多指教！

 

此外，我从TSPLIB（http://comopt.ifi.uni-heidelberg.de/software/TSPLIB95/）下载了一个eil51问题作为测试。

 

源码及其相关问题下载：http://download.csdn.net/source/2208441

 

#!/user/bin/perl
# Author:  WYF
# E-mail:  [e-mail]
# Date:    2010-03-31
# ===========================================================================
# Simulated Annealing Algorithm for TSP problem
# ===========================================================================

use strict;
use warnings;

my $project_name;#问题的命名
my $temperature;#初始温度
my $outcycle;#外循环次数
my $innercycle;#内循环次数


print "/n===========================================================================/n";
print "                     模拟退火算法求解旅行商问题(TSP)                       /n";
print "===========================================================================/n/n";

print "请键入一个问题的名字:";
chomp ($project_name=<STDIN>);
print "请输入初始温度:";
chomp ($temperature=<STDIN>);
print "请输入退火的次数(外循环次数):";
chomp ($outcycle=<STDIN>);
print "请输入每次退火产生随机的次数(内循环次数):";
chomp ($innercycle=<STDIN>);

print "/n=============================请稍等，正在处理中============================/n/n";
#主程序
my $file=$ARGV[0];
my %city_distant=();#存储城市之间的距离
my $city_numbers=0;#存储城市的数目
&Distant();
my @array = &GenerateInitialSolution();
my $min_length = &cost(@array);

my @best_cycle=();#最佳的城市访问顺序
for (my $i=0;$i<$outcycle;$i++) {
    for (my $j=0;$j<$innercycle;$j++) {
        @best_cycle = &PickAtRandom(@array);
        @array = &AcceptWithProbability($temperature,/@array,/@best_cycle);#将数组作为参数传入
        my $length = &cost(@array);
        if ($length < $min_length) {
            $min_length = $length;
        }
    }
    $temperature *= 0.95;
}

open (OUT,">F:/opt_tour.fa");# || die "cannot write opt_tour.fa./n";
    print OUT "问题:$project_name/n";
    print OUT "本次实验的最短距离为:$min_length/n";
    print OUT "本次实验的最佳访问途径:/n";
    print OUT "TOUR_SECTION:/n";
    foreach my $a (@best_cycle) {
        print OUT "$a/n";
    }
    print OUT "EOF/n";
close (OUT);

print "本次实验的最短距离为:$min_length/n";
print "本次实验的最佳路径为:(保存在F://opt_tour.fa)/n";

print "/n===========================================================================/n";
print "      谢谢您的使用，如果结果不理想，请增加内循环和外循环的次数再试一次     /n";
print "===========================================================================/n";

sub Distant () {
    my %city_position=();
    open (FILE,$file) || die "can't open $file !";
    while (<FILE>) {
        chomp;
        if (/^(/d)+/) {    # 每行以数字开头即为城市的坐标，第一列为城市编号，第二列为x坐标，第三列为y坐标
            my ($a1,$a2,$a3) = split (/ /,$_,3);
            $city_position{$a1} = $a2."/t".$a3 ;
            $city_numbers++;
        }
    }
    close (FILE);
    # 通过城市坐标计算各个城市之间的距离，并将结果存入%city_distant中
    for (my $i=1 ; $i<=$city_numbers ; $i++) {
        for (my $j=1 ; $j<=$city_numbers ; $j++) {
            if ($i == $j) {
                $city_distant{$i."/t".$j} = 0;
            }else {
                my ($xi,$yi) = split (//t/,$city_position{$i},2) ;
                my ($xj,$yj) = split (//t/,$city_position{$j},2) ;
                $city_distant{$i."/t".$j} = sqrt(($xi-$xj)*($xi-$xj)+($yi-$yj)*($yi-$yj));
            }
        }
    }
}


sub GenerateInitialSolution () {
    my @temp_array = 1..$city_numbers; # 产生一个备用的数组，避免重复构建初始的解 Note:$city_numbers的产生必须要先运行Distant ()
    my @initial_city_cycles = ();
    my $array_length = @temp_array;
    my $pos=0;
    while ($array_length != 0) {
        my $index = int rand ($array_length);
        my $city = $temp_array[$index]; # 将该位置的数组元素删除，并把这个删除的元素值赋给$city
        splice (@temp_array,$index,1);
        $initial_city_cycles[$pos] = $city ;
        $pos++;
        $array_length = @temp_array;
    }
    return @initial_city_cycles; # 返回值
}


sub PickAtRandom () { #使用swap方法进行领域结构变换
    my @new_cycle = @_;
    my $number = @new_cycle;
    my $indexfrom = int rand ($number);
    my $indexto = int rand ($number);
    my $temp = $new_cycle[$indexfrom];
    $new_cycle[$indexfrom] = $new_cycle[$indexto];
    $new_cycle[$indexto] = $temp;
    return @new_cycle;
}


sub cost () { #计算按访问城市顺序所需的路程
    my @cycle = @_;
    my $cost=0;
    my $number = @cycle;
    for (my $i=0;$i<$number-1;$i++) {
        my $from = $cycle[$i];
        my $to = $cycle[$i+1];
        $cost += $city_distant{$from."/t".$to};
    }
    my $cycle_start = $cycle[0];
    my $cycle_end = $cycle[$number-1];
    $cost += $city_distant{$cycle_end."/t".$cycle_start};
    return $cost;
}



sub AcceptWithProbability () {
   
    my @accept_cycle=();
   
   
    my ($t,$arrayold,$arraynew) = @_;
    my @arrayold = @$arrayold;
    my @arraynew = @$arraynew;
   
    my $costold = &cost(@arrayold);
    my $costnew = &cost(@arraynew);
    my $delta = $costnew - $costold;
    if ($delta < 0) {
        @accept_cycle = @arraynew;
    }else {
        my $p = 1/exp($delta/$t);#以一定的概率接受劣质解，以避免产生局部解
        my $r = int rand () ;
        if ($r < $p) {
            @accept_cycle = @arraynew;
        }else {
            @accept_cycle = @arrayold;
        }
       
    }
    return @accept_cycle;
}

__END__

 欢迎到我的个人网站一起探讨

http://justhinking.org

#转载需标明出处