Re: Using a list as a variable
- To: mathgroup at smc.vnet.net
- Subject: [mg67135] Re: [mg67069] Using a list as a variable
- From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
- Date: Sat, 10 Jun 2006 04:53:34 -0400 (EDT)
- References: <200606080854.EAA12414@smc.vnet.net> <503E620F-D55A-41A7-8892-4795AB905053@mimuw.edu.pl> <003001c68b16$a63943f0$6501a8c0@bblaptop>
- Sender: owner-wri-mathgroup at wolfram.com
On 9 Jun 2006, at 01:14, Bonny Banerjee wrote:
>> *This message was transferred with a trial version of CommuniGate
>> (tm) Pro*
>>
>> On 8 Jun 2006, at 17:54, Bonny Banerjee wrote:
>>
>>> I would like to use a list (or set) as a variable. I am working
>>> on the
>>> Subset-Sum problem. Given a set S of integers, the goal is to
>>> find a subset
>>> of S (say Q) whose elements add to a given integer x. This is how
>>> I would
>>> like to define the function:
>>>
>>> SubsetSum(S, x) := {Q such that Q is a subset of S and sum of the
>>> elements
>>> of Q is x}
>>>
>>> In Mathematica functional programming language, this would look
>>> like:
>>>
>>> SubsetSum[S_, x_] := Reduce[Q \[Element] Subsets[S] && Sum[Q,
>>> {i,1,Length[Q]}]==x, Q, Reals]
>>>
>>> Now when I try to evaluate SubsetSum[{1, 3, 5, 2, 7, 100, 6},
>>> 101], the
>>> output is as follows:
>>>
>>> Reduce : : naqs :
>>> \[Exists]{Q} Q is not a quantified system of equations and
>>> inequalities. More ...
>>>
>>> Out[365]= Reduce[Q, False, Q, Reals]
>>>
>>>
>>> I guess, Mathematica is not being able to understand from my
>>> statement that
>>> the variable Q is not an atom but a list. But it should since I
>>> stated that
>>> Q is an element of the power set of S.
>>>
>>> Note that I know how to write a function for Subset-Sum using a
>>> Module. But
>>> I am interested in functional programming, similar to the format
>>> shown
>>> above.
>>>
>>> Any help would be appreciated.
>>>
>>> Thanks much,
>>> Bonny.
>>>
>>>
>>
>>
>> Reduce solves (or "reduces" ) algebraic and some transcendental
>> (e.g. trygonometric) equations and inequalities. Your problem is
>> not of this kind.
>>
>> One way to solve it:
>>
>> SubsetSum[S_, x_] := Select[Subsets[S], Total[#] == x &]
>>
>>
>> SubsetSum[{1, 3, 5, 2, 7, 100, 6}, 101]
>>
>>
>> {{1, 100}}
>>
>>
>> SubsetSum[{1, 3, 5, 2, 7, 100, 6}, 105]
>>
>>
>> {{5, 100}, {3, 2, 100}}
>>
>>
>> Andrzej Kozlowski
>> Tokyo, Japan
>>
>
> That was very helpful. Thanks.
>
> Now I would like to create a similar function for grouping a set of
> elements, say S, into n groups so that union of all those groups is
> S, intersection of any two groups is {}, and sum of variance of
> each group is minimized. Note that in SubsetSum, it was required to
> select a subset of S and check whether it elements add to x or not.
> So we could do Select[Subsets[S], ...].
>
> In grouping, it is required to select a set of subsets of S, and
> check whether their union is S and mutual intersection is {} and
> variance is minimized or not. So we need to do Select[Subsets
> [Subsets[S]], ...]. But that is going to be computationally very
> intensive as it will search in a space of O(2^(2^m)) elements where
> m is the number of elements in S.
>
> Is there a more computationally efficient method possible using the
> approach similar to SubsetSum?
>
> Thanks once again for your help.
> Bonny.
Hm... I am not quite sure if I understand you correctly. Obviously
you must be disallowing partitions into single element sets, since
the variance of such a singleton is zero so the splitting of a set
into disjoint singletons would always have the sum of variances zero.
So presumably you require your "groups" to have at least two elements
each?
If my assumption is correct, a simple-minded solution of your problem
could look as this. First we simply make a list of all partitions of
your set S. The function SetPartitions from the Combinatorica package
could be used for that. Then we remove all partitions containing a
set with one element. This is also easy. Finally we simply find the
partition with the smallest sum of variances. Here is a simple
implementation.
<< Discretemath`Combinatorica`
VarianceOrderedPartitions1[s_?(VectorQ[#, NumericQ] &)] :=
With[{p = DeleteCases[SetPartitions[s], {___, l_, ___} /;
Length[l] == 1], f = Total[Variance /@ #] &}, p[[Ordering[f /@ p]]]]
Let's try it on a simple example:
pts=VarianceOrderedPartitions1[{2, 3, 5, 7}]
{{{2, 3}, {5, 7}}, {{2, 3, 5, 7}}, {{2, 5}, {3, 7}}, {{2, 7}, {3, 5}}}
The actual sums of variances are:
Total[Variance/@#]&/@pts//N
{2.5,4.91667,12.5,14.5}
Of course this program is dreadfully slow. We can try to improve it
in various ways, by using backtracking for example, etc. But I think
the largest improvement will be made by observing that find the
partition with the smallest sum of variances we do not actually need
to consider all partitions into subsets but partitions into subsets
which have the property that for any two subsets all the elements in
one subset are either smaller or larger than all the elements in the
other subset. This makes it possible to write a much more efficient
program. It also makes use of the Combinatorica package, but this
time of the function Partitions[n], which gives all the partitions of
an integer n. I did not try to make it particularly functional or
efficient, but it still beats the first one by a huge margin.
VarianceOrderedPartitions2[SS_?(VectorQ[#, NumericQ] &)] := Module[{n =
Length[SS], f,
v, ord}, f[l_] := With[{s = FoldList[Plus, 0, l]}, Transpose[{Most
[s +
1], Rest[s]}]];
v = Map[Take[Sort[SS], #] &,
Map[f, Flatten[Permutations /@ DeleteCases[
Partitions[n], {___,
1, ___}], 1]], {2}]; v[[Ordering[Map[Total[Variance /@ #]
&, v]]]]]
Let's compare the performance on a random sample. I will use only 10
sample points as the function VarianceOrderedPartitions1 is too slow
for many more:
SS=Table[Random[Integer,{1,50}],{10}]
{3,35,27,36,43,15,43,18,49,17}
Let's try the first function, which considers all the possible
partitions:
Take[VarianceOrderedPartitions1[SS],2]//Timing
{10.169279*Second, {{{3, 15, 18, 17}, {35, 27, 36}, {43, 43, 49}},
{{3, 27, 15, 18, 17}, {35, 36}, {43, 43, 49}}}}
Now let's try to do it with the other:
Timing[Take[VarianceOrderedPartitions2[SS], 2]]
{0.015622000000000469*Second, {{{3, 15, 17, 18}, {27, 35, 36}, {43,
43, 49}}, {{3, 15, 17, 18, 27}, {35, 36}, {43, 43, 49}}}}
The answers are the same (except that the second function sorts the
numbers so the answer looks a bit different) but the difference in
the time taken is quite impressive. The winning partition {{3, 15,
17, 18}, {27, 35, 36}, {43, 43, 49}} has the sum of variances
Total[Variance/@#]&@{{3,15,17,18},{27,35,36},{43,43,49}}//N
84.5833
while the original set has variance
Variance[SS]//N
224.044
Andrzej Kozlowski
Tokyo, Japan
- References:
- Using a list as a variable
- From: "Bonny Banerjee" <banerjee@cse.ohio-state.edu>
- Using a list as a variable