11
$\begingroup$

The following list has some elements that are labeled. For example {1, 2} -> 1, {-1, 3} -> 3, etc: 

list = {{1, 2}, {-1, 3}, {5, 6}, {-3, 4}, {7, 8}, {-9, 1}, {0, 1}};
labels = {1, 3, 2, 1, 2, 1, 3};

What is a good way to gather list's elements clustered according to their labels?

clusters = {{{1 ,2}, {-3, 4}, {-9, 1}}, {{5, 6}, {7, 8}}, {{-1, 3}, {0, 1}}}
Improve this question
$\endgroup$
7
  • 2
    $\begingroup$ I think there was a question like this in the past but I can't recall it. Extract[list, Position[labels, #]] & /@ Union@labels $\endgroup$
    – Kuba
    Commented Jul 15, 2013 at 13:10
  • $\begingroup$ @Kuba. Please write up your solution as an answer so we can get this question off the unanswered list. $\endgroup$
    – m_goldberg
    Commented Jul 15, 2013 at 13:21
  • $\begingroup$ After 5 days i will run a benchmark for all answers (with reasonable data) and post here the results. $\endgroup$
    – tchronis
    Commented Jul 15, 2013 at 13:58
  • 1
    $\begingroup$ @tchronis More than five days have passed, and you've got two new answers. I chose to add timings to my own. I'll be interested to see your own timings when you get around to it. $\endgroup$
    – Mr.Wizard
    Commented Jul 31, 2013 at 10:47
  • 1
    $\begingroup$ similar $\endgroup$
    – user1066
    Commented Feb 12, 2017 at 9:44

4 Answers 4

Reset to default
10
$\begingroup$

I believe the best way is to use an Ordering function with recognition of duplicates.
Please see that (self) Q&A for an explanation.

