MathGroup Archive 2006

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

Search the Archive

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


  • Prev by Date: Re: WITM - A web interface to Mathematica
  • Next by Date: Re: Using a list as a variable
  • Previous by thread: Re: Using a list as a variable
  • Next by thread: Re: Using a list as a variable