 XP is just a number 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||1000) {
my \$new = (shuffle &ad(\$e));
\$tbl[\$e->][\$e->] = \$tbl[\$new->][\$new->];
\$tbl[\$new->]->[\$new->] = 16;
\$e = [\$new->,\$new->];
}
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[\$\$_]->[\$\$_]==\$m}map{[\$_,0],[\$_,1],[\$_,2],[
+\$_,3]}0..3;
my \$new=first{\$tbl[\$\$_]->[\$\$_]==16}&ad(grep{\$tbl[\$\$_]->[\$\$_
+]==\$m}
map {[\$_,0],[\$_,1],[\$_,2],[\$_,3]}0..3);
if (\$new){\$tbl[\$\$new][\$\$new]=\$m;\$tbl[\$\$tile][\$\$tile]=16;
+}
system (\$^O eq 'MSWin32' ? 'cls' : 'clear');
}
sub ad{
my \$e = shift; grep {\$_-><4 && \$_-><4 && \$_->>-1 && \$_-
+>>-1}
[\$\$e-1,\$\$e],[\$\$e+1,\$\$e],[\$\$e,\$\$e-1],[\$\$e,\$\$
+e+1]
}
[download]```

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 (Prior) 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(\$_->, sort {\$a-> <=> \$b->} map [\$_, rand],
1..15), 0), 1 & map { grep{ \$a[\$'] > \$_ } @a[\$_ + // .. 14] } 0..13;
sub xy { -row => \$_ % 4, -column => int \$_ / 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;
[download]```

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

Log In?
 Username: Password:

What's my password?
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 chilling in the Monastery: (5)
As of 2021-04-10 15:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?