There's more than one way to do things PerlMonks

### Re^2: Tk - Discipulus 15 puzzle -- minimalist challenge

by Discipulus (Abbot)
 on Jun 15, 2017 at 14:31 UTC ( #1192865=note: print w/replies, xml ) Need Help??

in reply to Re: Tk - Discipulus 15 puzzle
in thread Tk - Discipulus 15 puzzle

Eh eh tybalt89 yes, you have a real talent and not only in Tk!

But if I can accept the challenge I'd present a commandline version of the 15 puzzle that is a bit longer than your (25 vs 15 lines) but always poses resolvable games.. ;=)

```unless (\$^W){use strict; use warnings;}
use List::Util qw(shuffle first);
my @tbl = ([1,2,3,4],[5,6,7,8],[9,10,11,12],[13,14,15,16]);
my \$e = [3,3];
for (1..\$ARGV[0]||1000) {
my \$new = (shuffle &ad(\$e))[0];
\$tbl[\$e->[0]][\$e->[1]] = \$tbl[\$new->[0]][\$new->[1]];
\$tbl[\$new->[0]]->[\$new->[1]] = 16;
\$e = [\$new->[0],\$new->[1]];
}
while(1){
print +(join ' ',map{\$_==16?'  ':sprintf '%02s',\$_}@{\$tbl[\$_]}),"\n"
+ for 0..3;
my \$m = <STDIN>;
chomp \$m;
die "Enter a number to move!" unless \$m;
my \$tile=first{\$tbl[\$\$_[0]]->[\$\$_[1]]==\$m}map{[\$_,0],[\$_,1],[\$_,2],[
+\$_,3]}0..3;
+[1]]==\$m}
map {[\$_,0],[\$_,1],[\$_,2],[\$_,3]}0..3);
if (\$new){\$tbl[\$\$new[0]][\$\$new[1]]=\$m;\$tbl[\$\$tile[0]][\$\$tile[1]]=16;
+}
system (\$^O eq 'MSWin32' ? 'cls' : 'clear');
}
my \$e = shift; grep {\$_->[0]<4 && \$_->[1]<4 && \$_->[0]>-1 && \$_-
+>[1]>-1}
[\$\$e[0]-1,\$\$e[1]],[\$\$e[0]+1,\$\$e[1]],[\$\$e[0],\$\$e[1]-1],[\$\$e[0],\$\$
+e[1]+1]
}

Never reached such square brackets density..

L*

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

Replies are listed 'Best First'.
Re^3: Tk - Discipulus 15 puzzle -- minimalist challenge
by tybalt89 (Parson) on Jun 15, 2017 at 17:12 UTC

But it only takes one additional line (with a tiny bit of reshuffling and a very small golf trick involving // ) to get it to pose only resolvable games :)

```#!/usr/bin/perl
use Tk;
use strict;
my (\$mw, \$hole, @a) = new MainWindow;
1 while @a = (map(\$_->[0], sort {\$a->[1] <=> \$b->[1]} map [\$_, rand],
1..15), 0), 1 & map { grep{ \$a[\$'] > \$_ } @a[\$_ + // .. 14] } 0..13;
sub xy { -row => \$_[0] % 4, -column => int \$_[0] / 4 }
for my \$ii (0..15) {
my (\$num, \$i, \$but) = (\$a[\$ii], \$ii);
\$hole = \$i, next unless \$num;
\$but = \$mw->Button(-text => \$num, -width => 2, -height => 2, -comman
+d
=> sub { \$but->grid(xy((\$i,\$hole) = (\$hole,\$i))) if abs \$i - \$hole
== 4 or abs \$i - \$hole == 1 and int \$i/4 == int \$hole/4
})->grid(xy \$i);
}
MainLoop;

The extra line, however, spoils the whole "15 in 15" esthetic :(

Create A New User
Node Status?
node history
Node Type: note [id://1192865]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (4)
As of 2019-10-14 04:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
In 2019 the site I miss most is:

Results (36 votes). Check out past polls.

Notices?