Sokoban: Difference between revisions
Content added Content deleted
(Safer second D entry) |
(→{{header|Perl 6}}: add entry) |
||
| Line 1,805: | Line 1,805: | ||
Although my code doesn't print out the actual final board, it would be easy enough |
Although my code doesn't print out the actual final board, it would be easy enough |
||
to compute from the move list. |
to compute from the move list. |
||
=={{header|Perl 6}}== |
|||
{{trans|Go}} |
|||
<lang perl6>sub MAIN() { |
|||
my $level = q:to//; |
|||
####### |
|||
# # |
|||
# # |
|||
#. # # |
|||
#. $$ # |
|||
#.$$ # |
|||
#.# @# |
|||
####### |
|||
say 'level:'; |
|||
print $level; |
|||
say 'solution:'; |
|||
say solve($level); |
|||
} |
|||
class State { |
|||
has Str $.board; |
|||
has Str $.sol; |
|||
has Int $.pos; |
|||
method move(Int $delta --> Str) { |
|||
my $new = $!board; |
|||
if $new.substr($!pos,1) eq '@' { |
|||
substr-rw($new,$!pos,1) = ' '; |
|||
} else { |
|||
substr-rw($new,$!pos,1) = '.'; |
|||
} |
|||
my $pos := $!pos + $delta; |
|||
if $new.substr($pos,1) eq ' ' { |
|||
substr-rw($new,$pos,1) = '@'; |
|||
} else { |
|||
substr-rw($new,$pos,1) = '+'; |
|||
} |
|||
return $new; |
|||
} |
|||
method push(Int $delta --> Str) { |
|||
my $pos := $!pos + $delta; |
|||
my $box := $pos + $delta; |
|||
return '' unless $!board.substr($box,1) eq ' ' | '.'; |
|||
my $new = $!board; |
|||
if $new.substr($!pos,1) eq '@' { |
|||
substr-rw($new,$!pos,1) = ' '; |
|||
} else { |
|||
substr-rw($new,$!pos,1) = '.'; |
|||
} |
|||
if $new.substr($pos,1) eq '$' { |
|||
substr-rw($new,$pos,1) = '@'; |
|||
} else { |
|||
substr-rw($new,$pos,1) = '+'; |
|||
} |
|||
if $new.substr($box,1) eq ' ' { |
|||
substr-rw($new,$box,1) = '$'; |
|||
} else { |
|||
substr-rw($new,$box,1) = '*'; |
|||
} |
|||
return $new; |
|||
} |
|||
} |
|||
sub solve(Str $start --> Str) { |
|||
my $board = $start; |
|||
my $width = $board.lines[0].chars + 1; |
|||
my @dirs = |
|||
["u", "U", -$width], |
|||
["r", "R", 1], |
|||
["d", "D", $width], |
|||
["l", "L", -1]; |
|||
my %visited = $board => True; |
|||
my $pos = $board.index('@'); |
|||
my @open = State.new(:$board, :sol(''), :$pos); |
|||
while @open { |
|||
my $state = @open.shift; |
|||
for @dirs -> [$move, $push, $delta] { |
|||
my $board; |
|||
my $sol; |
|||
my $pos = $state.pos + $delta; |
|||
given $state.board.substr($pos,1) { |
|||
when '$' | '*' { |
|||
$board = $state.push($delta); |
|||
next if $board eq "" || %visited{$board}; |
|||
$sol = $state.sol ~ $push; |
|||
return $sol unless $board ~~ /<[ . + ]>/; |
|||
} |
|||
when ' ' | '.' { |
|||
$board = $state.move($delta); |
|||
next if %visited{$board}; |
|||
$sol = $state.sol ~ $move; |
|||
} |
|||
default { next } |
|||
} |
|||
say $sol; |
|||
@open.push: State.new: :$board, :$sol, :$pos; |
|||
%visited{$board} = True; |
|||
} |
|||
} |
|||
return "No solution"; |
|||
}</lang> |
|||
{{out}} |
|||
<pre>Level: |
|||
####### |
|||
# # |
|||
# # |
|||
#. # # |
|||
#. $$ # |
|||
#.$$ # |
|||
#.# @# |
|||
####### |
|||
Solution: |
|||
ulULLulDDurrrddlULrruLLrrUruLLLulD</pre> |
|||
=={{header|PicoLisp}}== |
=={{header|PicoLisp}}== |
||