Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Code to solve the "matrix formation" puzzle

by Rhose (Priest)
on Jun 20, 2003 at 15:47 UTC ( #267624=CUFP: print w/ replies, xml ) Need Help??

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.

Comment on Code to solve the "matrix formation" puzzle
Download Code
On TRUE and FALSE
by merlyn (Sage) on Jun 20, 2003 at 16:37 UTC
    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.

      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.

Re: Code to solve the "matrix formation" puzzle
by tall_man (Parson) on Jun 20, 2003 at 16:44 UTC
    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.

Re: Code to solve the "matrix formation" puzzle
by artist (Parson) on Jun 20, 2003 at 17:24 UTC
    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

      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.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (3)
As of 2014-07-31 04:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (244 votes), past polls