Re: Re: Summing list subsets
- To: mathgroup at smc.vnet.net
- Subject: [mg30810] Re: [mg30768] Re: Summing list subsets
- From: "Allan Hayes" <hay at haystack.demon.co.uk>
- Date: Wed, 19 Sep 2001 00:16:54 -0400 (EDT)
- References: <933FF20B19D8D411A3AB0006295069B02869DE@dassne02.darmstadt.dsh.de>
- Sender: owner-wri-mathgroup at wolfram.com
Hartmut, Mark,
Hartmut, Aggregate2 below is a variant of your method. It does not need the
x-list to be made up of symbols and seems to be about twice as fast, but it
is only about a quarter as fast as my previously posted function, Aggregate
Aggregate2[x_,y_,F_]:=
Module[{f,h},
f[_h,s_,v_]:= h[s]=F[v];
f[_,s_,v_]:= h[s]=F[h[s],v];
MapThread[f,{h/@x,x,y}];
Composition[Flatten,h]/@Union[x]
]
Aggregate[x_,y_, F_]:=
{First[#1],F@@y[[#2]]}&@@@Transpose/@(Split[Sort[
Transpose[{x,Range[Length[x]]}]], First[#]==First[#2]&])
TEST:
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};
xb = Table[Random[Integer,{1,100}],{20000}];
yb= Table[Random[Integer,{-50,50}],{20000}];
Aggregate2[x,y,F]
{F[1,-5],F[2,0,3,-1],F[-3],F[4,5,-4,-2,6],F[-6],F[0]}
Aggregate2[xb,yb,F];//Timing
{10. Second,Null}
Aggregate[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]}
}
Aggregate[xb,yb,F];//Timing
{2.64 Second,Null}
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
----- Original Message -----
From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.de>
To: mathgroup at smc.vnet.net
Subject: [mg30810] RE: [mg30768] Re: Summing list subsets
> 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
> > Subject: [mg30810] [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
> > > >
> > > >
> > >
> > >
> > >
> >
> >
>