#!/usr/bin/perl
# race.pl - example script for MouseRace.pm
use MouseRace;
use strict; use warnings;
my $arena = new MouseRace(
x => 15,
y => 15,
no_draw => 0,
dump_arena => 0,
load_arena => 0
);
$arena->add_mouse( colour => "blue" );
# works with incorrect spelling as well :)
$arena->add_mouse( color => "red", solver => 'MouseRace::Random::solve' );
$arena->add_mouse( color => "green" );
$arena->run_mousy_run;
####
# MouseRace.pm - a mouse racing module.
package MouseRace;
use strict;
use warnings;
use Language::Logo;
use Data::Dumper;
sub new {
my %args = ( x => 15, y => 15 );
my ($class) = shift @_;
(%args) = ( %args, @_ );
my $self = bless \%args, $class;
my $backup_file=$self->{load_arena}=~/\D/?$self->{load_arena}:"ref.backup";
if ( $self->{load_arena} && -e $backup_file) {
$self = do $backup_file;
print "arena loaded\n";
}
else {
$self->{num_x} = $self->{x} + 1;
$self->{width} = 20 * $self->{num_x};
$self->{height} = 20 + 20 * $self->{y};
$self->{referee} = { maze => delete $self->{maze} };
$self->make_maze;
}
if ( $self->{dump_arena} &&! $self->{load_arena}) {
my $backup_file=$self->{dump_arena}=~/\D/?$self->{dump_arena}:"ref.backup";
delete $self->{dump_arena};
open( FH, ">$backup_file" );
print FH Data::Dumper->Dump( [$self] );
close FH;
die 'arena backed up' . $/;
}
print "Optimum: " . $self->{referee}->{optimum} . $/ x 2;
@{ $self->{mouse_positions} } = ( 20, 16, 24 );
$self->{directions} = {
1 => { name => "east", heading => "90" },
-1 => { name => "west", heading => "270" },
$self->{num_x} => { name => "south", heading => "180" },
-$self->{num_x} => { name => "north", heading => "0" },
};
for ( keys %{ $self->{directions} } ) {
$self->{directions}->{ $self->{directions}->{$_}->{name} } =
{ heading => $self->{directions}->{$_}->{heading}, next => $_ };
}
$self->draw_maze unless $self->{no_draw};
return $self;
}
sub make_maze {
my $self = shift;
my $ref = $self->{referee};
@{ $ref->{maze} } =
( ( 31, (15) x $self->{x} ) x $self->{y}, (31) x $self->{num_x} );
$ref->{position} = 0;
while ( !$ref->{finish} ) {
$ref->{maze}[ $ref->{position} ] |= 16;
@{ $ref->{choices} } =
grep /.$/ & !( $ref->{maze}[ $ref->{position} + $` ] & 16 ), -18, 11,
$self->{num_x} . 4, -$self->{num_x} . 2;
if ( scalar @{ $ref->{choices} } ) {
$ref->{choices}[ rand @{ $ref->{choices} } ] =~ /.$/;
push @{ $ref->{visited} }, $ref->{position};
$ref->{maze}[ $ref->{position} ] &= ~( 8 / $& );
$ref->{position} += $`;
$ref->{maze}[ $ref->{position} ] &= 15 - $&;
if ( $ref->{position} ==
( ( $self->{x} * ( $self->{y} + 1 ) ) - 1 ) )
{
$ref->{optimum}=(scalar( @{ $ref->{visited} } ) -1 )
}
if ( ++$ref->{total_visited} == ( $self->{x} * $self->{y} ) ) {
map { $_ &= 15 } @{ $ref->{maze} };
$ref->{maze}[0] = 31;
$ref->{position} = $ref->{finish} = 1;
}
}
else {
$ref->{position} = pop @{ $ref->{visited} };
}
}
}
sub draw_maze {
my $self = shift;
$self->{referee}->{logo} = new Logo(
update => 1,
width => $self->{width},
height => $self->{height}
);
$self->{referee}->{logo}->cmd(
"ht;xy 10 10;pd"
. (
(
";rt 90;fd "
. ( $self->{x} * 20 )
. ";rt 90;fd "
. $self->{y} * 20
) x 2
)
. ";bk 20;rt 90;"
);
$self->{referee}->{logo}->cmd(
$_ % $self->{num_x}
? ( $self->{referee}->{maze}[$_] & 2 ? "pd" : "pu" )
. ";fd 20;lt 90;"
. ( $self->{referee}->{maze}[$_] & 8 ? "pd" : "pu" )
. ";fd 20;bk 20;rt 90;"
: "pu;bk " . ( $self->{x} * 20 ) . ";rt 90; fd 20;lt 90;"
) for 1 .. ( $self->{num_x} * $self->{y} ) - 1;
}
sub add_mouse {
my %args = ( solver => 'MouseRace::DFS::solve', data => {} );
my $self = shift @_;
(%args) = ( %args, @_ );
my $mouse = \%args;
$mouse->{colour} ||= $mouse->{color};
if ( $#{ $self->{mice} } >= 2 ) {
print "EMOUSE : $mouse->{colour} dropped - mice limit (3) reached\n";
}
else {
my $solver_package = $mouse->{solver};
if ( $solver_package =~ s#\:\:[^:]+$## ) {
eval("require $solver_package") || die $@
if $mouse->{solver} =~ /::/;
}
else {
$mouse->{solver} = "main::$mouse->{solver}";
}
$mouse->{logo} = new Logo(
update => 50,
width => $self->{width},
height => $self->{height}
) unless $self->{no_draw};
# place mouse
my $mp = shift @{ $self->{mouse_positions} };
$mouse->{logo}
->command( "color " . $mouse->{colour} . ";xy $mp $mp;rt 90;ps 2;pd" )
if $mouse->{logo};
$mouse->{position} = 1;
$mouse->{heading} = 90;
push @{ $self->{mice} }, $mouse;
return $mouse;
}
}
sub run_mousy_run {
my $self = shift;
my $ref = $self->{referee};
$self->{finished} = 0;
while ( $self->{finished} < scalar( @{ $self->{mice} } ) ) {
$self->{counter}++;
for my $mouse ( @{ $self->{mice} } ) {
next if $mouse->{finished};
my $position = $mouse->{position};
my $options;
for (
my @a =
grep /.$/ & !( $ref->{maze}[ $position + $` ] & ( $& + 16 ) ),
-18, 11, $self->{num_x} . 4, -$self->{num_x} . 2
)
{
chop;
my $direction = $self->{directions}->{$_};
$options->{absolute}->{ $direction->{name} } = $_ + $position;
# set up relative directions;
my $diff = abs( $mouse->{heading} - $direction->{heading} );
$diff =
!$diff ? "forward"
: $diff == 180 ? "backward"
: $mouse->{heading} > $direction->{heading} ? "left"
: "right";
$options->{relative}->{$diff} = ( $_ + $position ) || 1;
$options->{backtrack}->{ $_ + $position } = $direction->{name};
}
my $next;
eval( '$next='
. $mouse->{solver}
. '($mouse->{data},$position,$options)' )
|| print $@
unless $mouse->{finished};
if ($next) {
if ( $options->{absolute}->{$next} ) {
#print "ab: $next $mouse->{position}\n";
$mouse->{heading} = $self->{directions}->{$next}->{heading};
$mouse->{position} += $self->{directions}->{$next}->{next};
if ( $mouse->{logo} ) {
$mouse->{logo}->cmd("sh $mouse->{heading};fd 20");
}
}
elsif ( $options->{relative}->{$next} ) {
my $dir_hash =
$self->{directions}
->{ $options->{relative}->{$next} - $mouse->{position} };
$mouse->{heading} = $dir_hash->{heading};
$mouse->{position} +=
$self->{directions}->{ $dir_hash->{name} }->{next};
if ( $mouse->{logo} ) {
$mouse->{logo}->cmd("sh $mouse->{heading};fd 20");
}
}
else {
print "ILLEGAL MOVE: $next; bad mouse ($mouse->{colour} at box $mouse->{position})\n";
}
if ( $mouse->{position} ==
( $self->{x} * ( $self->{y} + 1 ) ) - 1 )
{
print "$mouse->{colour} "
. ( !$self->{finished}++ ? "wins" : "finishes" )
. " in $self->{counter} moves\n";
$mouse->{finished}++;
#$mouse->{logo}->disconnect;
}
}
}
my $z;
select $z, $z, $z, 0.1 unless $self->{no_draw};
}
$self->{referee}->{logo}->disconnect("finished") unless $self->{no_draw};
}
1;
##
##
# MouseRace/DFS.pm - the default mouse solver routine - using depth first search
package MouseRace::DFS;
sub solve {
my ( $self, $current, $choices ) = @_;
$self->{visited}->{$current} = 1;
my @options =
grep { !$self->{visited}->{ $choices->{absolute}->{$_} } }
keys %{ $choices->{absolute} };
if (@options) {
push @{ $self->{path} }, $current;
$choice = $options[ rand @options ];
}
else {
my $back = pop @{ $self->{path} };
$choice = $choices->{backtrack}->{$back};
}
return $choice;
}
1;
##
##
# MouseRace/Random.pm - a random mouse solver
package MouseRace::Random;
sub solve {
my ( $self, $current, $choices ) = @_;
@choices = grep { !/backward/ } keys %{ $choices->{relative} };
return $choices[ rand @choices ] || "backward";
}
1;
##
##
# $data -> a data hash for use as a persistent scratch pad
# $current -> your current position (box #)
# $options -> these is a data structure containing your available moves.
##
##
{
'relative' => {
'left' => 165,
'backward' => 182
},
'absolute' => {
'north' => 165,
'east' => 182
},
'backtrack' => {
'182' => 'east',
'165' => 'north'
}
};
##
##
while($mouse_code_not_optimised){
$arena->add_mouse(solve=>$code_ref);
$arena->run_mousy_run;
optimise_code($code_ref);
}