Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: A puzzle for Mathematica

• To: mathgroup at smc.vnet.net
• Subject: [mg42404] Re: [mg42393] A puzzle for Mathematica
• From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
• Date: Sat, 5 Jul 2003 03:10:52 -0400 (EDT)
• Sender: owner-wri-mathgroup at wolfram.com

On Friday, July 4, 2003, at 02:33 PM, Souvik Banerjee wrote:

> Hello,
>
> How many n x n binary matrices (that is, whose elements are either 0 
> or 1)
> are possible such that each row and each column sum exactly to m <= n 
> (both
> m and n are positive integers)?
>
> How do you solve this in Mathematica? A method for generating would be 
> good
> to although not necessary.
>
> Thanks,
>
> -Souvik
>

One way to solve such problems is by using a technique known as 
"backtracking". The most efficient approach would be to write a custom 
backtracking function and compile it. A much slower and less memory 
efficient  but simpler approach is to make use of the "general" 
backtracking function Backtrack from the Combinatorica package. Here is 
how it works:

We first load the Combinatorica package:

In[1]:=
<< "DiscreteMath`Combinatorica`"

let's consider the case k=3 and n =5

In[2]:=
k = 3; n = 5;

This creates a list consisting of all arrangements of k 1's and n-k 
0's, which will be the rows of our matrices:

In[3]:=
s = Permutations[Join[Table[1, {k}], Table[0, {n - k}]]];

Next we create the "space" over which we shall backtrack, choosing rows 
in such a way that the condition that sum of the elements in a column 
is no greater than k is not violated:

In[4]:=
space = Table[s, {n}];

here is the test for a "partial" solution:
In[5]:=
partialQ[l_List] := And @@ Thread[Plus @@ l <= k]

here is the test for a final solution:

In[6]:=
solutionQ[l_List] := And @@ Thread[Plus @@ l == k]

Now we apply the Backtrack function with the fourth argument All, which 
makes it find all the matrices:

In[7]:=
Length[Backtrack[space,partialQ,solutionQ,All]]//Timing

Out[7]=
{24.32 Second,2040}

So there are 2040 solutions. The timing (on a 400 megahertz Mac) is not 
impressive. However, in my experience a compiled custom backtracking 
program can be in such a situation at least two orders of magnitude 
faster. You can see some examples in past posting to this list by 
searching for the word "backtrack".

Andrzej Kozlowski
Yokohama, Japan
http://www.mimuw.edu.pl/~akoz/
http://platon.c.u-tokyo.ac.jp/andrzej/

• Follow-Ups:
  • Re: Re: A puzzle for Mathematica
    • From: Kirk Reinholtz <kirk.reinholtz@jpl.nasa.gov>