A puzzle for Mathematica

[Souvik Banerjee]

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

[Andrzej Kozlowski]

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/

[Dr Bob]

Here are six solutions for n=3, m=1.

eqns[(n_Integer)?Positive, (m_Integer)?Positive] :=
Join[Join[Table[Sum[a[i, k], {k, 1, n}] == m, {i, 1, n}], Table[Sum[a[k,
i], {k, 1, n}] == m, {i, 1, n}]],
Flatten[Table[0 <= a[i, j] <= 1, {i, 1, n}, {j, 1, n}]]]
vars[(n_Integer)?Positive] := Flatten[matrix[n]]
matrix[(n_Integer)?Positive] := matrix[n] = Table[a[i, j], {i, 1, n}, {j,
1, n}]

n = 3; m = 1;
soln = Last@Maximize[{0, eqns[n, m]}, vars[n]]
(r = matrix[n] /. soln) // MatrixForm

(Outer[r[[#1, #2]] &, Permutations@Range@n, Permutations@Range@n, 1] /.
soln // Flatten[#, 1] & // Union)
MatrixForm /@ %

Bobby

On Fri, 4 Jul 2003 01:33:11 -0400 (EDT), Souvik Banerjee <s-
bane...@nwu.edu> 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
>
>
>

--
maj...@cox-internet.com
Bobby R. Treat

[Kirk Reinholtz]

I used backtracking on a "similar" problem. Here's the algorithm,
perhaps it will help
http://forums.wolfram.com/mathgroup/archive/2003/Apr/msg00409.html

Andrzej Kozlowski wrote:

>
> 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
> >
>