Re: Re: A puzzle for Mathematica
- To: mathgroup at smc.vnet.net
- Subject: [mg42441] Re: [mg42404] Re: [mg42393] A puzzle for Mathematica
- From: Kirk Reinholtz <kirk.reinholtz at jpl.nasa.gov>
- Date: Tue, 8 Jul 2003 04:37:22 -0400 (EDT)
- References: <200307050710.DAA19856@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
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 > > > > 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/
- References:
- Re: A puzzle for Mathematica
- From: Andrzej Kozlowski <akoz@mimuw.edu.pl>
- Re: A puzzle for Mathematica