diff options
| -rw-r--r-- | challenge-118/lance-wicks/perl/lib/Knight.pm | 108 | ||||
| -rw-r--r-- | challenge-118/lance-wicks/perl/t/02-lib.t | 56 |
2 files changed, 164 insertions, 0 deletions
diff --git a/challenge-118/lance-wicks/perl/lib/Knight.pm b/challenge-118/lance-wicks/perl/lib/Knight.pm new file mode 100644 index 0000000000..9a185c83fe --- /dev/null +++ b/challenge-118/lance-wicks/perl/lib/Knight.pm @@ -0,0 +1,108 @@ +package Knight; + +use Moo; + +has treasures => ( is => 'ro', ); + +has collected_treasures => ( + is => 'rw', + default => sub { return []; }, +); + +sub go { + my ( $self, %args ) = @_; + + my $targets = $self->treasures; + my $treasures_to_collect = @$targets; + my $row = 7; + my $col = 0; + + my @path; + while ( $treasures_to_collect > 0 ) { + push @path, [ $row, $col ]; + if ( $self->has_treasure( $row, $col ) ) { + if ( !$self->have_we_got_this_treasure( $row, $col ) ) { + $self->collect_treasure( $row, $col ); + $treasures_to_collect--; + } + } + my $new = $self->move( $row, $col ); + $row = $new->[0]; + $col = $new->[1]; + } + + return { + treasures => $self->collected_treasures, + path => @path, + moves => 0 + @path + }; +} + +sub move { + my ( $self, $row, $col ) = @_; + + # Directions: 0 -> up left (row +2, col -1) + # Directions: 1 -> up right (row +2, col +1) + # Directions: 2 -> right up (row +1, col +2) + # Directions: 3 -> right down (row -1, col +2) + # Directions: 4 -> down right (row -2, col +1) + # Directions: 5 -> down left (row -2, col -1) + # Directions: 6 -> left down (row -1, col -2) + # Directions: 7 -> left up (row +1, col -2) + + my $new_row; + my $new_col; + + while (1) { + my $direction = int rand(8); + #warn "**** $row, $col -> $direction"; + $new_row = 0; + $new_col = 0; + + if ( $direction == 0 ) { $new_col = $col - 1; $new_row = $row + 2; } + if ( $direction == 1 ) { $new_col = $col + 1; $new_row = $row + 2; } + if ( $direction == 2 ) { $new_col = $col + 2; $new_row = $row + 1; } + if ( $direction == 3 ) { $new_col = $col + 2; $new_row = $row - 1; } + if ( $direction == 4 ) { $new_col = $col + 1; $new_row = $row - 2; } + if ( $direction == 5 ) { $new_col = $col - 1; $new_row = $row - 2; } + if ( $direction == 6 ) { $new_col = $col - 2; $new_row = $row - 1; } + if ( $direction == 7 ) { $new_col = $col - 2; $new_row = $row + 1; } + + if ( $new_col < 8 && $new_col >= 0 && $new_row < 8 && $new_row >= 0 ) + { + last; + } + } + return [ $new_row, $new_col ]; +} + +sub has_treasure { + my ( $self, $row, $col ) = @_; + return unless defined $row && defined $col; + + for my $treasure ( @{ $self->treasures } ) { + return unless defined $treasure; + if ( $treasure->[0] == $row && $treasure->[1] == $col ) { + return 1; + } + } + return 0; +} + +sub have_we_got_this_treasure { + my ( $self, $row, $col ) = @_; + + for my $target ( @{ $self->collected_treasures } ) { + if ( $target->[0] == $row && $target->[1] == $col ) { + return 1; + } + } + return 0; +} + +sub collect_treasure { + my ( $self, $row, $col ) = @_; + push @{ $self->collected_treasures }, [ $row, $col ]; +} + +1; diff --git a/challenge-118/lance-wicks/perl/t/02-lib.t b/challenge-118/lance-wicks/perl/t/02-lib.t new file mode 100644 index 0000000000..ed74d53d2e --- /dev/null +++ b/challenge-118/lance-wicks/perl/t/02-lib.t @@ -0,0 +1,56 @@ +use Test2::V0 -target => 'Knight', -srand => 1234; + +my $treasures + = [ [ 0, 1 ], [ 1, 0 ], [ 1, 1 ], [ 2, 1 ], [ 3, 2 ], [ 5, 4 ] ]; +my $collected_treasures = [ [ 1, 1 ] ]; + +my $k = Knight->new( + treasures => $treasures, + collected_treasures => $collected_treasures +); + +note 'We control random so this is the order of RAND'; + +subtest 'move' => sub { + is $k->move( 5, 5 ), [ 3, 4 ], 'Direction 5, down left'; + is $k->move( 5, 5 ), [ 7, 6 ], 'Direction 1, up right'; + is $k->move( 5, 5 ), [ 6, 7 ], 'Direction 2, right up'; + is $k->move( 5, 5 ), [ 6, 7 ], 'Direction 2, right up'; + is $k->move( 5, 5 ), [ 6, 3 ], 'Direction 7, left up'; + is $k->move( 5, 5 ), [ 6, 7 ], 'Direction 2, right up'; + is $k->move( 5, 5 ), [ 7, 4 ], 'Direction 0, up left'; + is $k->move( 5, 5 ), [ 3, 6 ], 'Direction 4, down right'; + + is $k->move( 0, 0 ), [ 1, 2 ], 'From 0,0 -> Direction 4, down right'; +}; + +subtest 'has_treasure' => sub { + is $k->has_treasure( 0, 1 ), 1, '0,1 Has a treasure'; + is $k->has_treasure( 5, 5 ), 0, '5,5 Has no treasure'; +}; + +subtest 'have_we_got_this_teasure' => sub { + $k->collected_treasures( [ [ 1, 1 ] ] ); + is $k->have_we_got_this_treasure( 0, 1 ), 0, + 'return 0 if we don\'t have this treasure'; + is $k->have_we_got_this_treasure( 1, 1 ), 1, + 'return 1 if we do have this treasure'; + +}; + +subtest 'add_to_collected_treasure' => sub { + my $before = $k->collected_treasures; + #push @{$k->collected_treasures}, [2,2]; + $k->collect_treasure( 2, 2 ); + is $k->collected_treasures, [ [ 1, 1 ], [ 2, 2 ] ], + 'Added an entry to the collected treasures'; +}; + +subtest 'go' => sub { + my $k2 = Knight->new( treasures => $treasures ); + my $res = $k2->go; + is $res->{moves}, 257, + 'Given control of random we know we should have 257 moves'; +}; + +done_testing; |