path: root/challenge-118/duane-powell/perl/ch-2.pl

#!/usr/bin/perl
use warnings;
use strict;
use feature 'say';

=pod
    Problem: 
    https://perlweeklychallenge.org/blog/perl-weekly-challenge-118/ TASK #2

    Approach: 
    Generate all Knight moves, search via stochastic recursion at each ply, prune out obsolete paths. 
   
    Result: 
    This is script reports, in Chess notation, the best path.
    If more than one path exists it returns the first path found. 
=cut

# Slow down so we can watch the Knight move around the board 
my $sleep = shift || 0;

# Knight $N, Treasure $T, Empty $E
my ($N,$T,$E) = ('N','x','0');

# Let's go on a new Adventure!
my $AoK = AdventureOfKnight->new();

# Place Knight and Treasure on the board
$AoK->piece_put($N,1,8);
my $treasure_list = [[1,2],[2,1],[2,2],[2,3],[3,4],[5,6]]; 
#my $treasure_list = [[2,6],[3,4],[4,2],[5,4],[6,6],[7,8],[8,6],[6,5],[4,4],[2,3],[1,1]]; 
#my $treasure_list = [[1,4],[2,4],[3,4],[4,4],[5,4],[6,4],[7,4],[8,4]]; 
$AoK->piece_put($T,$_->[0],$_->[1]) foreach ( @{$treasure_list} );

# Render starting board postion
my $board = $AoK->board_render();
say $board;

# Find the shortest path to all the treasure
$AoK->shortest_path_find();

# Say best solution 
$AoK->best_path_say($board,1);
exit;


package AdventureOfKnight;
# use Data::Dumper; 
sub new {
    my $class = shift;
    my $self = {
        # Current location of Knight
        file => 0,
        rank => 0,

        # Count of treasure items
        treasure_count => 0,

        # Nested array ref indexed by file and rank, 
        # representing the state of the board, $self->{squares}[$f][$r]
        squares => [], 

        # Hash of unique board positions seen, so
        # we can short circuit recursion. 
        board_pos => {},

        # Nested array ref of moves representing current path.
        # A move is a array ref [a,b,c,d,x] where a,b is from square,
        # c,d is target square and x is capture of treasure.
        this_path => [],

        # Best solution found 
        best_path => [],
    };

    # init board to empty squares
    foreach my $r (1..8) {
        foreach my $f (1..8) {
            $self->{squares}[$f][$r] = "$E";
        }
    }

    bless $self, $class;
    return $self;
}
sub shortest_path_find {
    my $self = shift;

    # Note initial board position 
    $self->board_position_visited();

    # Recurse 
    $self->shortest_path_recurse();
}        

sub shortest_path_recurse {
    my $self = shift;

    my @move = $self->knight_moves_get();
    while (@move) {
        # Random, stochastic search 
        my $r = int(rand(scalar @move)); 
        my $move = $move[$r];
        splice @move, $r, 1;

        # Move the knight.
        $self->knight_move($move);

        # Update best path if no treasure remains on a shorter path
        if (not $self->treasure_exists() and $self->this_path_is_shorter()) {
            # copy this_path to best_path, don't forget to deference before copy
            my @this_path = @{$self->{this_path}};
            $self->{best_path} = \@this_path;
        }

        # Render and sleep so we can see the Knight move around
        my $board = $self->board_render();
        $AoK->best_path_say($board);
        sleep $sleep; 

        # Only recurse if: we have not visited this postion before and this path is shorter than best path so far
        $self->shortest_path_recurse() if ( not $self->board_position_visited() and $self->this_path_is_shorter() );

        # Undo Knight move and try another
        $self->knight_move_undo($move);
    }
}
sub treasure_exists {
    my $self = shift;
    return $self->{treasure_count} > 0;
}
sub this_path_is_shorter {
    my $self = shift;
    return (scalar @{$self->{this_path}} < scalar @{$self->{best_path}} or scalar @{$self->{best_path}} == 0);
}
sub treasure_is_here {
    my $self = shift;
    my ($f, $r) = @_;

    return 1 if ( $self->{squares}[$f][$r] eq $T );
    return 0; 
}
sub piece_put {
    my $self  = shift;
    my $piece = shift; 
    my ($f, $r) = @_;

    # A piece can be a Knight $N, Treasure $T or Empty $E.
    # It's $E when we're undo'ing a move
    if ($piece eq $N) {
        # Side effects of placing Knight:
        # Note its location
        $self->{file} = $f;  
        $self->{rank} = $r;  
        if ($self->treasure_is_here($f,$r)) {
            # decrement Treasure if capture
            $self->{treasure_count}--;
        }
    } elsif ($piece eq $T) {
        # Treasure placed if undo'ing a capture
        # or initial Treasure placement
        $self->{treasure_count}++;
    }
    # put piece at file, rank
    $self->{squares}[$f][$r] = $piece;
}
sub knight_moves_get {
    my $self = shift;

    my @move;
    my @capture;

    # Use an offset to calculate all possible Knight moves
    my $offset = [
        [ 2, -1 ], [ 2,  1 ], [ -2, 1 ], [ -2, -1 ],
        [ 1,  2 ], [ 1, -2 ], [ -1, 2 ], [ -1, -2 ],
    ];
    my $a = $self->{file};
    my $b = $self->{rank};
    foreach ( @{ $offset } ) {
        my ($x, $y) = @{$_};
        my ($c, $d) = ($a + $x, $b + $y);

        # Discard move if its off board
        next if (($c < 1 or $c > 8) or ($d < 1 or $d > 8));

        if ($self->treasure_is_here($c,$d)) {
            push @capture, [$a, $b, $c, $d, 1];
        } else {
            push @move, [$a, $b, $c, $d, 0];
        }
    }

    # Focus on captures until we get at least one solution path.
    # This will find a relatively short path quickly but maybe not the shortest.
    # We will use it, though, to prime the pump and prune long dry paths.
    return @capture if (scalar @capture > 0 and scalar @{$self->{best_path}} == 0);

    # Otherwise, return all moves
    return (@capture, @move);

}
sub knight_move {
    my $self = shift;
    my $move = shift; 
    my ($a,$b,$c,$d,$capture) = @{$move};

    # Move Knight to target square [c,d]
    $self->piece_put($N, $c, $d); 
    # Set source square [a,b] to empty 
    $self->piece_put($E, $a, $b); 

    # add move to this path
    push @{ $self->{this_path} }, $move;
}
sub knight_move_undo {
    my $self = shift;
    my $move = shift;

    my ($a,$b,$c,$d,$capture) = @{$move};
    if ( $capture ) {
        # Put treasure back 
        $self->piece_put($T, $c, $d); 
    } else {
        # Set target square to empty
        $self->piece_put($E, $c, $d); 
    }

    # Put knight back on source square 
    $self->piece_put($N, $a, $b); 

    # discard move
    pop @{ $self->{this_path} };
}
sub board_position_visited {
    my $self = shift;

    # Generate unique key to id this board position
    my $key = $self->board_position_key_gen();

    # Note the path length it took to reach this board position
    my $this_path_len = scalar @{$self->{this_path}};

    if ($self->{board_pos}{$key}) {
        # We've been here before but ...
        if ($self->{board_pos}{$key} > $this_path_len) {