File Coverage

blib/lib/Games/LMSolve/Minotaur.pm
Criterion Covered Total %
statement 15 98 15.3
branch 0 22 0.0
condition 0 27 0.0
subroutine 5 14 35.7
pod 8 8 100.0
total 28 169 16.5


line stmt bran cond sub pod time code
1             package Games::LMSolve::Minotaur;
2             $Games::LMSolve::Minotaur::VERSION = '0.14.0';
3 1     1   7 use strict;
  1         3  
  1         30  
4 1     1   6 use warnings;
  1         2  
  1         46  
5              
6 1     1   7 use Games::LMSolve::Base;
  1         3  
  1         44  
7              
8 1     1   5 use Games::LMSolve::Input;
  1         2  
  1         33  
9              
10 1     1   6 use vars qw(@ISA);
  1         3  
  1         1030  
11              
12             @ISA = qw(Games::LMSolve::Base);
13              
14             sub input_board
15             {
16 0     0 1   my $self = shift;
17 0           my $filename = shift;
18              
19             my $spec = {
20             (
21 0           map { $_ => { 'type' => "xy(integer)", 'required' => 1 } }
  0            
22             (qw(dims thes mino exit))
23             ),
24             'layout' => { 'type' => "layout", 'required' => 1 },
25             };
26              
27 0           my $input_obj = Games::LMSolve::Input->new();
28 0           my $input_fields = $input_obj->input_board( $filename, $spec );
29              
30             my ( $width, $height ) =
31 0           @{ $input_fields->{'dims'}->{'value'} }{ 'x', 'y' };
  0            
32             my ( $thes_x, $thes_y ) =
33 0           @{ $input_fields->{'thes'}->{'value'} }{ 'x', 'y' };
  0            
34             my ( $mino_x, $mino_y ) =
35 0           @{ $input_fields->{'mino'}->{'value'} }{ 'x', 'y' };
  0            
36             my ( $exit_x, $exit_y ) =
37 0           @{ $input_fields->{'exit'}->{'value'} }{ 'x', 'y' };
  0            
38              
39 0 0 0       if ( ( $thes_x >= $width ) || ( $thes_y >= $height ) )
40             {
41 0           die "Theseus is out of bounds of the board in file \"$filename\"!\n";
42             }
43              
44 0 0 0       if ( ( $mino_x >= $width ) || ( $mino_y >= $height ) )
45             {
46 0           die
47             "The minotaur is out of bounds of the board in file \"$filename\"!\n";
48             }
49              
50 0 0 0       if ( ( $exit_x >= $width ) || ( $exit_y >= $height ) )
51             {
52 0           die "The exit is out of bounds of the board in file \"$filename\"!\n";
53             }
54              
55             my ( $horiz_walls, $vert_walls ) =
56             $input_obj->input_horiz_vert_walls_layout( $width, $height,
57 0           $input_fields->{'layout'} );
58              
59 0           $self->{'width'} = $width;
60 0           $self->{'height'} = $height;
61 0           $self->{'exit_x'} = $exit_x;
62 0           $self->{'exit_y'} = $exit_y;
63 0           $self->{'horiz_walls'} = $horiz_walls;
64 0           $self->{'vert_walls'} = $vert_walls;
65              
66 0           return [ $thes_x, $thes_y, $mino_x, $mino_y ];
67             }
68              
69             sub _mino_move
70             {
71 0     0     my $self = shift;
72 0           my $horiz_walls = $self->{'horiz_walls'};
73 0           my $vert_walls = $self->{'vert_walls'};
74              
75 0           my ( $thes_x, $thes_y, $mino_x, $mino_y ) = @_;
76 0           for ( my $t = 0 ; $t < 2 ; $t++ )
77             {
78 0 0 0       if ( ( $thes_x < $mino_x ) && ( !$vert_walls->[$mino_y][$mino_x] ) )
    0 0        
    0 0        
    0 0        
79             {
80 0           --$mino_x;
81             }
82             elsif (( $thes_x > $mino_x )
83             && ( !$vert_walls->[$mino_y][ $mino_x + 1 ] ) )
84             {
85 0           ++$mino_x;
86             }
87             elsif ( ( $thes_y < $mino_y ) && ( !$horiz_walls->[$mino_y][$mino_x] ) )
88             {
89 0           --$mino_y;
90             }
91             elsif (( $thes_y > $mino_y )
92             && ( !$horiz_walls->[ $mino_y + 1 ][$mino_x] ) )
93             {
94 0           ++$mino_y;
95             }
96             }
97 0           return ( $mino_x, $mino_y );
98             }
99              
100             # A function that accepts the expanded state (as an array ref)
101             # and returns an atom that represents it.
102             sub pack_state
103             {
104 0     0 1   my $self = shift;
105 0           my $state_vector = shift;
106 0           return pack( "cccc", @{$state_vector} );
  0            
107             }
108              
109             # A function that accepts an atom that represents a state
110             # and returns an array ref that represents it.
111             sub unpack_state
112             {
113 0     0 1   my $self = shift;
114 0           my $state = shift;
115 0           return [ unpack( "cccc", $state ) ];
116             }
117              
118             # Accept an atom that represents a state and output a
119             # user-readable string that describes it.
120             sub display_state
121             {
122 0     0 1   my $self = shift;
123 0           my $state = shift;
124             my ( $x, $y, $mx, $my ) =
125 0           ( map { $_ + 1 } @{ $self->unpack_state($state) } );
  0            
  0            
126 0           return sprintf( "Thes=(%i,%i) Mino=(%i,%i)", $x, $y, $mx, $my );
127             }
128              
129             # This function checks if a state it receives as an argument is a
130             # dead-end one.
131             sub check_if_unsolvable
132             {
133 0     0 1   my $self = shift;
134 0           my $coords = shift;
135 0   0       return ( ( $coords->[0] == $coords->[2] )
136             && ( $coords->[1] == $coords->[3] ) );
137             }
138              
139             sub check_if_final_state
140             {
141 0     0 1   my $self = shift;
142              
143 0           my $coords = shift;
144              
145             return ( ( $coords->[0] == $self->{'exit_x'} )
146 0   0       && ( $coords->[1] == $self->{'exit_y'} ) );
147             }
148              
149             # This function enumerates the moves accessible to the state.
150             # If it returns a move, it still does not mean that it is a valid
151             # one. I.e: it is possible that it is illegal to perform it.
152             sub enumerate_moves
153             {
154 0     0 1   my $self = shift;
155              
156 0           my $horiz_walls = $self->{'horiz_walls'};
157 0           my $vert_walls = $self->{'vert_walls'};
158              
159 0           my $coords = shift;
160              
161 0           my ( $thes_x, $thes_y ) = @$coords[ 0 .. 1 ];
162              
163 0           my @moves;
164              
165 0 0         if ( !$vert_walls->[$thes_y][$thes_x] )
166             {
167 0           push @moves, "l";
168             }
169 0 0         if ( !$vert_walls->[$thes_y][ $thes_x + 1 ] )
170             {
171 0           push @moves, "r";
172             }
173 0 0         if ( !$horiz_walls->[$thes_y][$thes_x] )
174             {
175 0           push @moves, "u";
176             }
177 0 0         if ( !$horiz_walls->[ $thes_y + 1 ][$thes_x] )
178             {
179 0           push @moves, "d";
180             }
181 0           push @moves, "w";
182              
183 0           return @moves;
184             }
185              
186             my %translate_moves = (
187             "u" => [ 0, -1 ],
188             "d" => [ 0, 1 ],
189             "l" => [ -1, 0 ],
190             "r" => [ 1, 0 ],
191             "w" => [ 0, 0 ],
192             );
193              
194             # This function accepts a state and a move. It tries to perform the
195             # move on the state. If it is succesful, it returns the new state.
196             #
197             # Else, it returns undef to indicate that the move is not possible.
198             sub perform_move
199             {
200 0     0 1   my $self = shift;
201              
202 0           my $coords = shift;
203 0           my $m = shift;
204              
205 0           my $offsets = $translate_moves{$m};
206 0           my @new_coords = @$coords;
207 0           $new_coords[0] += $offsets->[0];
208 0           $new_coords[1] += $offsets->[1];
209 0           ( @new_coords[ 2 .. 3 ] ) = $self->_mino_move(@new_coords);
210              
211 0           return \@new_coords;
212             }
213              
214             1;
215              
216             __END__