Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2002
*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 2002

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

Search the Archive

Re: need a function for sums of subsets

  • To: mathgroup at smc.vnet.net
  • Subject: [mg33018] Re: [mg33001] need a function for sums of subsets
  • From: Andrzej Kozlowski <andrzej at tuins.ac.jp>
  • Date: Tue, 26 Feb 2002 04:35:00 -0500 (EST)
  • Sender: owner-wri-mathgroup at wolfram.com

After I sent the message below it occurred to me to try an recursive 
approach. It appears to be considerably faster but runs a risk of 
running out of memory. Still, if your lists are only as long as about 
100 elements it should be fine. Note that it gives a different answer 
than the other approach in cases when there are multiple solutions.

In[41]:=
findsum1[L_, m_] := findsum1[L, m] = Module[{u}, If[Plus @@ L == m, L,
      Do[If[(u = findsum1[Drop[L, {i}], m]) != {}, Return[u]], {i, 1, 
Length[L]}]]]

In[42]:=
findsum1[L_, m_] /; Length[L] == 1 := If[L[[1]] == m, L, {}]

We need to increase

$RecursionLimit = 10000

Let's compare the two functions on a random list:

In[49]:=
myrationals=Table[Random[Integer,{1,10}],{100}];

In[50]:=
m=26;

In[51]:=
findsum[myrationals,m]//Timing

Out[51]=
{5.35 Second,{7,9,10}}

In[52]:=
findsum1[myrationals,m]//Timing

Out[52]=
{0.04 Second,{10,7,9}}

Quite a difference in speed!





On Monday, February 25, 2002, at 12:32  PM, Andrzej Kozlowski wrote:

> It seems to me that this is just the sort of problem for which you 
> should use the technique known as "backtracking". The most efficient 
> way is to write your own backtracking program. But as that can be 
> tricky and time consuming another approach is to use the Backtrack 
> function from the DiscreteMath`Combinatorica` package. One can achieve 
> some speed up by partially compiling this function. Here is the code 
> that does that:
>
> Off[General::"spell"]; Off[General::"spell1"];
>
> 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
> 	];
>
> Solution =
>     Compile[{{space, _Integer, 2}, {index, _Integer, 1}, {count, 
> _Integer}},
> 	Module[{i}, Table[space[[ i, index[[i]] ]], {i, count}] ]];
>
>
> Note that the function is designed to work with integers. However, if 
> your lists consists of rationals it is easy to convert them to 
> integers. I am also going to assume that your list contains each number 
> only once. This can be relaxed but at a price of efficiency (see below).
>
> Here is first a code that works for lists of integers:
>
>
> findsum[L_, m_] :=
>   DeleteCases[Module[{sp, L1 = Prepend[L, 0], l, k = Length[L] + 1},
>       sp = Table[L1, {k}];
>       partialQ =
>         Compile[{{l, _Integer, 1}},
>           If[Length[l] == 1, True,
>             Plus @@ l â?¤ m && Plus @@ l + (k - Length[l])*Max[L] â?¥ m &&
>               If[l[[-1]] > 0, (l[[-1]] > l[[-2]]), True]]];
> solutionQ = Compile[{{l, _Integer, 1}}, Plus @@ l == m];
>       Backtrack[sp, partialQ, solutionQ, One]], 0]
>
> Let's try it on an example:
>
> In[5]:=
> L=Range[100];
>
> In[6]:=
> findsum[L,110]//Timing
>
> Out[6]=
> {0.18 Second,{10,100}}
>
> To allow rational input we add a definition:
>
>
> findsum[L_, m_] /; Not[FreeQ[L, Rational]] :=
>   Module[{d}, d = LCM @@ Denominator[Append[L, m]]; findsum[d *L, 
> d*m]/d]
>
> In[8]:=
> myrationals = {1/2, 1/3, 1/4, 1/8, 3/10, 12/79, 13/38};
>
> In[9]:=
> m=3/4;
>
> In[10]:=
> findsum[myrationals,m]
>
> Out[10]=
> {1/4, 1/2}
>
> Note that I have not preserved the order in which these terms appear in 
> your list. (It is easy to do so but I am not sure you need it so 
> decided not to bother).
>
> Of course your two list version is now also available:
>
> In[11]:=
> findsum[myrationals,#]&/@{3/4,3/8}
>
> Out[11]=
> {{1/4, 1/2}, {1/8, 1/4}}
>
> Finally, if you want to allow lists with repeated entries you need to 
> modify findsum. One way is:
>
>
> findsum[L_, m_] :=
>   DeleteCases[Module[{sp, L1 = Prepend[L, 0], l, k = Length[L] + 1},
>       sp = Table[L1, {k}];
>       partialQ =
>         Compile[{{l, _Integer, 1}},
>           If[Length[l] == 1, True,
>             Plus @@ l â?¤ m && Plus @@ l + (k - Length[l])*Max[L] â?¥ m &&
>               If[l[[-1]] > 0,
>                 If[Count[L, l[[-1]]] ==
>                     1, (l[[-1]] > l[[-2]]), (l[[-1]] >= l[[-2]])], 
> True]]];
> solutionQ = Compile[{{l, _Integer, 1}}, Plus @@ l == m];
>       Backtrack[sp, partialQ, solutionQ, One]], 0]
>
>
> For example:
>
> myrationals = {1/3, 1/2, 1/2};
>
> In[14]:=
> findsum[myrationals,1]
>
> Out[14]=
> {1/2, 1/2}
>
Andrzej Kozlowski
Toyama International University
JAPAN
http://platon.c.u-tokyo.ac.jp/andrzej/
>
>
> On Monday, February 25, 2002, at 07:31  AM, Mark Ganson wrote:
>
>> Hello,
>>
>> I need a function that will find the first subset of a list that will
>> sum up to a given value.
>>
>> For example, if I have a list of rationals:
>>
>> myrationals = {1/2, 1/3, 1/4, 1/8, 3/10, 12/79, 13/38}
>>
>> I would like a function that will return the first subset of
>> myrationals that sums up to a given parameter.
>>
>> We can call the function "findsum".  It would work like so:
>>
>> In: findsum[myrationals, 3/4]
>> Out: {1/2, 1/4}
>>
>> It would be nice also, but not essential, to be able to use another
>> list as the second parameter and have the function return a list of
>> lists.
>>
>> Example:
>>
>> In: findsum[myrationals, {3/4, 3/8}]
>> Out: {{1/2, 1/4}, {1/4, 1/8}}
>>
>> I need something really fast and memory efficient because my lists
>> tend to be quite large (up to 100 elements).
>>
>>
>> Many thanks,
>>
>> Mark Ganson
>>
>>
>>
>



  • Prev by Date: Re: need a function for sums of subsets
  • Next by Date: Re: need a function for sums of subsets
  • Previous by thread: Re: need a function for sums of subsets
  • Next by thread: Re: need a function for sums of subsets