Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2001
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2001

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

Search the Archive

Re: [Q] Generalized Partitions

  • To: mathgroup at smc.vnet.net
  • Subject: [mg30010] Re: [mg29942] [Q] Generalized Partitions
  • From: Andrzej Kozlowski <andrzej at tuins.ac.jp>
  • Date: Sat, 21 Jul 2001 00:49:18 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

Unfortunately the code I sent below contained one silly mistake (more of a
misprint) and one "misjudgement". The mistake is in the code where I should
have distinguished the given list (which I shall denote by capital letter L)
and the partial solution l. The misjudgement was counting separately
permutations of the same solutions which greatly increases their number. So
here is my corrected code in the same case as below. I Use the same modified
Backtrack function (by the way you need not worry about all spell messages
Mathematica produces when that is evaluated):

We begin as below (but note the capital L!):

In[5]:=
n=51;
k=6;
In[7]:=
L={1,4,7,10,13,16,19,22,25,28,31,34,37,40,43,47,50,53,56,59};
In[8]:=
sp=Table[L,{k}];


partialQ[l_] /; Length[l] == 1 = True;
partialQ[l_] := Tr[l] + (k - Length[l])*Min[L] <= n && Tr[l] + (k -
Length[l])*Max[L] >= n &&l[[-1]] >= l[[-2]];
solutionQ[l_] := Tr[l] == n;

Notice the capilal and small l's. Also, I have added the conditions that the
numbers in solutions should not decrease:

{5.79 Second,{{1,1,1,1,4,43},{1,1,1,1,7,40},{1,1,1,1,10,37},{1,1,1,1,13,
34},{1,1,1,1,16,31},{1,1,1,1,19,28},{1,1,1,1,22,25},{1,1,1,4,4,40},{1,1,
1,4,7,37},{1,1,1,4,10,34},{1,1,1,4,13,31},{1,1,1,4,16,28},{1,1,1,4,19,
25},{1,1,1,4,22,22},{1,1,1,7,7,34},{1,1,1,7,10,31},{1,1,1,7,13,28},{1,1,
1,7,16,25},{1,1,1,7,19,22},{1,1,1,10,10,28},{1,1,1,10,13,25},{1,1,1,10,
16,22},{1,1,1,10,19,19},{1,1,1,13,13,22},{1,1,1,13,16,19},{1,1,1,16,16,
16},{1,1,4,4,4,37},{1,1,4,4,7,34},{1,1,4,4,10,31},{1,1,4,4,13,28},{1,1,
4,4,16,25},{1,1,4,4,19,22},{1,1,4,7,7,31},{1,1,4,7,10,28},{1,1,4,7,13,
25},{1,1,4,7,16,22},{1,1,4,7,19,19},{1,1,4,10,10,25},{1,1,4,10,13,
22},{1,1,4,10,16,19},{1,1,4,13,13,19},{1,1,4,13,16,16},{1,1,7,7,7,
28},{1,1,7,7,10,25},{1,1,7,7,13,22},{1,1,7,7,16,19},{1,1,7,10,10,22},{1,
1,7,10,13,19},{1,1,7,10,16,16},{1,1,7,13,13,16},{1,1,10,10,10,19},{1,1,
10,10,13,16},{1,1,10,13,13,13},{1,4,4,4,4,34},{1,4,4,4,7,31},{1,4,4,4,
10,28},{1,4,4,4,13,25},{1,4,4,4,16,22},{1,4,4,4,19,19},{1,4,4,7,7,
28},{1,4,4,7,10,25},{1,4,4,7,13,22},{1,4,4,7,16,19},{1,4,4,10,10,22},{1,
4,4,10,13,19},{1,4,4,10,16,16},{1,4,4,13,13,16},{1,4,7,7,7,25},{1,4,7,7,
10,22},{1,4,7,7,13,19},{1,4,7,7,16,16},{1,4,7,10,10,19},{1,4,7,10,13,
16},{1,4,7,13,13,13},{1,4,10,10,10,16},{1,4,10,10,13,13},{1,7,7,7,7,
22},{1,7,7,7,10,19},{1,7,7,7,13,16},{1,7,7,10,10,16},{1,7,7,10,13,
13},{1,7,10,10,10,13},{1,10,10,10,10,10},{4,4,4,4,4,31},{4,4,4,4,7,
28},{4,4,4,4,10,25},{4,4,4,4,13,22},{4,4,4,4,16,19},{4,4,4,7,7,25},{4,4,
4,7,10,22},{4,4,4,7,13,19},{4,4,4,7,16,16},{4,4,4,10,10,19},{4,4,4,10,
13,16},{4,4,4,13,13,13},{4,4,7,7,7,22},{4,4,7,7,10,19},{4,4,7,7,13,
16},{4,4,7,10,10,16},{4,4,7,10,13,13},{4,4,10,10,10,13},{4,7,7,7,7,
19},{4,7,7,7,10,16},{4,7,7,7,13,13},{4,7,7,10,10,13},{4,7,10,10,10,
10},{7,7,7,7,7,16},{7,7,7,7,10,13},{7,7,7,10,10,10}}}

