How to Gather a list with some elements considered unique

It seems my understanding was correct.

Unique[] is concise and descriptive but runs slower every time it is used. A more robust method is:

group2[lst_] := 
  Module[{x, i = 1}, Join @@ GatherBy[lst, #[[1]] /. 0 :> x[i++] &]]

Compare these Timings:

big = RandomInteger[5, {10000, 3}];

Table[group[big] // Timing // First, {5}]

Table[group2[big] // Timing // First, {5}]

{0.172, 0.515, 0.842, 1.17, 1.529}

{0., 0.016, 0.015, 0., 0.016}

• Note: The timings above were performed in Mathematica 7. In v10.1 I cannot reproduce the progressive slow-down so I believe this problem has been corrected.

---

I believe you just want a Gather where zeros are considered unique:

group[lst_] := Join @@ GatherBy[lst, #[[1]] /. 0 :> Unique[] &]

Test:

Join[List /@ RandomInteger[{0, 5}, 20], RandomReal[{0, 1}, {20, 6}], 2];

%[[All, 1]]

group[%%][[All, 1]]

{0, 0, 4, 5, 0, 3, 3, 3, 4, 2, 4, 2, 3, 2, 5, 0, 5, 0, 1, 4}

{0, 0, 4, 4, 4, 4, 5, 5, 5, 0, 3, 3, 3, 3, 2, 2, 2, 0, 0, 1}

If not at least I tried. :-)

Here is a refinement of @Mr.Wizards answer using my GatherByList function. The function is short:

GatherByList[list_, representatives_] := Module[{func},
    func /: Map[func, _] := representatives;
    GatherBy[list, func]
]

And using GatherByList:

g[list_] := Module[{min = 0},
    Join @@ GatherByList[list, Replace[list[[All, 1]], 0 :> min--, {1}]]
]

Timing comparison:

list = RandomInteger[5, {10^5, 3}];

r1 = g[list]; //AbsoluteTiming
r2 = group2[list]; //AbsoluteTiming

r1 === r2

{0.030611, Null}

{0.219069, Null}

True

Here's an easy way using //.:

list = {0, 1, 1, 0, 3, 3, 0, 0, 5, 5, 5, 0, 5, 0, 1};
Split[list] //. {h___, x : {a_, ___}, m___, y : {a_, ___}, t___} :> 
    {h, x ~Join~ y, m, t} /; a =!= 0 // Flatten

(* {0, 1, 1, 1, 0, 3, 3, 0, 0, 5, 5, 5, 5, 0, 0} *)