myOrdering[a_List] := GatherBy[Ordering@a, a[[#]] &]

list[[#]] & /@ myOrdering[labels]

{{{1, 2}, {-3, 4}, {-9, 1}}, {{5, 6}, {7, 8}}, {{-1, 3}, {0, 1}}}

Benchmarking

And updated benchmark for recent versions, performed in 10.1.0.

Note: in version 7 Pick was orders of magnitude slower in this test. Now it is competitive but it still falls behind as the number of unique labels increases.

myOrdering[a_List] := GatherBy[Ordering@a, a[[#]] &]

f1[{list_, labels_}] :=
  Extract[list, Position[labels, #]] & /@ Union@labels

f2[{list_, labels_}] :=
  Pick[list, labels, #] & /@ Union@labels

f3[{list_, labels_}] :=
  GatherBy[Sort[Transpose@{labels, list}, OrderedQ[{#1[[1]], #2[[1]]}] &], 
   First][[All, All, 2]]

f4[{list_, labels_}] :=
  Reap[MapThread[Sow, {list, labels}], Union@labels][[2, All, 1]]

f5[{list_, labels_}] :=
  list[[#]] & /@ myOrdering[labels]

g[n_] := RandomInteger[⌈n/4⌉, #] & /@ {{n, 2}, n}


Needs["GeneralUtilities`"]

BenchmarkPlot[{f1, f2, f3, f4, f5}, g, 10]

enter image description here

Improve this answer
$\endgroup$
6
  • $\begingroup$ Performance depends of labels variety. Try labels = RandomInteger[10, 3000], Pick should show it's strength :) $\endgroup$
    – Kuba
    Commented Jul 31, 2013 at 10:39
  • $\begingroup$ @Kuba It's still nearly an order of magnitude slower than myOrdering on my system. I know Pick was improved on Packed Arrays in version 8 (I use v7). What timings do you get? Nevertheless I think the multiple-pass Pick/Position method has a higher complexity by nature. $\endgroup$
    – Mr.Wizard
    Commented Jul 31, 2013 at 10:44
  • $\begingroup$ 0.000625001 for Pick and 0.00057500 for myOrdering :) $\endgroup$
    – Kuba
    Commented Jul 31, 2013 at 10:51
  • $\begingroup$ @Kuba I added a note to my answer; I hope you approve. $\endgroup$
    – Mr.Wizard
    Commented Jul 31, 2013 at 10:58
  • $\begingroup$ I fully agree :) I was aware of not efficient nature of this approach, I should have described it but I forgot :) $\endgroup$
    – Kuba
    Commented Jul 31, 2013 at 11:02
8
$\begingroup$

I'm always afraid in case of that there was a duplicate in the past. But I do not remember.

You can try this:

Extract[list, Position[labels, #]] & /@ Union@labels

{{{1 ,2}, {-3, 4}, {-9, 1}}, {{5, 6}, {7, 8}}, {{-1, 3}, {0, 1}}}

and this:

Pick[list, labels, #] & /@ Union@labels

{{{1, 2}, {-3, 4}, {-9, 1}}, {{5, 6}, {7, 8}}, {{-1, 3}, {0, 1}}}

GatherBy variation 

GatherBy[Sort@Thread[Rule[labels, list]], First][[ ;; , ;; , 2]]

{{{-9, 1}, {-3, 4}, {1, 2}}, {{5, 6}, {7, 8}}, {{-1, 3}, {0, 1}}}

Improve this answer
$\endgroup$
7
$\begingroup$

My GatherBy variation:

GatherBy[Transpose@{labels, list}, First][[All, All, 2]]

{{{1, 2}, {-3, 4}, {-9, 1}}, {{-1, 3}, {0, 1}}, {{5, 6}, {7, 8}}}

A possible drawback is that the result is not sorted by label. This is easy to change by doing

GatherBy[Sort@Transpose@{labels, list}, First][[All, All, 2]]

{{{-9, 1}, {-3, 4}, {1, 2}}, {{5, 6}, {7, 8}}, {{-1, 3}, {0, 1}}}

which sorts by label but destroys the initial intra-label ordering or by

GatherBy[Sort[Transpose@{labels, list}, OrderedQ[{#1[[1]], #2[[1]]}] &], First][[All, All, 2]]

{{{1, 2}, {-3, 4}, {-9, 1}}, {{5, 6}, {7, 8}}, {{-1, 3}, {0, 1}}}

which keeps the initial order.

Improve this answer
$\endgroup$
5
  • $\begingroup$ Thank you @sebhofer. Yes the non sorted drawback matters in my case. $\endgroup$
    – tchronis
    Commented Jul 15, 2013 at 13:39
  • 1
    $\begingroup$ @tchronis I realised this is easy to change, see my edit. $\endgroup$
    – sebhofer
    Commented Jul 15, 2013 at 13:44
  • $\begingroup$ Another idea for the sorting might be: Sort[GatherBy[Transpose[{labels, list}], First], First@#1[[1]] < First@#2[[1]] &][[All, All, 2]] (possibly slower than your ideas, but at least it's rather short :) ) $\endgroup$
    – Pinguin Dirk
    Commented Jul 15, 2013 at 16:55
  • $\begingroup$ @PinguinDirk Sure that also works, I would contest it's shorter though. You can do Sort[GatherBy[Transpose[{labels, list}], First], #1[[1, 1]] < #2[[1, 1]] &][[All, All, 2]] then it is shorter, but only by 7 keystrokes :) $\endgroup$
    – sebhofer
    Commented Jul 15, 2013 at 17:07
  • $\begingroup$ ok :) it's not code golfing, and I'd have chosen the same approach! +1 $\endgroup$
    – Pinguin Dirk
    Commented Jul 15, 2013 at 17:10
5
$\begingroup$

This also works:

Reap[MapThread[Sow, {list, labels}]][[2]]

or an alternatively ordering by tags:

Reap[MapThread[Sow, {list, labels}], Union @ labels][[2, All, 1]]
Improve this answer
$\endgroup$
4
  • $\begingroup$ I really like Sow and Reap. (+1) I hope you don't mind, but I'm taking the liberty to streamline your code; you can revert the edit if you disapprove. $\endgroup$
    – Mr.Wizard
    Commented Jul 31, 2013 at 10:11
  • $\begingroup$ Value your comment and edit. I always learn something. $\endgroup$
    – ubpdqn
    Commented Jul 31, 2013 at 10:36
  • $\begingroup$ Thanks: Reap/Sow seemed a useful approach. I just failed to understand it well enough, My ignorance, I hope, is now further reduced. $\endgroup$
    – ubpdqn
    Commented Aug 1, 2013 at 0:59
  • $\begingroup$ What you had was perfectly valid. It is simply that the default values work in this case so we aren't required to specify them. Regarding using Sow[#, #2]& rather than simply Sow, I've seen many people do that so you're in good company. :-) $\endgroup$
    – Mr.Wizard
    Commented Aug 1, 2013 at 1:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.