package GridWorld;
##################################
# See the end of this file for the documentation in POD format.
####################################
use 5.008;
use strict;
use warnings;
require Exporter;
our $DEBUG=0;
our $VERSION = '0.01';	# Feb 3, 2002
use Clone;
our @ISA = qw(Exporter Clone);
# Uncomment these next two lines to enable "use GridWorld ':all';" syntax.
#  our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
#  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
# Variables to export automatically.  Use sparingly.
our @EXPORT = qw();
# ================================================================

my @defaultArgs = (
		   xSize	 => 8,
		   ySize	 => 8,
		   timeSteps	 => 20,	    # how long to run the world.
		   stuff         => '',	    # what to fill cells with
		   randomFill    => '',	    # if number, fraction to fill
		  );
my @directions  = qw( up down left right );

# -- Vacuum World specific ---------------------------------------

## actions for Vacuum agents.
#  my @actions    = qw( turnRight turnLeft suck forward wait );
#
## results of actions of Vacuum agents.
#  my @results    = qw( suck move )
#
## possible environment perceptions for Vacuum agents.
#my @perceptions = qw( dirt bump );
#

# Input:  reference ($percepts->{key}=value) hash of perceptions.
# Output: action taken (string)
sub defaultVacuumAgent {		# This one behaves randomly.
  my ($percepts) = @_;
  my @actions = ( qw( forward forward foward
		      turnRight turnLeft suck suck ) );
  return $actions[ randMinMax(0,scalar(@actions)-1) ];
}

# Input:  reference ($result->{key}=value) of results of actions.
# Output: numeric score for that result.
sub defaultVacuumPerformance {		# Similar to book's function.
  my ($result) = @_;
  return 100 if $result->{suck};
  return -1  if $result->{move};
  return 0;
}

# Inputs: %args with possible keys shown below. All are optional.
# Output: $report
sub runVacuumAgent {
  my ($self, %args) = @_;
  my ($xmax, $ymax) = ( $self->getXSize()-1, $self->getYSize()-1 );
  print " ** in runVacuumAgent, self='$self'\n" if $DEBUG;
  my $x		 = $args{'x'}	      || randMinMax(0,$xmax);
  my $y		 = $args{'y'}	      || randMinMax(0,$ymax);
  my $direction  = $args{direction}   || $directions[randMinMax(0,3)];
  print "  x,y,direction = $x, $y, $direction \n" if $DEBUG;
  my $agent      = $args{agent}       || \&defaultVacuumAgent;
  print "  agent = '$agent' \n" if $DEBUG;
  my $performance= $args{performance} || \&defaultVacuumPerformance;
  print "  perfomance = '$performance' \n" if $DEBUG;
  my $verbose	 = $args{verbose}     || 1;  # default is true.
  $verbose = '' if $verbose =~ /no/i;
  my $percept	 = {};
  my $result     = {};
  my $time       = 0;
  my $score	 = 0;
  my ($dx,$dy)   = figureDxDy($direction);
  while ($time < $self->getTimeSteps()){
    $time++;
    print "  t=$time at ($x,$y,$direction), " if $verbose;
    $percept->{dirt} =  ($self->getGrid($x,$y) eq 'dirt') ? 1 : 0;
    my $dirt = $percept->{dirt};
    print "percept=(" . ($dirt ? ' dirt ' : '')      if $verbose;
    print "" . ($percept->{bump} ? ' bump ' : '') . "), " if $verbose;
    my $action = &$agent($percept);	# <===== HERE'S THE AGENT CALL 
    print "action ='$action', " if $verbose;
    $result = {};		                        # reset results.
    print "  time, dirt, action = '$time', '$dirt', '$action'\n" if $DEBUG;
    print "  x,y,direction = '$x', '$y', '$direction'\n" if $DEBUG;
    for ($action){
      $direction = rightward($direction),          next if /turnRight/;
      $direction = leftward($direction),           next if /turnLeft/;
      $x+=$dx, $y+=$dy,         $result->{move}=1, next if /forward/;
      $self->setGrid($x,$y,''), $result->{suck}=1, next if /suck/ and $dirt;
    }
    ($dx,$dy) = figureDxDy($direction);			# recalcuate direction.
    $percept->{bump} = 0;				# reset bump.
    if ($x>$xmax) { $x=$xmax; $percept->{bump}=1; }	# set bump if off edge.
    if ($y>$ymax) { $y=$ymax; $percept->{bump}=1; }
    if ($x<0)     { $x=0;     $percept->{bump}=1; }
    if ($y<0)     { $x=0;     $percept->{bump}=1; }
    $score += &$performance($result);
    print "score=$score\n" if $verbose;
  }
  print "  Finished $time steps." if $verbose;
  print "  Total score = $score, average = " . $score/$time . "\n" if $verbose;
  return $score;
}


# --- These parts can probably be reused in other grid worlds. ------------

# Create a GridWorld object.
#  * To fill a fraction of them with dirt, 
#    pass in something like ( stuff => 'dirt', randomFill => 0.3 )
sub new {
  my ($class, @args) = @_;
  print " ** in GridWorld::new(), class='$class'\n" if $DEBUG;
  print "       args='@args' \n" if $DEBUG;
  my $self = {@defaultArgs, @args};
  bless $self, $class;
  init($self);
  return $self;
}

# Initialize the grid, i.e. erase and re-fill it.
sub init {
  my ($self)	= @_;
  print " ** in GridWorld::init(), self='$self' \n" if $DEBUG;
  $self->{grid} = [];		# make the old grid vanish.
  $self->gridLoop( \&fillCells );
}

