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