6
$\begingroup$

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}, ... }
Improve this question
$\endgroup$
3
  • $\begingroup$ 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. $\endgroup$
    – Mr.Wizard
    Sep 8, 2013 at 20:56
  • $\begingroup$ 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. $\endgroup$
    – Jonathan Prieto-Cubides
    Sep 8, 2013 at 21:13
  • 1
    $\begingroup$ If speed is your goal I think you'll want to see my answer. $\endgroup$
    – Mr.Wizard
    Sep 8, 2013 at 21:18

6 Answers 6

Reset to default
10
$\begingroup$

After reading the other answers I propose this:

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.

Improve this answer
$\endgroup$
3
  • $\begingroup$ :O that's really nice. Actually, I've just used with my algorithm. Thanks!!! $\endgroup$
    – Jonathan Prieto-Cubides
    Sep 8, 2013 at 21:25
  • 1
    $\begingroup$ FYI: one could use First in place of #[[1]] & but there are also reasons to prefer Part. $\endgroup$
    – Mr.Wizard
    Sep 9, 2013 at 10:36
  • $\begingroup$ @d555 you can change the chosen answer if you think that it's a better one. $\endgroup$
    – Murta
    Sep 9, 2013 at 11:12
6
$\begingroup$ 
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}}
Improve this answer
$\endgroup$
2
  • $\begingroup$ @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) $\endgroup$
    – Dr. belisarius
    Sep 8, 2013 at 19:28
  • $\begingroup$ 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 :) $\endgroup$
    – Kuba ♦
    Sep 8, 2013 at 19:33
6
$\begingroup$

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

Improve this answer
$\endgroup$
5
$\begingroup$

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.

Improve this answer
$\endgroup$
5
  • $\begingroup$ It seems unique elements are not sorted by the second argument, but I do not know if they have to. $\endgroup$
    – Kuba ♦
    Sep 8, 2013 at 19:27
  • $\begingroup$ @Kuba, me neither, in that case {lookup@First@#&,First,Last} :) $\endgroup$
    – ssch
    Sep 8, 2013 at 19:30
  • 1
    $\begingroup$ @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. $\endgroup$
    – Mr.Wizard
    Sep 9, 2013 at 7:38
  • $\begingroup$ @Mr.Wizard The question is not "how" but "do we really want to"? :) OP has not made this issue clear. $\endgroup$
    – Kuba ♦
    Sep 9, 2013 at 11:49
  • $\begingroup$ @Kuba I'm just providing options; don't shoot the messenger. :-p $\endgroup$
    – Mr.Wizard
    Sep 9, 2013 at 11:55
3
$\begingroup$

An approach using Sow and Reap

Flatten[Thread /@ (SortBy[
    Reap[Sow @@@ 
       Reverse /@ A, _, {#1, #2} &][[2]], -Length[#[[2]]] &]), 1]
Improve this answer
$\endgroup$
2
$\begingroup$

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}}

Improve this answer
$\endgroup$

Your Answer

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

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