Hi, Monks. I'm no great shakes at writing Perl but someone threw down the "write the 15 Puzzle" gauntlet (elsewhere) so I decided to try my hand — and I managed to produce my first-ever Perl game (or puzzle). (Of course, the 15 Puzzle has been done before but I wrote my (much simpler) version without reference to that and, heck, I'm proud of it, so give a nonexpert a break. That said, any constructive feedback would be most welcome.) use strict;
use warnings;
use List::Util 'shuffle';
use Term::TransKeys;
my $listener = Term::TransKeys->new();
$\=$/;
# INTRO
print for(
'',
'Welcome to the 15 puzzle!',
'',
'Use an arrow key to move a block into the empty position.',
"You're trying to reach the position:",
' 01 02 03',
'04 05 06 07',
'08 09 10 11',
'12 13 14 15',
'',
'^C to kill.',
''
);
# GENERATE THE BOARD
my @board;
my $inversions;
GEN:
@board = (0, shuffle(1..15));
# @board = (1,0,2..15); # for testing
$inversions = 0;
for my $a(1..15) {
for my $b(1..15) {
++$inversions if($a<$b and $board[$a]>$board[$b])
}
}
goto GEN if $inversions % 2;
# PLAY THE GAME
sub printboard {
print join ' ', map {s/^00$/ /r} map {sprintf '%02d', $_} @board[0.
+.3];
print join ' ', map {s/^00$/ /r} map {sprintf '%02d', $_} @board[4.
+.7];
print join ' ', map {s/^00$/ /r} map {sprintf '%02d', $_} @board[8.
+.11];
print join ' ', map {s/^00$/ /r} map {sprintf '%02d', $_} @board[12
+..15];
print '';
}
print "The starting position is:";
printboard();
my %keys;
$keys{$_} = 1 for qw/<UP> <DOWN> <RIGHT> <LEFT> <CONTROL+C>/;
my $solved;
while(!$solved){
my $key;
while(not defined($key = $listener->TransKey())){sleep 1}
next unless $keys{$key};
die "Have a great day!$/" if $key eq '<CONTROL+C>';
if ($key eq '<UP>' and grep {$_==0} @board[12..15] ) {print "Yo
+u can't move up. The empty space is at the bottom."; next}
if ($key eq '<DOWN>' and grep {$_==0} @board[0..3] ) {print "Yo
+u can't move down. The empty space is at the top."; next}
if ($key eq '<RIGHT>' and grep {$_==0} @board[0,4,8,12] ) {print "Yo
+u can't move right. The empty space is at the left."; next}
if ($key eq '<LEFT>' and grep {$_==0} @board[3,7,11,15]) {print "Yo
+u can't move left. The empty space is at the right."; next}
my ($zero) = (grep {$board[$_]==0} 0..15);
if ($key eq '<UP>' ){ @board = (@board[0..$zero-1, $zero+4, $zero
++1..$zero+3, $zero, $zero+5..15]) };
if ($key eq '<DOWN>' ){ @board = (@board[0..$zero-5, $zero, $zero-3
+..$zero-1, $zero-4, $zero+1..15]) };
if ($key eq '<RIGHT>' ){ @board = (@board[0..$zero-2, $zero, $zero-1
+, $zero+1..15]) };
if ($key eq '<LEFT>' ){ @board = (@board[0..$zero-1, $zero+1, $zero
+, $zero+2..15]) };
$solved = 1 if 16 == grep {$board[$_]==$_} 0..15;
printboard();
}
print "You've solved it!"
$_="msh210";$"=$\;@_=@{[split//,uc]}[2,0];$_="@_$\1";$\=$/;++$_[0]for$...1;print lc substr crypt($_,"@_"),1,6
Re: The 15 Puzzle
by hippo (Bishop) on Jun 10, 2020 at 08:49 UTC
|
I'm proud of it, so give a nonexpert a break. That said, any constructive feedback would be most welcome.
For a non-expert it's pretty good. There are a few inconsistencies but I'm sure you can spot those and polish them out in due course. The only bit which really grates is this:
# GENERATE THE BOARD
my @board;
my $inversions;
GEN:
@board = (0, shuffle(1..15));
# @board = (1,0,2..15); # for testing
$inversions = 0;
for my $a(1..15) {
for my $b(1..15) {
++$inversions if($a<$b and $board[$a]>$board[$b])
}
}
goto GEN if $inversions % 2;
There's really no need for a goto in here. You are clearly aware of conditional loops in Perl as you've used them elsewhere in this script. Let's re-write this to avoid the goto, avoid the special variables $a and $b and make it marginally more efficient by only checking the triangle rather than the square.
my @board;
my $inversions = 1;
while ($inversions % 2) {
@board = (0, shuffle(1..15));
$inversions = 0;
for my $x (1 .. 15) {
for my $y ($x + 1 .. 15) {
$inversions++ if $board[$x] > $board[$y];
}
}
}
Hopefully I have not altered the logic of your board construction at all, just tweaked the code to do the same thing but in a slightly more Perlish way. For completeness I would probably put this in its own subroutine and just call my @board = setup_board() in the main script as the setup is entirely independent of the rest of the script.
| [reply] [d/l] [select] |
|
my $inversions = 1;
while ($inversions % 2) {
@board = (0, shuffle(1..15));
$inversions = 0;
for my $x (1 .. 15) {
for my $y ($x + 1 .. 15) {
$inversions++ if $board[$x] > $board[$y];
}
}
}
bothers me a little, because the code is asserting we have one inversion, and then that we have none, and then counting them. It seems… wrong, somehow, to assert at the start that we have one inversion, beginning counting them — especially because that assertion is followed immediately by a contradictory one. So I switched it to my $inversions;
do {
$inversions = 0;
@board = (0, shuffle(1..15));
# @board = (1,0,2..15); # for testing
for my $x(1..15) {
for my $y($x+1..15) {
++$inversions if $board[$x]>$board[$y]
}
}
} while $inversions % 2;
I'd appreciate your letting me know what you think. $_="msh210";$"=$\;@_=@{[split//,uc]}[2,0];$_="@_$\1";$\=$/;++$_[0]for$...1;print lc substr crypt($_,"@_"),1,6 | [reply] [d/l] [select] |
|
Both versions of the loop are effectively the same as far as the algorithm goes. By moving the conditional to the end you have avoided the need for the initial flag value. I just picked 1 as it makes $inversions % 2 a true value but it could equally have been -1 or -9999 or any other (odd) value if that were to make it seem less wrong. You could even go so far as to set up a constant called INITIAL_INVERSIONS and set that to have the arbitrary flag value - TIMTOWTDI.
It's best to code in a way that's right for you. If the semantics of the variables are most important to you then that's clearly the way to go. There's no computational penalty for this and anything that makes the code easier to maintain, whether objectively or for the specific maintainer, has to be beneficial.
Just the process of analysing this and re-working the loop will have been, I hope, a worthwhile exercise. Thanks for taking the time to do so.
| [reply] [d/l] [select] |
|
Thanks! $_="msh210";$"=$\;@_=@{[split//,uc]}[2,0];$_="@_$\1";$\=$/;++$_[0]for$...1;print lc substr crypt($_,"@_"),1,6
| [reply] [d/l] |
Re: The 15 Puzzle
by Tux (Canon) on Jun 10, 2020 at 09:27 UTC
|
NICE! A big PLUS to you. The generation of the board can go into an endless loop, and can be done much simpler directly:
# GENERATE THE BOARD
my @board = shuffle 1 .. 15;
splice @board, int rand 16, 0, 0;
I've added my version here, which is how I would re-write yours (TIMTOWTDI):
| [reply] [d/l] [select] |
|
| [reply] [d/l] [select] |
|
| [reply] |
Re: The 15 Puzzle
by jwkrahn (Abbot) on Jun 10, 2020 at 20:30 UTC
|
print for(
'',
'Welcome to the 15 puzzle!',
'',
'Use an arrow key to move a block into the empty position.',
"You're trying to reach the position:",
' 01 02 03',
'04 05 06 07',
'08 09 10 11',
'12 13 14 15',
'',
'^C to kill.',
''
);
That would probably be better as a here doc (a single string) than a list of strings:
print <<TEXT;
Welcome to the 15 puzzle!
Use an arrow key to move a block into the empty position.
You're trying to reach the position:
01 02 03
04 05 06 07
08 09 10 11
12 13 14 15
^C to kill.
TEXT
| [reply] [d/l] [select] |
|
Thank you! $_="msh210";$"=$\;@_=@{[split//,uc]}[2,0];$_="@_$\1";$\=$/;++$_[0]for$...1;print lc substr crypt($_,"@_"),1,6
| [reply] [d/l] |
Re: The 15 Puzzle
by Eily (Monsignor) on Jun 11, 2020 at 12:23 UTC
|
++ For your code. It's quite readable as well despite being dense IMHO.
About the number of permutations, rather than a loop wouldn't it be simpler to just have:
@board[1,2] = @board[2,1] if $inversions %2; ?
| [reply] [d/l] |
|
Good idea; thanks! $_="msh210";$"=$\;@_=@{[split//,uc]}[2,0];$_="@_$\1";$\=$/;++$_[0]for$...1;print lc substr crypt($_,"@_"),1,6
| [reply] [d/l] |
Re: The 15 Puzzle
by pDaleC (Sexton) on Jun 17, 2020 at 15:23 UTC
|
I am failing to install Term::TransKeys. Is that an ActiveState-only package? | [reply] |
|
| [reply] |
|
|