Code to solve the "matrix formation" puzzle

[Rhose]

This code "solves" artist's puzzle posted in Matrix Formation. The problem presented was to find the largest divisor for an N x N matrix of digits such that the numbers formed by joining the digits in each row and numbers formed by joining the digits in each column all have a common divisor. In addition, the following restrictions were added:

1. No formed-number should start with 0.
2. No two formed-numbers are allowed to be the same.

For example, a 2 x 2 matrix is solved as:

2 1

8 4

The numbers formed are: 21, 84, 28, and 14 which all have a divisor of 7.

The code below has come up with the follwing solutions:

• 2x2: Divisor 7, Rows 21, 84
• 3x3: Divisor 44, Rows 132, 792, 660
• 4x4: Divisor 416, Rows 2496, 9152, 1664, 2080

#!/usr/bin/perl
#
# NOTES: This code will not solve a 1 x 1 matrix as all numbers are "r
+eused" 
#
use strict;
use warnings;

use constant TRUE       => 1;
use constant FALSE      => 0;

use constant MATRIX_DIM => 3; # Set your matrix size here
use constant MAX_NUM    => (10 ** MATRIX_DIM) - 1;

use constant DEBUG      => 0; # 0=Nothing, 1=Summary, 2=Detail

use constant SEPARATOR  => '-';


# Since you need to find 2 times the matrix width distinct numbers, yo
+u cannot
# have a divisor greater than the maximum number divided by that produ
+ct.
# 
# For example, a 3 x 3 matrix has a maximum number of 999. You need 6 
+distinct 
# numbers to "solve" the matrix, so the maximum possible divisor would
+ be 166.
# 166 would result in 166, 332, 498, 664, 830, and 996.
#
my $Divisor = int(MAX_NUM / (MATRIX_DIM * 2)); 

my @Num;
my @PermPtrs; # Saves the position of the pointers between GetNextPerm
+() calls
my @Sol=();

