view release on metacpan or  search on metacpan

lib/Algorithm/Metric/Chessboard.pm  view on Meta::CPAN

horizontal, vertical or diagonal neighbour.

With no other features, the number of moves taken to go from
the point C<(x1, y1)> to C<(x2, y2)> I<would> be quite simple:

  d( (x1, y1), (x2, y2) ) = max( abs( x1 - x2 ), abs( y1 - y2) )

However within the space are "wormholes" which allow you to travel
between any two distant points, so the actual number of moves may be
smaller than the above.  Wormhole travel costs a fixed number of moves.

=head1 SYNOPSIS

  my @wormholes = (
    Algorithm::Metric::Chessboard::Wormhole->new( x => 5, y => 30 ),
    Algorithm::Metric::Chessboard::Wormhole->new( x => 98, y => 99 ),
  );

  my $grid = Algorithm::Metric::Chessboard->new(
                                   x_range       => [ 0, 99 ],
                                   y_range       => [ 0, 99 ],
                                   wormholes     => \@wormholes,
                                   wormhole_cost => 3,
                                               );

  my $wormhole = $grid->nearest_wormhole( x => 26, y => 53 );

  my $journey = $grid->shortest_journey(start => [1, 6], end => [80, 1]);

=head1 METHODS

=over

=item B<new>

  my @wormholes = (
    Algorithm::Metric::Chessboard::Wormhole->new(
                                                  x => 5,
                                                  y => 30,
                                                ),
    Algorithm::Metric::Chessboard::Wormhole->new(
                                                  x => 98,
                                                  y => 99,
                                                ),
  );

  my $grid = Algorithm::Metric::Chessboard->new(
                                   x_range       => [ 0, 99 ],
                                   y_range       => [ 0, 99 ],
                                   wormholes     => \@wormholes,
                                   wormhole_cost => 3,
                                               );

C<wormholes> is optional.  C<wormhole_cost> defaults to 0.

=cut

sub new {
    my ($class, %args) = @_;
    my $self = {};
    bless $self, $class;
    $self->x_range( $args{x_range} ) or croak "Bad 'x_range'";
    $self->y_range( $args{y_range} ) or croak "Bad 'y_range'";
    $self->wormholes( $args{wormholes} );
    $self->wormhole_cost( $args{wormhole_cost} );
    $self->calculate_wormhole_dists;
    return $self;
}

=item B<nearest_wormhole>

  my $wormhole = $grid->nearest_wormhole( x => 26, y => 53 );
  print "Nearest wormhole is " . $wormhole->id . " at ("
        . $wormhole->x . ", " . $wormhole->y . ")";

Returns a L<Algorithm::Metric::Chessboard::Wormhole> object.

=cut

sub nearest_wormhole {
    my ($self, %args) = @_;
    return $self->{nearest_wormhole}[$args{x}][$args{y}];
}

=item B<shortest_journey>

  my $journey = $grid->shortest_journey(
                                         start => [1, 6],
                                         end   => [80, 1],
                                       );
  my $distance = $journey->distance;
  my @via = $journey->via;
  print "Shortest journey is $distance move"
        . ( $distance == 1 ? "" : "s" );
  if ( scalar @via ) {
      print " via " . $via[0]->id . " and " . $via[1]->id;
  }

Returns a L<Algorithm::Metric::Chessboard::Journey> object.

=cut

sub shortest_journey {
    my ($self, %args) = @_;
    my ($start, $end) = @args{ qw( start end ) };
    my $straight_dist = $self->straight_distance(
                                                  start => $start,
                                                  end   => $end,
                                                );
    my $start_worm = $self->nearest_wormhole(
                                              x => $start->[0],
                                              y => $start->[1]  );
    my $end_worm   = $self->nearest_wormhole(
                                              x => $end->[0],
                                              y => $end->[1]  );
    if ( $start_worm and $end_worm ) {
        my $worm_dist = $self->straight_distance(
                                  start => $start,
                                  end   => [ $start_worm->x, $start_worm->y ]
                                                )
                      + $self->wormhole_cost