in reply to Mouse Heuristic

The easiest way to do this is to use a reverse flood fill algorithm. Essentially, fill in the cheese square with distance 0. Fill in all adjecent squares with 1, ignoring squares that are already filled. Repeat with the squares you just filled in, and so on. Here's some code:

my @dist; &flood($cheese{x},$cheese{y},0); die "No route to cheese!" unless defined $dist[$mouse{x}][$mouse{y}]; sub flood { my ($x,$y,$dist) = @_; return if defined $dist[$x][$y] and $dist[$x][$y] < $dist; $dist[$x][$y] = $dist++; flood($x-1,$y,$dist) unless $map[$x-1][$y]; flood($x+1,$y,$dist) unless $map[$x+1][$y]; flood($x,$y-1,$dist) unless $map[$x][$y-1]; flood($x,$y+1,$dist) unless $map[$x][$y+1]; }

 
perl -e 'print "I love $^X$\"$]!$/"#$&V"+@( NO CARRIER'

Replies are listed 'Best First'.
Re: Re: Mouse Heuristic
by pope (Friar) on Jun 13, 2001 at 13:04 UTC
    Perfect, Chmrr! Eventually my mouse has learnt Something from you! :-)
    Took your snippet and modified it slightly to work with my code, now we have a smart mouse.

    Two options are now made available:
    -d for heuristic by distance, and -s for heuristic by smell, i.e. the reverse flood fill algorithm.
    Enjoy!

    #!/usr/bin/perl -w use strict; use vars qw($opt_d $opt_s); use Getopt::Std; getopts('ds'); 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 smell or distances if ($opt_s) { flood($cheese{y}, $cheese{x}, 0); die "No route to cheese!" unless defined $dist[$mouse{y}][$mouse{x +}]; } else { foreach my $row (0..$#map) { $dist[$row] = [map {($_ - $cheese{x})**2 + ($row - $cheese{y}) +**2} 0..$#{$map[$row]}]; } } sub flood { my ($y, $x, $dist) = @_; return if defined $dist[$y][$x] and $dist[$y][$x] < $dist; $dist[$y][$x] = $dist++; for (@dir) { flood($y + $_->[1], $x + $_->[0], $dist) unless $map[$y + $_-> +[1]][$x + $_->[0]]; } } 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_d && !$opt_s ? @dir : sort { $dist[$y + $a->[1]][$x + $a->[0]] <=> $dist[$y + $b->[1 +]][$x + $b->[0]] } ($opt_s ? grep /./, map { defined $dist[$y + $_->[1]] && defined $dist[$y + $_->[1]][$x ++ $_->[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;