How to combine some elements of a list?

Question

In order to simplify my expression, I face a list manipulation problem.

For example, given the input list

list = {a[1] cof[1], a[2] cof[2], a[3] cof[3], a[4] cof[4], a[5] cof[5], a[6] cof[6]};

I can calculate the values of f[a[i]] and then combine the idential elements (f[] is just a function of the a[]). The condition of this transformation is

f[a[1]] == f[a[3]] == f[a[6]]; f[a[2]] == f[a[4]];

so that the output list becomes

newlist = {(cof[1] + cof[3] + cof[6]) a[1], (cof[2] + cof[4]) a[2], cof[5] a[5]};

How can I get this kind transformation to newlist for the general case?

Answer 1

Starting with your list and a dummy f that produces output with the equivalences you specified:

list = {a[1] cof[1], a[2] cof[2], a[3] cof[3], a[4] cof[4], a[5] cof[5], a[6] cof[6]};

f[a[1] | a[3] | a[6]] = "one";
f[a[2] | a[4]] = "two";

We might proceed:

GatherBy[list, f /@ Cases[#, _a] &]

{{a[1] cof[1], a[3] cof[3], a[6] cof[6]}, {a[2] cof[2], a[4] cof[4]}, {a[5] cof[5]}}

GatherBy[#, Head] & /@ List @@@ Join @@@ %

{{{a[1], a[3], a[6]}, {cof[1], cof[3], cof[6]}},
 {{a[2], a[4]}, {cof[2], cof[4]}}, {{a[5]}, {cof[5]}}}

First[#] Total[#2] & @@@ %

{a[1] (cof[1] + cof[3] + cof[6]), a[2] (cof[2] + cof[4]), a[5] cof[5]}

Answer 2

If you happen to dislike GatherBy as I do.

list = {a[1] cof[1], a[2] cof[2], a[3] cof[3], a[4] cof[4], a[5] cof[5], a[6] cof[6]};

Now similar to Mr. Wizard we define a function f which works as you suggest.

f[a[1] | a[3] | a[6]] = 1;
f[a[2] | a[4]] = 2;
f[_] := 0

And a second helper function g which does the actual work.

g[{0, expr_}] := expr
g[{i_, expr_}] := a[i]*Total[Cases[expr, _*r_cof :> r]]

Finally we put it all together...

With[{mask = f /@ Cases[list, a[r_]*_ :> a[r]]},
   g[{#, Pick[list, mask, #]}] & /@ DeleteDuplicates[mask]
 ]

(*{a[1] (cof[1] + cof[3] + cof[6]), a[2] (cof[2] + cof[4]), {a[5] cof[5]}} *)

Answer 3

This is a pretty clumsy way but it works:

# /. a[_] -> First@Cases[#, a[_], 2, 1] & /@ Apply[Plus, 
       GatherBy[list, f@First@Cases[#, a[_], 1, 1] &],1]//Simplify

Step by step:

list = {a[1] cof[1], a[2] cof[2], a[3] cof[3], a[4] cof[4], a[5] cof[5], a[6] cof[6]};
f[x_a] := MemberQ[{1, 3, 6}, First@x]

(* For each element of the list it picks out the first (and only) a[i]
   and applies f to it. Then does what the function name suggests *)
gb=GatherBy[list, f@First@Cases[#, a[_], 1, 1] &]
(* {{a[1] cof[1], a[3] cof[3], a[6] cof[6]},
    {a[2] cof[2], a[4] cof[4], a[5] cof[5]}} *)

(* Add the elemens of each group *)
ap=Apply[Plus,gb,1]
(* {a[1] cof[1] + a[3] cof[3] + a[6] cof[6], 
    a[2] cof[2] + a[4] cof[4] + a[5] cof[5]} *)

(* For each group replace all a[i] with just the first one *)
rep = # /. a[_] -> First@Cases[#, a[_], 2, 1] & /@ ap
(* {a[1] cof[1] + a[1] cof[3] + a[1] cof[6], a[2] cof[2] + a[2] cof[4] + a[2] cof[5]} *)

 Simplify@rep
 (* {a[1] (cof[1] + cof[3] + cof[6]), a[2] (cof[2] + cof[4] + cof[5])} *)

Answer 4

 list = Array[a[#] cof[#] &, {6}];

 Simplify /@ Total /@ GatherBy[#, #[[1, 1]] &] &@
   MapAt[# /. Join[Thread[{1, 3, 6} -> 1], Thread[{2, 4} -> 2]] &, list, {All, 1}]

or

 Collect[#, a[_]] & /@ Total /@ GatherBy[#, #[[1, 1]] &] &[
   list /. {PatternSequence[a[1 | 3 | 6] x_] :> a[1] x, 
        PatternSequence[a[2 | 4] x_] :> a[2] x}]
 (* {a[1] (cof[1] + cof[3] + cof[6]), a[2] (cof[2] + cof[4]), a[5] cof[5]} *)

Answer 5

Trying to write a compact version. Your initial data:

l = {a[1] cof[1], a[2] cof[2], a[3] cof[3], a[4] cof[4], a[5] cof[5], a[6] cof[6]};
p = {f[a[1]] == f[a[3]] == f[a[6]], f[a[2]] == f[a[4]]};

And then just:

List @@ Simplify[ Total[l /. Flatten[Thread[# -> #[[1]]] & /@ (List @@@ p /. f@x_ -> x)]]]

(*
{a[2] (cof[2] + cof[4]), a[5] cof[5], a[1] (cof[1] + cof[3] + cof[6])}
*)