# GetNextPerm generates purmutations from the passed array (one at a t
+ime)
# and uses a global array of pointers (@PermPtrs). This method seems t
+o be
# fast and uses less memory than computing all the permutations at onc
+e.
#
# NOTE: The first time this sub is called, @PermPtrs should be an empt
+y array.
#
sub GetNextPerm
{
  my $pNum=shift;

  my $Perm='';
  my @PtrStack;

  if ($#PermPtrs > -1)
  {
    my $Ptr=MATRIX_DIM-1;
    while (TRUE)
    {
      $PermPtrs[$Ptr]++;
      if ($PermPtrs[$Ptr] > $#$pNum)
      {
        push @PtrStack,$Ptr;
        $Ptr--;
        return undef if ($Ptr == -1);
        next;
      }
      else
      {
        my $OkInc=TRUE;
        foreach (0..MATRIX_DIM-1)
        {
          next if ($_ == $Ptr);
          $OkInc=FALSE if ($PermPtrs[$_] == $PermPtrs[$Ptr]);
        }
        next unless($OkInc)
      }
      last unless ($#PtrStack > -1);
      $Ptr=pop(@PtrStack);
      $PermPtrs[$Ptr]=-1;
    }
  }
  else
  {
    @PermPtrs=(0..MATRIX_DIM-1);
  }
  
  foreach (@PermPtrs)
  {
    $Perm.=SEPARATOR if (length($Perm));
    $Perm.=$$pNum[$_];
  }

  return $Perm;
}

sub CheckSolution
{
  my $pNum=shift;

  my $CheckNum;
  my $PossSol;
  my $Ptr;
  my @Sol=();
  my %Check;
  my %Num;

  #
  # This code checks every permutation of possible numbers (from the p
+assed 
  # numberarray) as rows and checks if there are MATRIX_DIM other numb
+ers 
  # (also in the passed array) which can act as columns.
  #
  # For example, with a 3 x 3 matrix, this code should go through each
+ 
  # permutation of three number (for rows) from the passed array and s
+ee if
  # there are three other numbers which would work with the selected r
+ows as
  # their columns.
  #
  # WISH LIST: Verify members of each permutation for "fitness" in the
+ir 
  #            assigned spot. "Fitness" means you do not put a number 
+in the 
  #            top row whose first digit is not the first digit of at 
+least 
  #            one other number... whose second digit is not the first
+ digit 
  #            of at least one other number... etc... This may speed u
+p this
  #            section of the code. 
  #
  #            Benchmark the code which checks the columns (foreach $P
+tr block)
  #            That code gets executed a lot, and *may* benefit from r
+ecoding.
  #

  @PermPtrs=();
  while($PossSol=GetNextPerm($pNum))
  {
    print "\t",'Checking ',$PossSol,'... ' if (DEBUG >= 2);

    %Num=map { $_ => TRUE } @$pNum;
    @Sol=split(SEPARATOR,$PossSol);
    delete $Num{$_} foreach (@Sol);
    foreach $Ptr (0..length($Sol[0])-1)
    {
      $CheckNum='';
      $CheckNum.=substr($_,$Ptr,1) foreach (@Sol);
      if (defined($Num{$CheckNum}))
      {
        delete $Num{$CheckNum};
      }
      else
      {
        print 'nope',"\n" if (DEBUG >= 2);
        @Sol=();
        last;
      }
    }
    last if ($#Sol > -1);
  }

  return @Sol;
}


while ($Divisor >= 1)
{
  @Num=();
  foreach (1..int(MAX_NUM / $Divisor))
  {
    next if (($Divisor * $_) < (MAX_NUM / 10)); # Numbers which begin 
+with zero
    push @Num, ($Divisor * $_);
  }
  print 'Checking solution for divisor ',$Divisor,': ',join('-',@Num),
+"\n" 
    if (DEBUG >= 1);

  @Sol=CheckSolution(\@Num);
  last if ($#Sol > -1);
  $Divisor--;
}

print "\n";
if ($#Sol > -1)
{
  print 'Maximum divisor is ',$Divisor,', solution is ',join('-',@Sol)
+,"\n";
}
else
{
  print 'No solution found...',"\n";
}

# End of Script

Observation: Unless I really missed something, I could not find a good CPAN module which would generate permutations of n distinct numbers taken r at a time. This problem led to the GetNextPerm() sub which uses a series or r pointers which are moved through the array of numbers generating one permutation at a time.

[merlyn]

use constant TRUE       => 1;
use constant FALSE      => 0;

Declaring such constants in Perl is generally agreed to be a Bad Idea. The return value of many "true" values in Perl will generally not be equal to your "TRUE". And the return values of some "false" values is undef, which will only noisily be equal to your "FALSE" (when warnings are enabled).

Just use the truth and falsehood tests within Perl as designed. Don't invent a data type or constant that doesn't exist.

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

[Rhose]

Good point.

While I never use these constants for anything other than setting variables I declare, it would be easy to use them otherwise. I started this habit when I was first learning perl as a way of distinguishing "logical" and "numerics" in my code and for setting "logical" options in some modules (like DBI).

For example:

$gDBHandle = DBI->connect
  (
    'dbi:Oracle:' . ORATNS, ORAUSER, ORAPASS,
    {
      AutoCommit  => FALSE,
      PrintError  => FALSE,
      RaiseError  => FALSE,
    }
  ) || die 'Could not connect to Oracle ['.$DBI::errstr.' - '.$DBI::er
+r.']';

This just helped me remember I was turning "off" those options instead of setting some "numeric" to zero.

Thank you for the suggestion.

[tall_man]

Looks great, but you didn't use any of the solution-space reducing tricks I suggested in the other thread. Oh well, it turns out that when you get close to the solution, in most cases all the numbers get into the candidate lists.

In the inner loop, I think assigning to a hash is cheaper than deleting from it, so it might be better to assign 0 or undef instead of removing elements.

You mentioned not seeing an algorithm for permutations of n distinct numbers taken r at a time. You could use Algorithm::ChooseSubsets to select the elements, and then permute them with Algorithm::FastPermute.

[artist]

Hi,Rhose
Wonderful it works very well. Is it something easy to dertermine the order of your algorithm ?. That will give idea of how long it can take to run. I obsereved that for higher dimension it takes much longer.

Thanks,
artist

[tall_man]

It looks like exponential-order to me. I added some code to sum up the number of permutations of the sets:

  $bigtotal += Math::NumberCruncher::Permutation(scalar(@Num),MATRIX_D
+IM);
  @Sol=CheckSolution(\@Num);

Here are the results:

Order 4:
Maximum divisor is 416, solution is 2496-9152-1664-2080
Checked 19301184 cases
1445.940u 5.500s 27:10.91 88.9% 0+0k 0+0io 364pf+0w

Order 3:
Maximum divisor is 44, solution is 132-792-660
Checked 140526 cases
10.690u 0.050s 0:14.69 73.1%    0+0k 0+0io 364pf+0w

Order 2:Maximum divisor is 7, solution is 21-84
Checked 820 cases
0.290u 0.010s 0:00.33 90.9%     0+0k 0+0io 364pf+0w

At that rate, order 5 will test about 1 billion cases and take over a day to run. But I think it might be feasible if bad solution sets are eliminated early.

The big problem is the permutations, which are factorial order. I would suggest picking the corner two items first. They have to have the same top digit. Then that determines the possible top digits of the rest of the rows.