 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||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] }

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(\$_->, 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;

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?