RE: Re: Summing list subsets
- To: mathgroup at smc.vnet.net
- Subject: [mg30805] RE: [mg30768] Re: Summing list subsets
- From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.de>
- Date: Wed, 19 Sep 2001 00:16:46 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Mark,
just for fun,... here an alternative solution; perhaps not for very best
performance,though interesting for certain application. Assuming that your
"keys" in x can be made Mathematica symbols, we may directly assign to them
the intended values:
In[20]:= x={a,a,b,b,b,b,c,d,d,d,d,d};
In[21]:= y={1,1,2,2,2,2,3,4,4,4,4,4};
In[22]:= l=Transpose[{x,y}]
In[33]:=
With[{fun=Plus,unit=0},
Function[{sym,val},
If[ValueQ[sym],sym=fun[sym,val],sym=fun[unit,val]],
HoldFirst]@@@l];
In[34]:= {a,b,c,d}
Out[34]= {2,8,3,20}
In[41]:= Clear[a,b,c,d]
In[39]:=
With[{fun=Append,unit={}},
Function[{sym,val},
If[ValueQ[sym],sym=fun[sym,val],sym=fun[unit,val]],
HoldFirst]@@@l];
In[40]:= {a,b,c,d}
Out[40]= {{1,1},{2,2,2,2},{3},{4,4,4,4,4}}
Attributing Flat to function F we get Allan's result:
In[64]:= Attributes[F]={Flat};
In[65]:= Clear[a,b,c,d,e,f]
In[66]:=
x={a,b,b,b,b,c,d,d,d,d,d,e,f,a};
y={1,2,0,3,-1,-3,4,5,-4,-2,6,-6,0,-5};
In[68]:=
With[{fun=F},
Function[{sym,val},
If[ValueQ[sym],sym=fun[sym,val],sym=fun[val]],
HoldFirst]@@@Transpose[{x,y}]];
In[69]:= {a,b,c,d,e,f}
Out[69]=
{F[1,-5],F[2,0,3,-1],F[-3],F[4,5,-4,-2,6],F[-6],F[0]}
Yours, Hartmut Wolf
> -----Original Message-----
> From: Allan Hayes [SMTP:hay at haystack.demon.co.uk]
To: mathgroup at smc.vnet.net
> Sent: Monday, September 10, 2001 2:43 AM
> To: mathgroup at smc.vnet.net
> Subject: [mg30768] Re: Summing list subsets
>
> Mark,
> Here is a variant of my previous function; it keeps the order of the y
> values for each element in Union[x].
>
> Aggregate2[x_,y_, F_]:=
> {First[#1],F@@y[[#2]]}&@@@Transpose/@Split[Sort[
> Transpose[{x,Range[Length[x]]}]], #[[1]]==#2[[1]]&]
>
> x = {a,b,b,b,b,c,d,d,d,d,d,e,f,a};
> y = {1,2,0,3,-1,-3,4,5,-4,-2,6,-6,0,-5};
>
> Aggregate2[x,y,F]
>
> {{a,F[1,-5]},{b,F[2,0,3,-1]},{c,F[-3]},{d,F[4,5,-4,-2,6]},{e,F[-6]},{f,F[0
> ]}
> }
>
> --
> Allan
> ---------------------
> Allan Hayes
> Mathematica Training and Consulting
> Leicester UK
> www.haystack.demon.co.uk
> hay at haystack.demon.co.uk
> Voice: +44 (0)116 271 4198
> Fax: +44 (0)870 164 0565
>
> "Allan Hayes" <hay at haystack.demon.co.uk> wrote in message
> news:9nf62q$sdi$1 at smc.vnet.net...
> > Mark,
> > Two suggestions:
> >
> > This is the most versatile, allowing for arbitrary ordering and zeros
> and
> > cancelation in y.
> >
> > x = {a,b,b,b,b,c,d,d,d,d,d,e,f,a};
> > y = {1,2,2,2,2,3,4,4,4,4,4,1,0,-1};
> >
> > Aggregate[x_,y_, F_]:=
> > Apply[
> > {First[#1],F@@#2}&
> > ,
> > Transpose/@
> > Split[
> > Sort[Transpose[{x,y}]],
> > First[#1]== First[#2]&
> > ]
> > ,
> > {1}
> > ]
> >
> > Aggregate[x,y,F]
> >
> > {{a,F[-1,1]},{b,F[2,2,2,2]},{c,F[3]},{d,F[4,4,4,4,4]},{e,F[1]},{f,F[0]}}
> >
> >
> > This is quicker for your particular example, but does not allow for
> zeros
> > and cancellation in the
> >
> > Replace[
> > Tr[x y]/.z_Plus:>List@@z,
> > x_. y_Symbol:> {x,y},
> > {1}
> > ]
> >
> > {{8,b},{3,c},{20,d},{1,e}}
> >
> > --
> > Allan
> > ---------------------
> > Allan Hayes
> > Mathematica Training and Consulting
> > Leicester UK
> > www.haystack.demon.co.uk
> > hay at haystack.demon.co.uk
> > Voice: +44 (0)116 271 4198
> > Fax: +44 (0)870 164 0565
> >
> > "Mark Coleman" <mcoleman at bondspace.com> wrote in message
> > news:9ncfgn$prb$1 at smc.vnet.net...
> > > Greetings:
> > >
> > > Consider two lists:
> > >
> > > x = {a,a,b,b,b,b,c,d,d,d,d,d,} and y = {1,1,2,2,2,2,3,4,4,4,4,4}
> > >
> > > I would like to have a function that returns the sum (or any other
> > function)
> > > of each unique element of x, given the corresponding value in y. That
> is,
> > > for a 'Sum', the result would be
> > >
> > > z={{a,2},{b,8},{c,3},{d,20}}
> > >
> > > This is similar in spirit to a common database aggregation problem.
> > >
> > > Any ideas?
> > >
> > > Thanks.
> > >
> > > -Mark
> > >
> > >
> >
> >
> >
>
>