# -*- mode: cperl6; -*- # 2011 Perl 6 Coding Contest # Edgar Gonzàlez i Pellicer # Grooves game module Grooves; # The board is represented as: # (0, 1) (0, 3) (0, 5) (0, 7) (0, 9) # (1, 0) (1, 2) (1, 4) (1, 6) (1, 8) (1, 10) # (2, 1) (2, 3) (2, 5) (2, 7) (2, 9) # (3, 0) (3, 2) (3, 4) (3, 6) (3, 8) (3, 10) # (4, 1) (4, 3) (4, 5) (4, 7) (4, 9) # (5, 0) (5, 2) (5, 4) (5, 6) (5, 8) (5, 10) # (6, 1) (6, 3) (6, 5) (6, 7) (6, 9) # A groove then corresponds to a starting position and a direction my %grooves = # e1 d1 c1 b1 a1 # f1 e2 d2 c2 b2 a2 # f2 e3 d3 c3 b3 # g1 f3 e4 d4 c4 b4 # g2 f4 e5 d5 c5 # h1 g3 f5 e6 d6 c6 # h2 g4 f6 e7 d7 'a' => [ 0, 9, 1, 1 ], 'b' => [ 0, 7, 1, 1 ], 'c' => [ 0, 5, 1, 1 ], 'd' => [ 0, 3, 1, 1 ], 'e' => [ 0, 1, 1, 1 ], 'f' => [ 1, 0, 1, 1 ], 'g' => [ 3, 0, 1, 1 ], 'h' => [ 5, 0, 1, 1 ], # i1 i2 i3 i4 i5 # j1 j2 j3 j4 j5 j6 # k1 k2 k3 k4 k5 # l1 l2 l3 l4 l5 l6 # m1 m2 m3 m4 m5 # n1 n2 n3 n4 n5 n6 # o1 o2 o3 o4 o5 'i' => [ 0, 1, 0, 2 ], 'j' => [ 1, 0, 0, 2 ], 'k' => [ 2, 1, 0, 2 ], 'l' => [ 3, 0, 0, 2 ], 'm' => [ 4, 1, 0, 2 ], 'n' => [ 5, 0, 0, 2 ], 'o' => [ 6, 1, 0, 2 ], # p2 q4 r6 s7 t7 # p1 q3 r5 s6 t6 u6 # q2 r4 s5 t5 u5 # q1 r3 s4 t4 u4 v4 # r2 s3 t3 u3 v3 # r1 s2 t2 u2 v2 w2 # s1 t1 u1 v1 w1 'p' => [ 1, 0, -1, 1 ], 'q' => [ 3, 0, -1, 1 ], 'r' => [ 5, 0, -1, 1 ], 's' => [ 6, 1, -1, 1 ], 't' => [ 6, 3, -1, 1 ], 'u' => [ 6, 5, -1, 1 ], 'v' => [ 6, 7, -1, 1 ], 'w' => [ 6, 9, -1, 1 ]; # Piece class Piece is export { has Str $.groove; has Int $.number; has Int $.start; has Int $.end; has @.positions; } # Board class Board is export { has @.rows; has @.pieces; has Piece $.bullet; # Make empty method make-empty() { # Create the rows my @rows; for ^7 -> $r { @rows[$r] = [ 0 xx 5 + $r !%% 2 ]; } # Set'em @.rows = @rows; } # Hash string method hash-str() { return (@.rows.map: { .join }).join; } # Display it method display() { for keys(@.rows) -> $r { my $row = @.rows[$r].join(' '); $row = " $row" if $r %% 2; say($row); } } # Is it final method is-final() { # Does it have a bullet die "No bullet specified" unless $.bullet.defined; # Is the bullet in the end? return $.bullet.positions[* - 1][1] == 10; } # Position exists method pos-exists(Int $row, Int $col) { # Validate row return False if $row !~~ (0 .. 6); # Validate column if $row %% 2 { return $col ~~ (1 .. 9) && $col !%% 2; } else { return $col ~~ (0 .. 10) && $col %% 2; } } # Check a position method check-pos(Int $row, Int $col) { die "Bad position ($row, $col)" if !self.pos-exists($row, $col); } # Pos value method pos-value(Int $row, Int $col) { # Validate self.check-pos($row, $col); # Get return @.rows[$row][$col div 2]; } # Reset a position method reset-pos(Int $row, Int $col) { # Validate self.check-pos($row, $col); # Empty @.rows[$row][$col div 2] = 0; } # Set a position method set-pos(Int $row, Int $col, Int $value) { # Validate self.check-pos($row, $col); # Empty? my $dcol = $col div 2; if @.rows[$row][$dcol] == 0 { # Set @.rows[$row][$dcol] = $value; } else { # Error! die "Position ($row, $col) not empty"; } } # Add piece method add-piece(Str $groove, Int $start, Int $end) { # Get groove info my ($r0, $c0, $dr, $dc) = %grooves{$groove}.list; # Piece number my $piece-no = @.pieces.elems + 1; # Piece pos my @piece-pos; # Mark each position for $start .. $end -> $i { my $r = $r0 + $dr * ($i - 1); my $c = $c0 + $dc * ($i - 1); # Clean? die "Piece overlaps: {$groove}{ ($start .. $end).join }" if self.pos-value($r, $c); # Mark self.set-pos($r, $c, $piece-no); # Add it @piece-pos.push([ $r, $c ]); } # Add it @.pieces.push(Piece.new(number => $piece-no, groove => $groove, start => $start, end => $end, positions => @piece-pos)); # Is it the bullet? $.bullet = @.pieces[* - 1] if $groove eq 'l' && $start == 1 && $end == 2; # Exception CATCH { # Revert pos self.clear-pos(|$_) for @piece-pos; # Rethrow } } # Piece movements method piece-movements(Piece $p) { # Get the direction my $dr = %grooves{$p.groove}[2]; my $dc = %grooves{$p.groove}[3]; # Get the start and end my ($r0, $c0) = $p.positions[0]\ .list; my ($re, $ce) = $p.positions[* - 1].list; # Movements my @movements; { # Move left my $i = 1; my $r = $r0 - $dr; my $c = $c0 - $dc; while self.pos-exists($r, $c) && self.pos-value($r, $c) ~~ any(0, $p.number) { # Add @movements.push(-$i); # Next ++$i; $r -= $dr; $c -= $dc; } } { # Move right my $i = 1; my $r = $re + $dr; my $c = $ce + $dc; while self.pos-exists($r, $c) && self.pos-value($r, $c) ~~ any(0, $p.number) { # Add @movements.push($i); # Next ++$i; $r += $dr; $c += $dc; } } # Return the list of movements return @movements; } # Move a piece method move-piece(Piece $p, Int $dist) { # Get the direction my $dr = %grooves{$p.groove}[2]; my $dc = %grooves{$p.groove}[3]; # New my $new-board = Board.new(rows => (@.rows.map: { [ .clone ] }), pieces => @.pieces, bullet => $.bullet); # Remove $new-board.reset-pos(|$_) for $p.positions; # New positions my @new-pos = $p.positions.map: { [ .list Z+ ($dist <<*>> ($dr, $dc)) ] }; # Set $new-board.set-pos(|$_, $p.number) for @new-pos; # New piece my $new-piece = Piece.new(number => $p.number, groove => $p.groove, start => $p.start + $dist, end => $p.end + $dist, positions => @new-pos); # Update $new-board.pieces[$p.number - 1] = $new-piece; $new-board.bullet = $new-piece if $.bullet === $p; # Return the new board return $new-board; } # Heuristic cost for A* # It is an optimistic heuristic method heuristic-cost() { # Ending column of bullet my $ce = $.bullet.positions[* - 1][1]; # There? if $ce == 10 { return 0; } else { # The heuristic is the number of pieces between the end and the target return (($ce + 2, $ce + 4 ... 10).grep: { self.pos-value(3, $_) != 0 }).elems; } } } # Read board sub read-board($input) is export { # Create a Board my Board $b = Board.new; $b.make-empty; # For each line for $input.lines -> $line { $line ~~ /^\s* (<[a .. w]>) (\d) (\d*) (\d) \s*$/ or die "Bad input line: $line"; # Get my ($groove, $start, $mid, $end) = (~$0, +$1, ~$2, +$3); # Check mid is range die "Bad input line: $line" if ($start + 1 .. $end - 1).join ne $mid; # Add the piece $b.add-piece($groove, $start, $end); } # Does it have a bullet die "No bullet specified" unless $b.bullet.defined; # Return it return $b; }