File Coverage

blib/lib/Games/LMSolve/Numbers.pm
Criterion Covered Total %
statement 12 92 13.0
branch 0 20 0.0
condition n/a
subroutine 4 13 30.7
pod 7 7 100.0
total 23 132 17.4


line stmt bran cond sub pod time code
1             package Games::LMSolve::Numbers;
2             $Games::LMSolve::Numbers::VERSION = '0.14.2';
3 1     1   83547 use strict;
  1         10  
  1         29  
4 1     1   4 use warnings;
  1         2  
  1         29  
5              
6 1     1   383 use Games::LMSolve::Base;
  1         3  
  1         48  
7              
8 1     1   7 use vars qw(@ISA);
  1         2  
  1         814  
9              
10             @ISA = qw(Games::LMSolve::Base);
11              
12             my %cell_dirs = (
13             'N' => [ 0, -1 ],
14             'S' => [ 0, 1 ],
15             'E' => [ 1, 0 ],
16             'W' => [ -1, 0 ],
17             );
18              
19             sub input_board
20             {
21 0     0 1   my $self = shift;
22              
23 0           my $filename = shift;
24              
25 0           my $spec = {
26             'dims' => { 'type' => "xy(integer)", 'required' => 1 },
27             'start' => { 'type' => "xy(integer)", 'required' => 1 },
28             'layout' => { 'type' => "layout", 'required' => 1 },
29             };
30              
31 0           my $input_obj = Games::LMSolve::Input->new();
32 0           my $input_fields = $input_obj->input_board( $filename, $spec );
33             my ( $width, $height ) =
34 0           @{ $input_fields->{'dims'}->{'value'} }{ 'x', 'y' };
  0            
35             my ( $start_x, $start_y ) =
36 0           @{ $input_fields->{'start'}->{'value'} }{ 'x', 'y' };
  0            
37 0           my (@board);
38              
39             my $line;
40 0           my $line_number = 0;
41 0           my $lines_ref = $input_fields->{'layout'}->{'value'};
42              
43             my $read_line = sub {
44 0 0   0     if ( scalar(@$lines_ref) == $line_number )
45             {
46 0           return 0;
47             }
48 0           $line = $lines_ref->[$line_number];
49 0           $line_number++;
50 0           return 1;
51 0           };
52              
53             my $gen_exception = sub {
54 0     0     my $text = shift;
55             die "$text on $filename at line "
56 0           . ( $input_fields->{'layout'}->{'line_num'} + $line_number + 1 )
57             . "!\n";
58 0           };
59              
60 0           my $y = 0;
61              
62 0           INPUT_LOOP: while ( $read_line->() )
63             {
64 0 0         if ( length($line) != $width )
65             {
66 0           $gen_exception->("Incorrect number of cells");
67             }
68 0 0         if ( $line =~ /([^\d\*])/ )
69             {
70 0           $gen_exception->("Unknown cell type $1");
71             }
72 0           push @board, [ split( //, $line ) ];
73 0           $y++;
74 0 0         if ( $y == $height )
75             {
76 0           last;
77             }
78             }
79              
80 0 0         if ( $y != $height )
81             {
82 0           $gen_exception->("Input terminated prematurely after reading $y lines");
83             }
84              
85 0 0         if ( !defined($start_x) )
86             {
87 0           $gen_exception->("The starting position was not defined anywhere");
88             }
89              
90 0           $self->{'height'} = $height;
91 0           $self->{'width'} = $width;
92 0           $self->{'board'} = \@board;
93              
94 0           return [ $start_x, $start_y ];
95             }
96              
97             # A function that accepts the expanded state (as an array ref)
98             # and returns an atom that represents it.
99             sub pack_state
100             {
101 0     0 1   my $self = shift;
102 0           my $state_vector = shift;
103 0           return pack( "cc", @{$state_vector} );
  0            
104             }
105              
106             # A function that accepts an atom that represents a state
107             # and returns an array ref that represents it.
108             sub unpack_state
109             {
110 0     0 1   my $self = shift;
111 0           my $state = shift;
112 0           return [ unpack( "cc", $state ) ];
113             }
114              
115             # Accept an atom that represents a state and output a
116             # user-readable string that describes it.
117             sub display_state
118             {
119 0     0 1   my $self = shift;
120 0           my $state = shift;
121 0           my ( $x, $y ) = @{ $self->unpack_state($state) };
  0            
122 0           return sprintf( "X = %i ; Y = %i", $x + 1, $y + 1 );
123             }
124              
125             sub check_if_final_state
126             {
127 0     0 1   my $self = shift;
128              
129 0           my $coords = shift;
130 0           return $self->{'board'}->[ $coords->[1] ][ $coords->[0] ] eq "*";
131             }
132              
133             # This function enumerates the moves accessible to the state.
134             # If it returns a move, it still does not mean that it is a valid
135             # one. I.e: it is possible that it is illegal to perform it.
136             sub enumerate_moves
137             {
138 0     0 1   my $self = shift;
139              
140 0           my $coords = shift;
141              
142 0           my $x = $coords->[0];
143 0           my $y = $coords->[1];
144              
145 0           my $step = $self->{'board'}->[$y][$x];
146              
147 0           my @moves;
148              
149 0 0         if ( $x + $step < $self->{'width'} )
150             {
151 0           push @moves, "E";
152             }
153              
154             # The ranges are [0 .. ($width-1)] and [0 .. ($height-1)]
155 0 0         if ( $x - $step >= 0 )
156             {
157 0           push @moves, "W";
158             }
159              
160 0 0         if ( $y + $step < $self->{'height'} )
161             {
162 0           push @moves, "S";
163             }
164              
165 0 0         if ( $y - $step >= 0 )
166             {
167 0           push @moves, "N";
168             }
169              
170 0           return @moves;
171             }
172              
173             # This function accepts a state and a move. It tries to perform the
174             # move on the state. If it is succesful, it returns the new state.
175             #
176             # Else, it returns undef to indicate that the move is not possible.
177             sub perform_move
178             {
179 0     0 1   my $self = shift;
180              
181 0           my $coords = shift;
182 0           my $m = shift;
183              
184 0           my $step = $self->{'board'}->[ $coords->[1] ][ $coords->[0] ];
185              
186 0           my $offsets = [ map { $_ * $step } @{ $cell_dirs{$m} } ];
  0            
  0            
187 0           my @new_coords = @$coords;
188 0           $new_coords[0] += $offsets->[0];
189 0           $new_coords[1] += $offsets->[1];
190              
191 0           return [@new_coords];
192             }
193              
194             1;
195              
196             __END__