巡回セールスマン問題をPerlで(2)
はじめに
前回の巡回セールスマン問題をPerlで - nirasan's tech blogで、巡回セールスマン問題の解法をPythonからPerlに移植しましたが、Tkまわりは省略しました。
今回はTkのインストールとTkまわりのコードを移植を行います。
Tkの実行テスト
SYNOPSIS の通りに下記のコードを実行すると、空のウィンドウが表示されます。
use Tk; $top = new MainWindow; MainLoop;
欲張り法スクリプトのTk対応
- draw, draw_path 関数を追加し、 main から呼び出すように変更しました。
#!/usr/bin/perl use strict; use warnings; use Time::HiRes qw(gettimeofday tv_interval); use Data::Dumper; use Tk; use List::Util qw(max); sub read_data { my $buff = []; while (my $line = <STDIN>) { my @vals = split /\s+/, $line; push @$buff, \@vals; } return $buff; } sub distance { my $ps = shift; # [ [x, y], .. ] 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 draw { my ($path, $point_table) = @_; my $top = new MainWindow; my $max_x = max map { $point_table->[$_]->[0] } @$path; my $max_y = max map { $point_table->[$_]->[1] } @$path; my $canvas = $top->Canvas( -width => $max_x + 20, -height => $max_y + 20 )->pack(); draw_path($canvas, $path, $point_table); MainLoop; } sub draw_path { my ($canvas, $path, $point_table) = @_; my ($x0, $y0) = ($point_table->[$path->[0]]->[0], $point_table->[$path->[0]]->[1]); for my $i (1 .. $#{$path}) { my $p = $point_table->[$i]; my ($x1, $y1) = ($p->[0], $p->[1]); $canvas->createLine($x0, $y0, $x1, $y1); ($x0, $y0) = ($x1, $y1); } my $p0 = $point_table->[0]; $canvas->createLine($x0, $y0, $p0->[0], $p0->[1]); for my $p (@$point_table) { my ($x, $y) = ($p->[0], $p->[1]); $canvas->createOval($x-4, $y-4, $x+4, $y+4, -fill => 'green' ); } } 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; draw($path, $point_table); } main(); __END__ =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
クラスカルのアルゴリズムの変形版スクリプトのTk対応
- 同様に draw, draw_path 関数を追加し、 main から呼び出すように変更しました。
#!/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; use Tk; use List::Util qw(max); sub read_data { my $buff = []; while (my $line = <STDIN>) { my @vals = split /\s+/, $line; push @$buff, \@vals; } return $buff; } sub distance { my $ps = shift; # [ [x, y], .. ] 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 draw { my ($select_edge, $point_table) = @_; my $top = new MainWindow; my $max_x = max map { $_->[0] } @$point_table; my $max_y = max map { $_->[1] } @$point_table; my $canvas = $top->Canvas( -width => $max_x + 20, -height => $max_y + 20 )->pack(); draw_path($canvas, $select_edge, $point_table); MainLoop; } sub draw_path { my ($canvas, $select_edge, $point_table) = @_; for my $edge (@$select_edge) { my ($p1, $p2) = split /,/, $edge; my ($x0, $y0) = ($point_table->[$p1]->[0], $point_table->[$p1]->[1]); my ($x1, $y1) = ($point_table->[$p2]->[0], $point_table->[$p2]->[1]); $canvas->createLine($x0, $y0, $x1, $y1); } for my $p (@$point_table) { my ($x, $y) = ($p->[0], $p->[1]); $canvas->createOval($x-4, $y-4, $x+4, $y+4, -fill => 'green' ); } } 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; draw($select_edge, $point_table); } main(); __END__ =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