File Coverage

blib/lib/Games/LMSolve/Plank/Base.pm
Criterion Covered Total %
statement 199 238 83.6
branch 57 90 63.3
condition 21 30 70.0
subroutine 16 17 94.1
pod 9 9 100.0
total 302 384 78.6


line stmt bran cond sub pod time code
1             package Games::LMSolve::Plank::Base;
2             $Games::LMSolve::Plank::Base::VERSION = '0.14.1';
3 2     2   2586 use strict;
  2         11  
  2         64  
4 2     2   11 use warnings;
  2         4  
  2         73  
5              
6 2     2   11 use vars qw(@ISA);
  2         5  
  2         123  
7              
8 2     2   477 use Games::LMSolve::Base qw(%cell_dirs);
  2         5  
  2         213  
9              
10             @ISA = qw(Games::LMSolve::Base);
11              
12 2     2   982 use Games::LMSolve::Input;
  2         20  
  2         5192  
13              
14             sub initialize
15             {
16 1     1 1 2 my $self = shift;
17              
18 1         8 $self->SUPER::initialize(@_);
19              
20 1         5 $self->{'dirs'} = [qw(E W S N)];
21             }
22              
23             sub input_board
24             {
25 1     1 1 2 my $self = shift;
26              
27 1         3 my $filename = shift;
28              
29 1         10 my $spec = {
30             'dims' => { 'type' => "xy(integer)", 'required' => 1, },
31             'planks' => {
32             'type' => "array(start_end(xy(integer)))",
33             'required' => 1,
34             },
35             'layout' => { 'type' => "layout", 'required' => 1, },
36             };
37              
38 1         7 my $input_obj = Games::LMSolve::Input->new();
39              
40 1         5 my $input_fields = $input_obj->input_board( $filename, $spec );
41             my ( $width, $height ) =
42 1         4 @{ $input_fields->{'dims'}->{'value'} }{ 'x', 'y' };
  1         5  
43 1         2 my ( $goal_x, $goal_y );
44              
45 1 50       2 if ( scalar( @{ $input_fields->{'layout'}->{'value'} } ) < $height )
  1         4  
46             {
47 0         0 die
48             "Incorrect number of lines in board layout (does not match dimensions";
49             }
50 1         3 my @board;
51 1         3 my $lines = $input_fields->{'layout'}->{'value'};
52 1         4 for ( my $y = 0 ; $y < $height ; $y++ )
53             {
54 5         10 my $l = [];
55 5 50       12 if ( length( $lines->[$y] ) < $width )
56             {
57             die "Too few characters in board layout in line No. "
58 0         0 . ( $input_fields->{'layout'}->{'line_num'} + $y + 1 );
59             }
60 5         7 my $x = 0;
61 5         13 foreach my $c ( split( //, $lines->[$y] ) )
62             {
63 35         61 push @$l, ( $c ne " " );
64 35 100       58 if ( $c eq "G" )
65             {
66 1 50       13 if ( defined($goal_x) )
67             {
68 0         0 die "Goal was defined twice!";
69             }
70 1         10 ( $goal_x, $goal_y ) = ( $x, $y );
71             }
72 35         48 $x++;
73             }
74 5         14 push @board, $l;
75             }
76 1 50       4 if ( !defined($goal_x) )
77             {
78 0         0 die "The Goal was not defined in the layout";
79             }
80              
81 1         3 my $planks_in = $input_fields->{'planks'}->{'value'};
82              
83 1         1 my @planks;
84              
85             my $get_plank = sub {
86 4     4   7 my $p = shift;
87              
88             my ( $start_x, $start_y ) =
89 4         10 ( $p->{'start'}->{'x'}, $p->{'start'}->{'y'} );
90 4         9 my ( $end_x, $end_y ) = ( $p->{'end'}->{'x'}, $p->{'end'}->{'y'} );
91              
92             my $check_endpoints = sub {
93 4 50       10 if ( !$board[$start_y]->[$start_x] )
94             {
95 0         0 die "Plank cannot be placed at point ($start_x,$start_y)!";
96             }
97 4 50       9 if ( !$board[$end_y]->[$end_x] )
98             {
99 0         0 die "Plank cannot be placed at point ($end_x,$end_y)!";
100             }
101 4         14 };
102              
103 4         10 my $plank_str = "Plank ($start_x,$start_y) ==> ($end_x,$end_y)";
104              
105 4 50 33     30 if ( ( $start_x >= $width )
      33        
      33        
106             || ( $end_x >= $width )
107             || ( $start_y >= $height )
108             || ( $end_y >= $height ) )
109             {
110 0         0 die "$plank_str is out of the boundaries of the board";
111             }
112              
113 4 100       11 if ( $start_x == $end_x )
    50          
    0          
114             {
115 1 50       4 if ( $start_y == $end_y )
116             {
117 0         0 die "$plank_str has zero length!";
118             }
119 1         3 $check_endpoints->();
120 1 50       3 if ( $start_y > $end_y )
121             {
122 0         0 ( $start_y, $end_y ) = ( $end_y, $start_y );
123             }
124 1         3 foreach my $y ( ( $start_y + 1 ) .. ( $end_y - 1 ) )
125             {
126 0 0       0 if ( $board[$y]->[$start_x] )
127             {
128 0         0 die "$plank_str crosses logs!";
129             }
130             }
131             return {
132 1         7 'len' => ( $end_y - $start_y ),
133             'start' => { 'x' => $start_x, 'y' => $start_y },
134             'dir' => "S"
135             };
136             }
137             elsif ( $start_y == $end_y )
138             {
139 3         7 $check_endpoints->();
140 3 50       8 if ( $start_x > $end_x )
141             {
142 0         0 ( $start_x, $end_x ) = ( $end_x, $start_x );
143             }
144 3         8 foreach my $x ( ( $start_x + 1 ) .. ( $end_x - 1 ) )
145             {
146 3 50       8 if ( $board[$start_y]->[$x] )
147             {
148 0         0 die "$plank_str crosses logs!";
149             }
150             }
151             return {
152 3         23 'len' => ( $end_x - $start_x ),
153             'start' => { 'x' => $start_x, 'y' => $start_y },
154             'dir' => "E"
155             };
156             }
157             elsif ( ( $end_x - $start_x ) == ( $end_y - $start_y ) )
158             {
159 0         0 $check_endpoints->();
160 0 0       0 if ( $start_x > $end_x )
161             {
162 0         0 ( $start_x, $end_x ) = ( $end_x, $start_x );
163 0         0 ( $start_y, $end_y ) = ( $end_y, $start_y );
164             }
165 0         0 foreach my $i ( 1 .. ( $end_x - $start_x - 1 ) )
166             {
167 0 0       0 if ( $board[ $start_y + $i ]->[ $start_x + $i ] )
168             {
169 0         0 die "$plank_str crosses logs!";
170             }
171             }
172 0 0       0 if ( !grep { $_ eq "SE" } @{ $self->{'dirs'} } )
  0         0  
  0         0  
173             {
174 0         0 die "$plank_str is not aligned horizontally or vertically.";
175             }
176             return {
177 0         0 'len' => ( $end_x - $start_x ),
178             'start' => {
179             'x' => $start_x,
180             'y' => $start_y,
181             },
182             'dir' => "SE",
183             };
184             }
185             else
186             {
187 0         0 die "$plank_str is not aligned horizontally or vertically.";
188             }
189 1         9 };
190              
191 1         3 foreach my $p (@$planks_in)
192             {
193 4         9 push @planks, $get_plank->($p);
194             }
195              
196 1         4 $self->{'width'} = $width;
197 1         3 $self->{'height'} = $height;
198 1         2 $self->{'goal_x'} = $goal_x;
199 1         3 $self->{'goal_y'} = $goal_y;
200 1         2 $self->{'board'} = \@board;
201 1         3 $self->{'plank_lens'} = [ map { $_->{'len'} } @planks ];
  4         8  
202              
203             my $state = [
204             0,
205             (
206             map {
207 1         3 (
208             $_->{'start'}->{'x'},
209             $_->{'start'}->{'y'},
210             (
211             ( $_->{'dir'} eq "E" ) ? 0
212 4 50       17 : ( $_->{'dir'} eq "SE" ) ? 2
    100          
213             : 1
214             )
215             )
216             } @planks
217             )
218             ];
219 1         6 $self->_process_plank_data($state);
220              
221             #{
222             # use Data::Dumper;
223             #
224             # my $d = Data::Dumper->new([$self, $state], ["\$self", "\$state"]);
225             # print $d->Dump();
226             #}
227              
228 1         35 return $state;
229             }
230              
231             sub _process_plank_data
232             {
233 642     642   919 my $self = shift;
234              
235 642         826 my $state = shift;
236              
237 642         937 my $active = $state->[0];
238              
239             my @planks = (
240             map {
241             {
242 2568         7778 'len' => $self->{'plank_lens'}->[$_],
243             'x' => $state->[ $_ * 3 + 1 ],
244             'y' => $state->[ $_ * 3 + 1 + 1 ],
245             'dir' => $state->[ $_ * 3 + 2 + 1 ],
246             'active' => 0,
247             }
248 642         920 } ( 0 .. ( scalar( @{ $self->{'plank_lens'} } ) - 1 ) )
  642         1300  
249             );
250              
251 642         1256 foreach my $p (@planks)
252             {
253 2568         3501 my $p_dir = $p->{'dir'};
254 2568 50       4428 my $dir = ( $p_dir == 0 ) ? "E" : ( $p_dir == 1 ) ? "S" : "SE";
    100          
255 2568         3617 $p->{'dir'} = $dir;
256              
257 2568         4343 $p->{'end_x'} = $p->{'x'} + $cell_dirs{$dir}->[0] * $p->{'len'};
258 2568         4724 $p->{'end_y'} = $p->{'y'} + $cell_dirs{$dir}->[1] * $p->{'len'};
259             }
260              
261             # $ap is short for active plank
262 642         931 my $ap = $planks[$active];
263 642         904 $ap->{'active'} = 1;
264              
265 642         866 my (@queue);
266 642         1665 push @queue, [ $ap->{'x'}, $ap->{'y'} ], [ $ap->{'end_x'}, $ap->{'end_y'} ];
267 642         1002 undef($ap);
268 642         1323 while ( my $point = pop(@queue) )
269             {
270 2113         3802 my ( $x, $y ) = @$point;
271 2113         3250 foreach my $p (@planks)
272             {
273 8452 100       14075 if ( $p->{'active'} )
274             {
275 3901         6037 next;
276             }
277 4551 100 100     8959 if ( ( $p->{'x'} == $x ) && ( $p->{'y'} == $y ) )
278             {
279 464         673 $p->{'active'} = 1;
280 464         940 push @queue, [ $p->{'end_x'}, $p->{'end_y'} ];
281             }
282 4551 100 100     11084 if ( ( $p->{'end_x'} == $x ) && ( $p->{'end_y'} == $y ) )
283             {
284 365         528 $p->{'active'} = 1;
285 365         870 push @queue, [ $p->{'x'}, $p->{'y'} ];
286             }
287             }
288             }
289 642         1221 foreach my $i ( 0 .. $#planks )
290             {
291 964 100       1709 if ( $planks[$i]->{'active'} )
292             {
293 642         881 $state->[0] = $i;
294 642         1305 return \@planks;
295             }
296             }
297             }
298              
299             sub pack_state
300             {
301 239     239 1 366 my $self = shift;
302              
303 239         310 my $state_vector = shift;
304 239         839 return pack( "c*", @$state_vector );
305             }
306              
307             sub unpack_state
308             {
309 83     83 1 126 my $self = shift;
310 83         128 my $state = shift;
311 83         334 return [ unpack( "c*", $state ) ];
312             }
313              
314             sub display_state
315             {
316 0     0 1 0 my $self = shift;
317 0         0 my $packed_state = shift;
318              
319 0         0 my $state = $self->unpack_state($packed_state);
320              
321 0         0 my $plank_data = $self->_process_plank_data($state);
322              
323 0         0 my @strings;
324 0         0 foreach my $p (@$plank_data)
325             {
326             push @strings,
327             sprintf( "(%i,%i) -> (%i,%i) %s",
328             $p->{'x'}, $p->{'y'}, $p->{'end_x'}, $p->{'end_y'},
329 0 0       0 ( $p->{'active'} ? "[active]" : "" ) );
330             }
331 0         0 return join( " ; ", @strings );
332             }
333              
334             sub check_if_final_state
335             {
336 83     83 1 122 my $self = shift;
337              
338 83         109 my $state = shift;
339              
340 83         178 my $plank_data = $self->_process_plank_data($state);
341              
342 83         143 my $goal_x = $self->{'goal_x'};
343 83         134 my $goal_y = $self->{'goal_y'};
344              
345             return (
346             scalar(
347             grep {
348 83         135 ( ( $_->{'x'} == $goal_x ) && ( $_->{'y'} == $goal_y ) )
349             || ( ( $_->{'end_x'} == $goal_x )
350 332 50 66     1498 && ( $_->{'end_y'} == $goal_y ) )
      33        
351             } @$plank_data
352             ) > 0
353             );
354             }
355              
356             sub enumerate_moves
357             {
358 82     82 1 123 my $self = shift;
359              
360 82         124 my $state = shift;
361              
362 82         156 my $plank_data = $self->_process_plank_data($state);
363              
364             # Declare some accessors
365 82         139 my $board = $self->{'board'};
366 82         134 my $width = $self->{'width'};
367 82         117 my $height = $self->{'height'};
368              
369 82         117 my $dirs_ptr = $self->{'dirs'};
370              
371 82         133 my @moves;
372              
373             my %current;
374             my $serialize = sub {
375 2851     2851   7422 return join "\t", @_;
376 82         316 };
377              
378 82         157 foreach my $plank (@$plank_data)
379             {
380             $current{ $serialize->( @$plank{qw(x y end_x end_y)} ) } =
381 328         655 $current{ $serialize->( @$plank{qw(end_x end_y x y)} ) } = 1;
382             }
383              
384 82         170 for my $to_move_idx ( 0 .. $#$plank_data )
385             {
386 328         490 my $to_move = $plank_data->[$to_move_idx];
387 328         580 my $len = $to_move->{'len'};
388 328 100       618 if ( !( $to_move->{'active'} ) )
389             {
390 166         290 next;
391             }
392 162         256 foreach my $move_to (@$plank_data)
393             {
394 648 100       1137 if ( !( $move_to->{'active'} ) )
395             {
396 256         373 next;
397             }
398 392         1068 for my $point (
399             [ $move_to->{'x'}, $move_to->{'y'} ],
400             [ $move_to->{'end_x'}, $move_to->{'end_y'} ]
401             )
402             {
403 784         1400 my ( $x, $y ) = @$point;
404 784         1108 DIR_LOOP: for my $dir (@$dirs_ptr) # (qw(E W S N))
405             {
406             # Find the other ending points of the plank
407 3136         5188 my $other_x = $x + $cell_dirs{$dir}->[0] * $len;
408 3136         4343 my $other_y = $y + $cell_dirs{$dir}->[1] * $len;
409              
410             # Check if we are within bounds
411 3136 100 100     8036 if ( ( $other_x < 0 ) || ( $other_x >= $width ) )
412             {
413 348         501 next;
414             }
415 2788 100 100     6731 if ( ( $other_y < 0 ) || ( $other_y >= $height ) )
416             {
417 593         989 next;
418             }
419              
420             # Check that we're not moving one plank on top of the
421             # other or itself.
422 2195 100       3685 if (
423             exists
424             $current{ $serialize->( $x, $y, $other_x, $other_y ) } )
425             {
426 558         1104 next DIR_LOOP;
427             }
428              
429             # Check if there is a stump at the other end-point
430 1637 100       3105 if ( !$board->[$other_y]->[$other_x] )
431             {
432 1378         2267 next;
433             }
434              
435             # Check the validity of the intermediate points.
436 259         514 for ( my $offset = 1 ; $offset < $len ; $offset++ )
437             {
438 276         418 my $ix = $x + $cell_dirs{$dir}->[0] * $offset;
439 276         434 my $iy = $y + $cell_dirs{$dir}->[1] * $offset;
440              
441 276 100       492 if ( $board->[$iy]->[$ix] )
442             {
443 15         32 next DIR_LOOP;
444             }
445              
446             # Check if another plank has this point in between
447 261         372 my $collision_plank_idx = 0;
448 261         389 for my $plank (@$plank_data)
449             {
450             # Make sure we don't test a plank against
451             # a collisions with itself.
452 1032 100       1670 if ( $collision_plank_idx == $to_move_idx )
453             {
454 261         369 next;
455             }
456 771         1137 my $p_x = $plank->{'x'};
457 771         1048 my $p_y = $plank->{'y'};
458 771         1058 my $plank_dir = $plank->{'dir'};
459 771         1295 for my $i ( 0 .. $plank->{'len'} )
460             {
461 1892 100 100     3740 if ( ( $p_x == $ix ) && ( $p_y == $iy ) )
462             {
463 6         16 next DIR_LOOP;
464             }
465             }
466             continue
467             {
468 1886         2537 $p_x += $cell_dirs{$plank_dir}->[0];
469 1886         2922 $p_y += $cell_dirs{$plank_dir}->[1];
470             }
471             }
472             continue
473             {
474 1026         1594 $collision_plank_idx++;
475             }
476             }
477              
478             # A perfectly valid move - let's add it.
479 238         932 push @moves,
480             {
481             'p' => $to_move_idx,
482             'x' => $x,
483             'y' => $y,
484             'dir' => $dir
485             };
486             }
487             }
488             }
489             }
490              
491 82         798 return @moves;
492             }
493              
494             sub perform_move
495             {
496 238     238 1 341 my $self = shift;
497              
498 238         307 my $state = shift;
499 238         310 my $m = shift;
500              
501 238         422 my $plank_data = $self->_process_plank_data($state);
502              
503 238         376 my ( $x, $y, $p, $dir ) = @{$m}{qw(x y p dir)};
  238         532  
504 238         361 my $dir_idx;
505 238 100       642 if ( $dir eq "S" )
    100          
    100          
    50          
    0          
    0          
506             {
507 34         55 $dir_idx = 1;
508             }
509             elsif ( $dir eq "E" )
510             {
511 21         61 $dir_idx = 0;
512             }
513             elsif ( $dir eq "N" )
514             {
515 76         107 $dir_idx = 1;
516 76         116 $y -= $self->{'plank_lens'}->[$p];
517             }
518             elsif ( $dir eq "W" )
519             {
520 107         159 $dir_idx = 0;
521 107         170 $x -= $self->{'plank_lens'}->[$p];
522             }
523             elsif ( $dir eq "NW" )
524             {
525 0         0 $dir_idx = 2;
526 0         0 $y -= $self->{'plank_lens'}->[$p];
527 0         0 $x -= $self->{'plank_lens'}->[$p];
528             }
529             elsif ( $dir eq "SE" )
530             {
531 0         0 $dir_idx = 2;
532             }
533              
534 238         481 my $new_state = [@$state];
535              
536 238         425 @$new_state[0] = $p;
537 238         639 @$new_state[ ( 1 + $p * 3 ) .. ( 1 + $p * 3 + 2 ) ] = ( $x, $y, $dir_idx );
538              
539 238         647 $self->_process_plank_data($new_state);
540              
541 238         1277 return $new_state;
542             }
543              
544             sub render_move
545             {
546 19     19 1 1605 my $self = shift;
547              
548 19         25 my $move = shift;
549              
550 19 50       36 if ($move)
551             {
552             return sprintf(
553             "Move the Plank of Length %i to (%i,%i) %s",
554             $self->{'plank_lens'}->[ $move->{'p'} ],
555 19         35 @{$move}{qw(x y dir)}
  19         90  
556             );
557             }
558             else
559             {
560 0           return "";
561             }
562             }
563              
564             1;
565              
566             __END__