This looks to me already like a reasonable code to try running on your
problem with n=2500 and k =18. I think I shall try running it overningth
myself.


-- 
Andrzej Kozlowski
Toyama International University
JAPAN

http://platon.c.u-tokyo.ac.jp/andrzej/
http://sigma.tuins.ac.jp/~andrzej/


on 01.7.20 5:01 PM, Andrzej Kozlowski at andrzej at tuins.ac.jp wrote:

> Since your problem involves rather large numbers none of the methods I have
> suggested so far will work. Both of them build up unnecessarily long lists.
> The method to use is known as backtracking. The most efficient way would be
> to write your own backtracking program. However, one can also rely on the
> already existing "general" one in the Combinatorica package. In your case it
> will take a very long time (you need a fast computer and be ready to wait).
> 
> To speed up thecomputations it would be a good idea to be able to Compile
> the Backtrack function. I have not quite been able to do this so far (I
> would need to think about it more, as there seem to be some difficulties and
> I have little experience with compiling functions) but I have complied a one
> component of the function (the Solution function below) which results in a
> speed up of 55%. Compiling the entire function should result in additional
> gains.
> 
> Here is the code of the Backtrack function taken form the Combinatorica
> package and modified to use Compile:
> 
> In[1]:=
> Backtrack[space_List,partialQ_,solutionQ_,flag_:One] :=
> Module[{n=Length[space],all={},done,index,v=2,solution},
> index=Prepend[ Table[0,{n-1}],1];
> While[v > 0,
> done = False;
> While[!done && (index[[v]] < Length[space[[v]]]),
> index[[v]]++;
> done = Apply[partialQ,{Solution[space,index,v]}];
> ];
> If [done, v++, index[[v--]]=0 ];
> If [v > n,
> solution = Solution[space,index,n];
> If [Apply[solutionQ,{solution}],
> If [SameQ[flag,All],
> AppendTo[all,solution],
> all = solution; v=0
> ]
> ];
> v--
> ]
> ];
> all
> ];
> 
> In[2]:=
> Solution=Compile[{{space,_Integer,2},{index,_Integer,1},{count,_Integer}},
> Module[{i}, Table[space[[ i,index[[i]] ]], {i,count}] ]]
> 
> Now we set up the auxiliary functions for our problem and the problem
> itself. I shall much smaller data than you want to use. This much smaller
> example below is pretty fast:
> 
> In[3]:=
> l={1,4,7,10,13,16,19,22,25,28,31,34,37,40,43,47,50,53,56,59};
> In[4]:=
> k=6;
> In[5]:=
> n=51;
> 
> In other words, we shall try to find the partitions of 51 as a sum of 6
> members of the list l.
> 
> Next we define the solution space for our problem, the test for a partial
> solution (a potential solution is rejected if it fails the test) and the
> test for the final solution.
> 
> In[6]:=
> sp = Table[l, {k}];
> 
> In[7]:=
> partialQ[l_, n_] := Tr[l] + (k - Length[l])*Min[l] <= n &&
> Tr[l] + (k - Length[l])*Max[l] >= n
> 
> In[8]:=
> solutionQ[l_, n_] := Tr[l] == n
> 
> 
> Now we can run our program:
> 
> In[9]:=
> Length[Backtrack[sp,partialQ[#,n]&,solutionQ[#,n]&,All]]//Timing
> Out[9]=
> {10.4333 Second,1386}
> 
> This was done on a 400 MHZ Macintosh. The problem is certainly of high time
> complexity so for your size of data I would expect a very long wait.
> 




  • Prev by Date: Re: [Q] Generalized Partitions
  • Next by Date: Re: Proof For Cov. Matrix equation?
  • Previous by thread: Re: [Q] Generalized Partitions
  • Next by thread: Re: Re: [Q] Generalized Partitions