pope has asked for the wisdom of the Perl Monks concerning the following question:
Hi, I've just played with the famous mouse and cheese problem,
the Perl Way, of course. The code is shown below.
That needs a map file which represents the maze, and the positions of the mouse and the cheese. A sample map file could be like this:#!/usr/bin/perl -w use strict; use vars qw($opt_h); use Getopt::Std; getopts('h'); my @dir = ([0,-1],[1,0],[0,1],[-1,0]); my (@map, @mark, @dist); my (%mouse, %cheese); my $poss = 1; # initialize map while(<>) { chomp; push @map, [map { tr/#// } split //]; if (/M/) { $mouse{x} = length($`); $mouse{y} = $. - 1; } if (/C/) { $cheese{x} = length($`); $cheese{y} = $. - 1; } } # init dist foreach my $row (0..$#map) { $dist[$row] = [map {($_ - $cheese{x})**2 + ($row - $cheese{y})**2} + 0..$#{$map[$row]}]; } sub find_cheese { my ($x, $y) = @_; return if not $poss; $mark[$x][$y] = 1; print "X = $x, Y = $y\n"; $poss = 0 if ($x == $cheese{x} && $y == $cheese{y}); for ($opt_h? sort { $dist[$y + $a->[1]][$x + $a->[0]] <=> $dist[$y + $b->[1 +]][$x + $b->[0]] } @dir : @dir) { !$map[$y + $_->[1]][$x + $_->[0]] && !$mark[$x + $_->[0]][$y + $_->[1]] && find_cheese($x + $_->[0], $y + $_->[1]); } } find_cheese(@mouse{'x','y'}); print "Cheese found!!\n" if not $poss;
######################### # # # # # # # # # # # # ##### # # # # # ####### # # # # # # ### # # # # ######### # # # # # # #C # # # # # # #M# #########################The mouse is represented by M, and the cheese by C.
The script's output is the coordinates of route taken by the mouse. For the sake of convenience, I've also written a script which takes the output and displays a simple text-mode animation, using Term::ANSIScreen:
The heuristic I use to help the mouse is the distance from the cheese. But as we notice the result, this is not quite satisfactory. Therefore I'm looking for a better heuristic, which can guide the mouse to refuse taking misleading route, and to refuse searching(!) if the cheese is at an unreachable place.#!/usr/bin/perl -w use strict; use vars qw($opt_m); use Getopt::Std; use Term::ANSIScreen qw(:cursor :screen :color); $|++, cls; getopts('m:'); die "Please specify map file" unless $opt_m; { local @ARGV = $opt_m; locate; while(<>) { print } } while(<>) { if (/X = (\d+), Y = (\d+)/) { locate($2 + 1, $1 + 1); print colored(".", 'bold yellow'); select(undef, undef, undef, 0.25); } }
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Mouse Heuristic
by Masem (Monsignor) on Jun 12, 2001 at 15:17 UTC | |
by pope (Friar) on Jun 12, 2001 at 16:48 UTC | |
Re: Mouse Heuristic
by Corion (Patriarch) on Jun 12, 2001 at 15:26 UTC | |
Re: Mouse Heuristic
by Chmrr (Vicar) on Jun 12, 2001 at 19:16 UTC | |
by pope (Friar) on Jun 13, 2001 at 13:04 UTC | |
Re: Mouse Heuristic
by hiroki (Novice) on Jun 13, 2001 at 01:38 UTC |
Back to
Seekers of Perl Wisdom