はじめに
巡回セールスマン問題の解法をPythonで解説しているサイトがあったので、Perlに移植してみたメモ。
「TSP を「欲張り法」で解く」をPerlで
- Tkまわりは省略
- 割とそのまま移植できた
- 実行結果も元サイトの通りになった
#!/usr/bin/perl
use strict;
use warnings;
use Time::HiRes qw(gettimeofday tv_interval);
use Data::Dumper;
sub read_data {
my $buff = [];
while (my $line = <STDIN>) {
my @vals = split /\s+/, $line;
push @$buff, \@vals;
}
return $buff;
}
sub distance {
my $ps = shift;
my $max = $#{$ps};
my $table = [ map { [0] } @$ps ];
for my $i (0..$max) {
for my $j (0..$max) {
if ($i != $j) {
my $dx = $ps->[$i]->[0] - $ps->[$j]->[0];
my $dy = $ps->[$i]->[1] - $ps->[$j]->[1];
$table->[$i]->[$j] = sqrt($dx ** 2 + $dy ** 2);
}
}
}
return $table;
}
sub path_length {
my ($path, $distance_table) = @_;
my $n = 0;
for my $i (1..$#{$path}) {
$n += $distance_table->[$path->[$i - 1]]->[$path->[$i]];
}
$n += $distance_table->[$path->[0]]->[$path->[-1]];
return $n;
}
sub greedy0 {
my ($size, $distance_table) = @_;
my @path = (0 .. $size-1);
for my $i (0 .. $size-2) {
my $min_len = 1000000;
my $min_pos = 0;
for my $j ($i+1 .. $size-1) {
my $len = $distance_table->[$path[$i]]->[$path[$j]];
if ($len < $min_len) {
$min_len = $len;
$min_pos = $j;
}
}
($path[$i + 1], $path[$min_pos]) = ($path[$min_pos], $path[$i + 1]);
}
return \@path;
}
sub main {
my $start = [gettimeofday];
my $point_table = read_data();
my $point_size = scalar(@$point_table);
my $distance_table = distance($point_table);
my $path = greedy0($point_size, $distance_table);
my $path_len = path_length($path, $distance_table);
my $end = [gettimeofday];
my $spend = tv_interval $start, $end;
print Dumper $path;
printf "\nlen:%d\ntime:%s\n", $path_len, $spend;
}
main();
=head1 USAGE
perl SCRIPT_NAME < DATA_FILE
=head1 DATA FILE FORMAT
position1 [space] position2
=head1 DATA FILE EXAMPLE
20 20
120 20
220 20
70 120
170 120
270 120
20 220
120 220
「クラスカルのアルゴリズムの変形版で解く」をPerlで
- Tkまわりは省略
- PQueue を List::PriorityQueue で置き換えた(要インストール)
- UnionFind を Graph::UnionFind で置き換えた(要インストール)
- 変更した部分の影響か、元サイトよりも若干結果が悪くなった
#!/usr/bin/perl
use strict;
use warnings;
use lib "./extlib/lib/perl5/";
use Time::HiRes qw(gettimeofday tv_interval);
use Data::Dumper;
use List::PriorityQueue;
use Graph::UnionFind;
sub read_data {
my $buff = [];
while (my $line = <STDIN>) {
my @vals = split /\s+/, $line;
push @$buff, \@vals;
}
return $buff;
}
sub distance {
my $ps = shift;
my $max = $#{$ps};
my $table = [ map { [0] } @$ps ];
for my $i (0..$max) {
for my $j (0..$max) {
if ($i != $j) {
my $dx = $ps->[$i]->[0] - $ps->[$j]->[0];
my $dy = $ps->[$i]->[1] - $ps->[$j]->[1];
$table->[$i]->[$j] = sqrt($dx ** 2 + $dy ** 2);
}
}
}
return $table;
}
sub path_length {
my ($select_edge, $distance_table) = @_;
my $n = 0;
for my $edge (@$select_edge) {
my ($p1, $p2) = split /,/, $edge;
$n += $distance_table->[$p1]->[$p2];
}
return $n;
}
sub make_edge {
my ($size, $distance_table) = @_;
my $edges = new List::PriorityQueue;
for my $i (0 .. $size-2) {
for my $j ($i+1 .. $size-1) {
my $edge = sprintf "%d,%d", $i, $j;
my $priority = $distance_table->[$i]->[$j];
$edges->insert($edge, $priority);
}
}
return $edges;
}
sub greedy1 {
my ($size, $edges) = @_;
my @edge_count = map { 0 } (0 .. $size-1);
my $u = Graph::UnionFind->new;
for my $n (0 .. $size-1) {
$u->add($n);
}
my $i = 0;
my @select_edge;
while ($i < $size) {
my $edge = $edges->pop();
my ($p1, $p2) = split /,/, $edge;
if (
$edge_count[$p1] < 2 &&
$edge_count[$p2] < 2 &&
( $u->find($p1) != $u->find($p2) || $i == $size -1 )
) {
$u->union($p1, $p2);
$edge_count[$p1] += 1;
$edge_count[$p2] += 1;
push @select_edge, $edge;
$i += 1;
}
}
return \@select_edge;
}
sub main {
my $start = [gettimeofday];
my $point_table = read_data();
my $point_size = scalar(@$point_table);
my $distance_table = distance($point_table);
my $edges = make_edge($point_size, $distance_table);
my $select_edge = greedy1($point_size, $edges);
my $path_len = path_length($select_edge, $distance_table);
my $end = [gettimeofday];
my $spend = tv_interval $start, $end;
print Dumper $select_edge;
printf "\nlen:%d\ntime:%s\n", $path_len, $spend;
}
main();
=head1 USAGE
perl SCRIPT_NAME < DATA_FILE
=head1 DEPENDENCY LIBRARY INATALL
cpanm -l ./extlib List::PriorityQueue
cpanm -l ./extlib Graph::UnionFind
=head1 DATA FILE FORMAT
position1 [space] position2
=head1 DATA FILE EXAMPLE
20 20
120 20
220 20
70 120
170 120
270 120
20 220
120 220