# Fill every cell with some stuff.
# If randomFill is set, only put stuff in some cells, and put '' in the rest.
sub fillCells {
  my ($self, $x, $y) = @_;
  my $stuff = $self->getStuff();
  if (my $fraction = $self->getRandomFill()) {
    if (rand() < $fraction) {
      $self->setGrid($x,$y,$stuff);
    }
    else {
      $self->setGrid($x,$y,'');
    }
  }
  else {
    $self->setGrid($x,$y, $stuff);
  }
}
# Apply a function &func($self,$x,$y) to each point of the grid.
sub gridLoop {
  my ($self, $func) = @_;
  print " ** in GridWorld::gridLoop()\n" if $DEBUG;
  print "    self='$self', func='$func'\n" if $DEBUG;
  my ($x,$y);
  my ($xsize,$ysize) = ($self->getXSize(), $self->getYSize());
  print "    (xsize,ysize)=('$xsize','$ysize')\n" if $DEBUG;
  print " in gridLoop - self = '" . $self . "'\n" if $DEBUG;
  for ($x=0; $x<$xsize; $x++) {
    for ($y=0; $y<$ysize; $y++) {
      &$func($self,$x,$y);
    }
  }
}
# get/set grid cells.
#   $grid->setGrid($x,$y,$value);
#   $foo = $grid->getGrid($x,$y);
sub setGrid {
  my ($self, $x, $y, $value) = @_;
  print " in setGrid (x,y)=($x,$y), value='$value'\n" if $DEBUG;
  $self->{grid}[$x][$y] = $value;
}
sub getGrid {
  my ($self, $x, $y) = @_;
  return $self->{grid}[$x][$y];
}

# (dx,dy) from (right,left,up,down)
sub figureDxDy {
  for (my ($direction) = @_) {
    return ( 1,0) if /right/;
    return (-1,0) if /left/;
    return ( 0,1) if /up/;
    return (-1,0) if /down/;
  }
}
# turning the direction
sub leftward {
  for (my ($direction) = @_) {
    return 'left'  if /up/;
    return 'down'  if /left/;
    return 'right' if /down/;
    return 'up'    if /right/;
  }
}
sub rightward {
  for (my ($direction) = @_) {
    return 'right' if /up/;
    return 'down'  if /right/;
    return 'left'  if /down/;
    return 'up'    if /left/;
  }
}

# Return a integer random between min and max, inclusive.
sub randMinMax {
  my ($min, $max) = @_;
  return int(rand($max-$min+1))+$min;
}

# Define generic set(param=>'value') and get('param') methods.
sub set {
  my ($self, $param, $value) = @_;
  $self->{$param} = $value;
}
sub get {
  my ($self, $param) = @_;
  return $self->{$param};
}
# Define methods setFoo() and GetFoo() for any parameter "foo".
sub AUTOLOAD {
  my ($self, @args) = @_;
  my ($setget, $param);
  our $AUTOLOAD;
  return if $AUTOLOAD =~ /::DESTROY$/;
  #print "AUTOLOAD = '$AUTOLOAD'\n"; exit;
  if ( ($setget, $param) = $AUTOLOAD =~ m/::(set|get)(.+)$/g ) {
    no strict 'refs';
    $param=lcfirst($param);
    if ($setget eq 'get'){
      *$AUTOLOAD = sub { my ($self) = @_; return $self->{$param}; };
    }
    else {
      *$AUTOLOAD = sub { my ($self,$value) = @_; $self->{$param}=$value; };
    }
    goto &$AUTOLOAD;
  }
  else {
    die qq{Oops - Can't locate object method "$AUTOLOAD" } .
        qq{via package "GridWorld"};
  }

}

1;
__END__
# ====== Documentation in POD format ============================

=head1 NAME

GridWorld - an environment to run intelligent agents.

=head1 SYNOPSIS

  use GridWorld;
  my $grid = new GridWorld( xSize => 8, ySize => 8,
			    stuff => 'dirt', dirtFraction => 0.3);
  $grid->runVacuumAgent( verbose=>1 );

=head1 ABSTRACT

 An environment to run intelligent agents.


=head1 DESCRIPTION

Runs a simple AI vacuum cleaner "agent" in a checkerboard world 
with dirt on some of the squares.  

Here's an example of an agent.

 # Input:  reference ($percepts->{key}=value) hash of perceptions.
 # Output: action taken (string)
 sub reflexAgent {
   my ($percept) = @_;
   return 'suck'					if $percept->{dirt};
   return (qw(turnLeft turnRight))[int(rand(2))] if $percept->{bump};
   return (qw( forward forward forward 
 	      turnRight turnLeft ))[ int(rand(5)) ];
 }

And here's an example of a "performance measure" used
to evaluate the agent's performance.

 # Input:  reference ($result->{key}=value) of results of actions.
 # Output: numeric score for that result.
 sub performanceMeasure {
   my ($result) = @_;
   return 100 if $result->{suck};
   return -1  if $result->{move};
   return 0;
 }

References to both of these routines may be specified in 
the runVacuumAgent call.  The key => value pairs which
may be passed are

 runVacuumAgent( x => $startX, y => $start, 
		 direction   => $startDirection,
		 agent       => \&agentFunction, 
		 performance => \&performanceFunction,
		 verbose     => 'yes' (the default) or 'no'
	       );

The directions are (left, right, up or down).

Actions are (forward, turnRight, turnLeft, suck, wait).

Results of actions, passed to the performanceMeasure function,
are (suck, move).

=head2 EXPORT

None.

=head1 SEE ALSO

Artificial Intelligence: A Modern Approach, 
by Stuart Russel and Peter Norvig, chapter 2.

=head1 AUTHOR

Jim Mahoney, E<lt>mahoney@marlboro.edu<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2003 by Jim Mahoney

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut
