MathGroup Archive 2002

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

Search the Archive

need a function for sums of subsets

  • To: mathgroup at smc.vnet.net
  • Subject: [mg33050] need a function for sums of subsets
  • From: "Juan Erfá" <erfa11 at hotmail.com>
  • Date: Wed, 27 Feb 2002 00:48:11 -0500 (EST)
  • Sender: owner-wri-mathgroup at wolfram.com

Hi Mark, I don&#8217;t understand what you mean by &#8230; return the 
&#8220;first&#8221; subset &#8230;
Anyway, you can use my function, I sent days ago (Iterators), which I wrote 
for integers, but I think can be use also for rationales.
Her you get the rational n in s parts, only with numbers in the list x of 
rationales.

In[1]:=QQ[n_, s_, x_List] :=
  Module[{a = Array[p, s, 0], w, v, r, d, q, t, sol, u = Union[x]},
  p[0] = 0;
  Off[Part::pspec];
  w = Table[r[[p[i]]], {i, s - 1}];
  v = Flatten[{w, n - Plus @@ w}]; r = u;
  d = Last[Position[r, _?(#1 < n/2 & )]][[1]] - s + 1;
  t = Table[{p[i], p[i - 1] + 1, d + i}, {i, s - 1}];
  sol = Flatten[Table[v, Evaluate[Sequence @@ t]], Abs[s - 2]];
  Select[sol, MemberQ[x, Last[#1]] && Last[#1] > #1[[-2]] & ]]

In[1]:=q = {1/2, 1/3, 1/4, 1/8, 3/10, 12/79, 13/38};
In[3]:=QQ[3/4, 2, q]
Out[3]={{1/4, 1/2}}

In[4]:=QQ[3/8, 2, q]
Out[4]={{1/8, 1/4}}

In[5]:=(QQ[#1, 2, q] & ) /@ {3/4, 3/8}
Out[5]={{{1/4, 1/2}}, {{1/8, 1/4}}}

In[6]:=QQ[61/84, 3, {1/8, 1/7, 1/4, 1/3, 1/2}]
Out[6]={{1/7, 1/4, 1/3}}

In[7]:=w = 1/Table[Random[Integer, {1, 20}], {50}]
Out[7]={1/7, 1/10, 1/3, 1/11, 1/3, 1/2, 1/7, 1/19, 1/2, 1/11, 1/11, 1/16, 
1/11, 1/14, 1/5, 1/9, 1/10, 1/16, 1, 1, 1/17,  1/15, 1/6, 1, 1/18, 1/20, 
1/11, 1/3, 1/14, 1/8, 1/20, 1/13, 1/16, 1/5, 1/18, 1/13, 1/11, 1/8, 1/20, 
1/2, 1, 1/20, 1/10, 1/18, 1/16, 1/5, 1/20, 1/16, 1/4, 1/2}
In[8]:=Timing[QQ[297/560, 4, w]]
Out[8]={0.13*Second, {{1/16, 1/8, 1/7, 1/5}}}

This function need to be correct, sure in the part of the code:
d=Last[&#8230;.],and t=Table[&#8230;].

Regards
Juan




_________________________________________________________________
Con MSN Hotmail súmese al servicio de correo electrónico más grande del 
mundo. http://www.hotmail.com/ES



  • Prev by Date: RE: Hint on: Problems converting mathematica notebook to PDF with Acrobat Distiller
  • Next by Date: Re: removing rules from function definitions
  • Previous by thread: Re: need a function for sums of subsets
  • Next by thread: sum problem with infinity