Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Listener Crossword #4321 solitaire

by GrandFather (Sage)
on Jun 21, 2019 at 10:19 UTC ( #11101663=CUFP: print w/replies, xml ) Need Help??

The Times newspaper features an occasional "The Listener Crossword" which is in fact a numerically based logic puzzle in the form of a crossword. A friend of mine introduced me to the genera with #4321 which is a puzzle of two parts. The first part consists of populating the playing grid with hexadecimal numbers. The second part consist of using the populated grid to play a game of solitaire which, when played correctly on a correctly constructed grid ends up spelling out three words. There is a certain amount of trial and error involved in finding the solution!

So to aid playing the game in the second part of the puzzle I wrote the following script. The gameGrid is configured for a partial solution of the game. A feature of the code is that you can "save" the game state at any point then paste the saved gameGrid in place of the current grid to explore possibilities from that point.

As far as I can tell developing tools of this sort is all part of the solution domain for the puzzle. They are very much one off puzzles as each "crossword" is a puzzle of a completely different nature, so it is very unlikely that this tool will be useful for another "Crossword Puzzle". But it is a cool use for Perl!

Note that a few shortcuts have been taken in the code. In particular global variables are used, which I usually avoid. The rendered grid is not very pretty and the layout generally is rough, but good enough for the task at hand.

Play consists of clicking on a "peg" (piece to be moved) then an "empty" cell ("_") skipping over one intervening piece. The skipped piece is removed and added to the "skipped" string. Moves can be undone back to the starting state. For instructions beyond these you will need to find the original puzzle instructions and create the starting grid.

use strict; use warnings; use Tk; my @gameGrid = ( # Word search start [qw(- - _ C C - -)], [qw(- - _ 0 _ - -)], [qw(D D 1 1 _ C A)], [qw(B _ 0 0 _ B F)], [qw(_ E _ C _ _ 0)], [qw(- - _ _ _ - -)], [qw(- - _ _ _ - -)], ); my $main = Tk::MainWindow->new(-title => "X4321"); my @rows; for my $rowIdx (0 .. 6) { for my $colIdx (0 .. 6) { next if ($rowIdx < 2 || $rowIdx > 4) && ($colIdx < 2 || $colId +x > 4); $rows[$rowIdx][$colIdx] = $main->Button( -textvariable => \$gameGrid[$rowIdx][$colIdx], -command => sub {onClick($rowIdx, $colIdx)} )->form( -top => $rowIdx * 20 + 2, -bottom => $rowIdx * 20 + 19, -left => $colIdx * 75 + 2, -right => $colIdx * 75 + 73 ); } } my @fromValue = ''; my $overValue = ''; my $lastToValue = ''; my $skipped = ''; my @stack; my $topPix = 7 * 20 + 2; my $botPix = 7 * 20 + 19; my $fromField = $main->Label(-textvariable => \$fromValue[0]) ->form( -top => $topPix, -bottom => $botPix, -left => 4, -right => 70 ); my $overField = $main->Label(-textvariable => \$overValue) ->form( -top => $topPix, -bottom => $botPix, -left => 74, -right => 140 ); my $toField = $main->Label(-textvariable => \$lastToValue) ->form( -top => $topPix, -bottom => $botPix, -left => 144, -right => 210 ); my $skippedField = $main->Label(-textvariable => \$skipped) ->form( -top => $topPix, -bottom => $botPix, -left => 214, -right => 460 ); my $undo = $main->Button(-text => 'undo', -command => sub {onUndo()}) ->form( -top => $topPix, -bottom => $botPix, -left => 464, -right => 510 ); my $save = $main->Button(-text => 'save', -command => sub {onSave()}) ->form( -top => $topPix, -bottom => $botPix, -left => 514, -right => 560 ); Tk::MainLoop(); sub onClick { my ($rowIdx, $colIdx) = @_; if (!$fromValue[0]) { $fromValue[0] = sprintf "%d, %d: %s", $rowIdx, $colIdx, $gameG +rid[$rowIdx][$colIdx]; $fromValue[1] = $rowIdx; $fromValue[2] = $colIdx; $lastToValue = ''; return; } if ($rowIdx == $fromValue[1] && $colIdx == $fromValue[2]) { $fromValue[0] = ''; return; } if ( !( ($rowIdx == $fromValue[1] && abs($colIdx - $fromValue[2 +]) == 2) || ($colIdx == $fromValue[2] && abs($rowIdx - $fromValue[1 +]) == 2) ) || $gameGrid[$rowIdx][$colIdx] ne '_' ) { $lastToValue = 'Invalid'; return; } my $rowMid = ($rowIdx + $fromValue[1]) / 2; my $colMid = ($colIdx + $fromValue[2]) / 2; push @stack, [$gameGrid[$rowMid][$colMid], @fromValue[1, 2], $rowI +dx, $colIdx]; $skipped = join ' ', map {$_->[0]} @stack; $gameGrid[$rowIdx][$colIdx] = $gameGrid[$fromValue[1]][$fromValue[ +2]]; $gameGrid[$rowMid][$colMid] = '_'; $gameGrid[$fromValue[1]][$fromValue[2]] = '_'; $fromValue[0] = ''; } sub onUndo { return if !@stack; my $move = pop @stack; my ($delChar, $fromRow, $fromCol, $toRow, $toCol) = @$move; my $rowMid = ($fromRow + $toRow) / 2; my $colMid = ($fromCol + $toCol) / 2; $gameGrid[$fromRow][$fromCol] = $gameGrid[$toRow][$toCol]; $gameGrid[$rowMid][$colMid] = $delChar; $gameGrid[$toRow][$toCol] = '_'; $skipped = join ' ', map {$_->[0]} @stack; $fromValue[0] = ''; } sub onSave { print "my \@gameGrid = (\n"; for my $rowIdx (0 .. 6) { print " [qw("; print join ' ', @{$gameGrid[$rowIdx]}; print ")],\n"; } print " );\n"; }
Optimising for fewest key strokes only makes sense transmitting to Pluto or beyond

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://11101663]
Approved by marto
Front-paged by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (5)
As of 2019-09-23 16:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The room is dark, and your next move is ...












    Results (281 votes). Check out past polls.

    Notices?