# Sort a list of coordinates by frequency from first component of each coordinate

The situation is that I have a List like this:

A = { {1, 11}, {1, 12}, {1, 17}, {1, 20}, {1, 52}, {4, 179}, {5, 10},
{5, 55}, {12, 16}, {13, 274}, {15, 206}, {17, 16}, {17, 23}, {17, 24},
{17, 25}, {22, 82}, {26, 131}, {30, 222}, {30, 391}, {40, 24},
{41, 31}, {41, 54}, {41, 78}, {41, 82}, {43, 42}, {44, 67},
{45, 21}, {47, 81}, {49, 192}, {52, 10}, {56, 67}, {56, 76},
{56, 79}, {56, 81}, {56, 89}, {56, 90}, {56, 91}, {56, 92} }


I would like to order the list A by frequencies from first component.

I tried to figure out this order with this function:

 frec = Table[i[[1, 1]]  , {i,
Sort[Tally[A, #1[[1]] ==   #2[[1]]  & ], #1[[2]] > #2[[2]] & ]}]


{56, 1, 41, 17, 30, 5, 52, 49, 47, 45, 44, 43, 40, 26, 22, 15, 13, 12, 4}

It means that 56 appears as first component more than 1, and so on.

But I really don't know how to use this order to produce something like this:

A = { {56, 67}, {56, 76}, {56, 79}, {56, 81}, {56, 89}, {56, 90}, {56, 91}, {56, 92},
{ 1, 11}, { 1, 12}, { 1, 17}, { 1, 20}, { 1, 52},
{41, 31}, {41, 54}, {41, 78}, {41, 82},
{17, 16}, {17, 23}, {17, 24}, {17, 25}, ... }

-
d555, you should not be so quick to Accept an answer. Despite receiving some fine ones already, you cannot know what you may get if you wait a bit longer. I suggest waiting 24 hours to give everyone around the world a chance to reply, before the question appears concluded. – Mr.Wizard Sep 8 '13 at 20:56
Ok, Sorry. I consider your hint for the next time. But, I should to say that the accepted answer was so fast with large list opposite others scripts. So, I taked it. – jonaprieto Sep 8 '13 at 21:13
If speed is your goal I think you'll want to see my answer. – Mr.Wizard Sep 8 '13 at 21:18

Join @@ SortBy[GatherBy[a, #[[1]] &], {-Length@# &}]


It is directly based on belisarius's method but I believe it is an improvement.

• By using {-Length@# &} we attain a stable sort(1)(2) which is also faster.

• Join @@ is faster than Flatten on packed sub-lists and returns a packed array.

Timings:

a = RandomInteger[99999, {500000, 2}];

Flatten[SortBy[GatherBy[a, #[[1]] &], -Length@# &], 1] // Timing // First
Join @@ SortBy[GatherBy[a, #[[1]] &], {-Length@# &}]   // Timing // First


0.608

0.2838

More than 2X faster on this data.

-
:O that's really nice. Actually, I've just used with my algorithm. Thanks!!! – jonaprieto Sep 8 '13 at 21:25
FYI: one could use First in place of #[[1]] & but there are also reasons to prefer Part. – Mr.Wizard Sep 9 '13 at 10:36
@d555 you can change the chosen answer if you think that it's a better one. – Murta Sep 9 '13 at 11:12
Flatten[SortBy[GatherBy[a, #[[1]] &], -Length@# &], 1]

{{56, 67}, {56, 76}, {56, 79}, {56, 81}, {56, 89}, {56, 90}, {56, 91}, {56, 92},
{1, 11}, {1, 12}, {1, 17}, {1, 20}, {1, 52},
{17, 16}, {17, 23}, {17, 24}, {17, 25},
{41, 31}, {41, 54}, {41, 78}, {41, 82},
{5, 10}, {5, 55},
{30, 222}, {30, 391},
{4, 179}, {12, 16}, {13, 274}, {15, 206}, {22, 82}, {26, 131},
{40, 24}, {43, 42}, {44, 67}, {45, 21}, {47, 81}, {49, 192}, {52, 10}}

-
@Kuba I partly agree, but. The use of First[], Last[], etc. has been criticized before on this site as some kind of "generality loss" (while I don't share that opinion, I try to adapt my code to the site preferences), and as for the Reverse[] instead of -Length[], I really prefer to keep my orig (one less op) – Dr. belisarius Sep 8 '13 at 19:28
You are right. And you are right, I think -Length is better because it preserves sorting of equal frequency types by the second element. Which in case of reverse is reversed :) – Kuba Sep 8 '13 at 19:33

Here is another options:

rule = Dispatch@Rule@@@Tally[a[[All, 1]]];
Reverse@SortBy[a, #[[1]] /. rule &]

rule = Dispatch@Rule@@@Tally[a[[All, 1]]];
a[[Ordering[a[[All, 1]] /. rule]]]


The second form is faster

-

Here is one way that uses the Tally of the first elements to create a function that maps an element to the number of first occurrences. That function is then used in SortBy, with a secondary function that look at the last elements:

lookupmethod[a_] := Module[{lookup},
(lookup[#1] = -#2) & @@@ Tally[a[[All, 1]]];
SortBy[a, {lookup@First@# &, Last}]
]
lookupmethod[a]//Short
(* {{56,67},{56,76},{56,79},{56,81},<<30>>,{4,179},{49,192},{15,206},{13,274}} *)


The minus sign is there to get the ordering desired.

-
It seems unique elements are not sorted by the second argument, but I do not know if they have to. – Kuba Sep 8 '13 at 19:27
@Kuba, me neither, in that case {lookup@First@#&,First,Last} :) – ssch Sep 8 '13 at 19:30
@Kuba & ssch, if you want pairs to be sorted also by the second element in the case of a tie, simply use SortBy[a, lookup@First@# &] -- the single function without {} will automatically use canonical sort for tiebreaking. – Mr.Wizard Sep 9 '13 at 7:38
@Mr.Wizard The question is not "how" but "do we really want to"? :) OP has not made this issue clear. – Kuba Sep 9 '13 at 11:49
@Kuba I'm just providing options; don't shoot the messenger. :-p – Mr.Wizard Sep 9 '13 at 11:55

An approach using Sow and Reap

Flatten[Thread /@ (SortBy[
Reap[Sow @@@
Reverse /@ A, _, {#1, #2} &][[2]], -Length[#[[2]]] &]), 1]

-

One more way might be this

    Block[{w={}},Table[If[A[[s,1]]==frec[[i]],w={w,A[[s]]},0],
{i,1,Length[frec]},{s,1,Length[A]}];Partition[w//Flatten,2]]


{{56,67},{56,76},{56,79},{56,81},{56,89},{56,90},{56,91},{56,92},{1,11},{1,12},{1,17},{1,20},{1,52},{41,31},{41,54},{41,78},{41,82},{17,16},{17,23},{17,24},{17,25},{30,222},{30,391},{5,10},{5,55},{52,10},{49,192},{47,81},{45,21},{44,67},{43,42},{40,24},{26,131},{22,82},{15,206},{13,274},{12,16},{4,179}}

-