We don't bite newbies here... much PerlMonks

### Number Grid Fillin

by QM (Parson)
 on Aug 14, 2017 at 08:41 UTC ( #1197354=CUFP: print w/replies, xml ) Need Help??

Saw this idea recently. Wondered how susceptible it would be to a brute force approach.

Given a square grid size N, and a list of numbers 2*N**2 2*N, find a fillin (like a crossword), and report the digits in the major diagonal (as an easy proof of solution).

The reference in the spoiler took an hour or two to find the solution. I won't post the solution here, you'll have to do the work yourself.

```#!/usr/bin/env perl

# eliottline.com, puzzle 112
# http://www.elliottline.com/puzzles-1/2017/8/11/puzzle-of-the-week-11
+2-number-fill-in

# Given 12 6-digit numbers, fill in the 6x6 grid.
# Report the 6 digit number from the major diagonal.

use strict;
use warnings;

use File::Basename;

# Autoflush stdout
BEGIN { \$| = 1 }

#######################
# options and defaults

our \$GRID_DEFAULT = 6;
our \$GRID_OPT = '-g';
our \$GRID = \$GRID_DEFAULT;
our \$HELP = '^\D\$'; # Not a known option, and not a number

############################

sub usage {
my(\$filename, \$dirs, \$suffix) = fileparse(\$0);
my \$script_name = \$filename . \$suffix;

print STDERR "Solve Elliot's Puzzle of the Week #112\n\n";
print STDERR "Usage:\n";
print STDERR "\t\$script_name [\$GRID_OPT grid_size] [list_of_number
+s]\n\n";
print STDERR "Default grid size is \$GRID_DEFAULT\n\n";
print STDERR "Grid is square, there must be 2x numbers for a grid
+of size x.\n\n";
exit;
}

our @NUMS_DEFAULT = qw(113443 143132 241131 321422 323132 331222
341114 412433 414422 431331 443112 444313);

our @nums;

######################
# Process the command line

while (@ARGV) {
if (\$ARGV[0] eq \$GRID_OPT and defined(\$ARGV[1]))  {
\$GRID = \$ARGV[1];
shift;shift;
next;
}

if (\$ARGV[0] =~ m/\$HELP/)  {
usage();
}

push @nums, shift;
}

if (not @nums) {
@nums = @NUMS_DEFAULT;
}

###########################
# We might do this a lot, so cache the results
# Closure, so put this before the function is called.
{
my @factorial;
\$factorial[0] = 1;

sub factorial {
my \$n = shift;

# If we already know it, return it
return \$factorial[\$n] if defined \$factorial[\$n];

# Else compute it from the largest known result
my \$result = \$factorial[\$#factorial];
for my \$k ( \$#factorial+1..\$n ) {
\$result *= \$k;
}
return \$result;
}
}

#########################

if (scalar(@nums) != (2 * \$GRID)) {
die sprintf "Wrong number count, expected %d, have %d\n",
2 * \$GRID, scalar(@nums);
}

# Create a hash of arrays, to store the digits of each number
our %nums;
for my \$num (@nums) {
push @{\$nums{\$num}}, split '', \$num;
}

printf STDERR "%d total permutations\n", factorial(scalar @nums);
# Now the work loop
for my \$n (0..factorial(scalar @nums)-1)
{
if (\$n % 100000 == 0) {
print STDERR "\$n ";
}
my @perm = permutation_n(\$n,@nums);
if (tryit(@perm)) {
print "\n*** permutation: \$n ***\n";
print "grid:\n";
for my \$p (@perm[0..(@perm/2-1)]) {
print "\t\$p\n";
}
print "Diagonal: ";
for my \$i (0..int(@perm/2)) {
print substr(\$perm[\$i], \$i, 1);
}
print "\n";
exit;
}
} continue {
\$n++;
}

exit;

###########################################
# Try the given permutation
sub tryit {
my @perm = @_;

# Fill a grid with the first half of the numbers (horizontally)
my @grid1;
for my \$x (0..\$GRID-1) {
for my \$y (0..\$GRID-1) {
\$grid1[\$y][\$x] = \$nums{\$perm[\$x]}[\$y];
}
}

# Fill a grid with the remaining numbers (vertically)
my @grid2;
for my \$p (@perm[\$GRID..\$#perm]) {
\$grid2[@grid2] = \$nums{\$p};
}

return grid_compare(\@grid1, \@grid2);
}

###########################################
# Compare 2 arrays
sub grid_compare {
my \$g1 = shift;
my \$g2 = shift;
my @g1 = @\$g1;
my @g2 = @\$g2;

for my \$x (0..\$#g1) {
for my \$y (0..\$#{\$g1[\$x]}) {
return 0 if \$g1[\$x][\$y] != \$g2[\$x][\$y];
}
}
return 1;
}

###########################################
# Find and return the \$n'th permutation
# of the remaining arguments in some canonical order
# (modified from QOTW solution)
sub permutation_n {
my \$n = shift;
my @result;
while (@_) {
(\$n, my \$r) = (int(\$n/@_), \$n % @_);
push @result, splice @_, \$r, 1;
}
return @result;
}

-QM
--
Quantum Mechanics: The dreams stuff is made of

Replies are listed 'Best First'.
Re: Number Grid Fillin
by tybalt89 (Priest) on Aug 14, 2017 at 12:05 UTC

Fun problem!

I call this "Smart Brute Force".
It fills in one column at a time with each remaining number in turn, then checks to see if the leading parts of each row are possible from left over numbers.

```#!/usr/bin/perl -l

# http://perlmonks.org/?node_id=1197354

use strict;
use warnings;

@ARGV or @ARGV = qw( 113443 143132 241131 321422 323132 331222
341114 412433 414422 431331 443112 444313 );

my \$half = @ARGV / 2;
my \$steps = 0;

my @stack = [ "\n" x \$half, join '', map "\$_\n", @ARGV ];

NEXT:
while( @stack )
{
my (\$have, \$rest) = @{ pop @stack };
\$steps++;

my %lefts;                            # validate legal so far
\$lefts{\$_}++ for \$have =~ /^(.+)\n/gm;
{
\$lefts{\$head} <= ( () = \$rest =~ /^\$head/gm ) or goto NEXT;
}

if( \$rest =~ tr/\n// == \$half )    # half left means completed
{
print "diagonal  ", \$have =~ /(\d)(?:..{\$half})?/gs;
exit;
}

while( \$rest =~ /^(.+)\n/gm )      # try each number remaining
{
my (\$before, \$after, @digits) = (\$`, \$', split //, \$1);
push @stack,
[ \$have =~ s/(?=\n)/ shift @digits /ger, \$before . \$after ];
}
}

print "failed to find solution in \$steps steps\n";

Output:

```answer in 35 steps

412433
414422
431331
341114
143132
331222

diagonal  411132

Computes the answer in less than 0.1 seconds.

Re: Number Grid Fillin
by hdb (Monsignor) on Aug 15, 2017 at 12:40 UTC

Thanks for posting this inspiring problem. Similar to what tybalt89 has posted, one can significantly reduce the search space by checking whether for a given number in a given position the remaining numbers would still fit. Below some code to do that based on positions counting from 0 to 5 and each can be vertical or horizontal. Given the output it is nearly trivial to solve the puzzle manually.

```use strict;
use warnings;

my @numbers = qw( 113443 143132 241131 321422 323132 331222
341114 412433 414422 431331 443112 444313 );

# find possible positions
my %positions;
for my \$n (@numbers) {
\$positions{\$n} = [];
# frequency of digits in current number
my @nfreq = (0) x 5;
\$nfreq[\$_]++ for split //, \$n;
# check which position is possible
for my \$p (0..5) {
# frequency of digits in current position w/o current number
my @freq = (0) x 5;
\$freq[substr( \$_, \$p, 1 )]++ for @numbers;
\$freq[substr( \$n, \$p, 1 )]--;
# check if position is feasible
# ie enough of each digit available
my \$possible = 1;
\$freq[\$_]<\$nfreq[\$_] and \$possible = 0 for 1..4;
push @{\$positions{\$n}}, \$p if \$possible;
}
}

for my \$n (sort { scalar(@{\$positions{\$a}}) <=> scalar(@{\$positions{\$b
+}}) } @numbers) {
print "Number \$n can be at positions @{\$positions{\$n}}.\n";
}

Re: Number Grid Fillin
by LanX (Bishop) on Aug 14, 2017 at 15:56 UTC

Create A New User
Node Status?
node history
Node Type: CUFP [id://1197354]
Approved by davies
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (6)
As of 2018-05-23 17:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
World peace can best be achieved by:

Results (172 votes). Check out past polls.

Notices?