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>