Mathematica 9 is now available
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: [mg33016] Re: [mg33001] need a function for sums of subsets
  • From: Andrzej Kozlowski <andrzej at tuins.ac.jp>
  • Date: Tue, 26 Feb 2002 04:34:57 -0500 (EST)
  • Sender: owner-wri-mathgroup at wolfram.com

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: Numerical Differentiation using Fourier Transform
  • 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