Extracting Pareto elements from a list

For solve this problem I have made this function:

takeParetoFromList[data_, cut_:0.8, paretoColumn_: 1] :=
Module[{dataSort, total, elements},
    dataSort = Reverse@SortBy[data, #[[paretoColumn]] &];
    total = Total[data[[All, paretoColumn]]];
    elements = LengthWhile[(Accumulate@dataSort[[All, paretoColumn]])/total, # <= cut &];
    Take[dataSort, elements]
]    

So, using the list below as data argument:

list = {{"A&W", 15}, {"Bubbly", 19}, {"Aquabona", 
       42}, {"Lanitis Extra", 91}, {"Ayataka", 80}, {"DASANI Nutriwater", 
       12}, {"diet Lift/Lift light", 2}, {"Minute Maid Antiox", 
       74}, {"Bimbo", 40}, {"Minute Maid Deli", 5}, {"Fire", 69}, {"Club",
        14}, {"Nada", 46}, {"Bu", 46}, {"Aybal", 29}, {"Kin", 
       73}, {"Minute Maid Just 10", 31}, {"Hero", 90}, {"diet Oasis", 
       65}, {"Canada Dry", 30}}

Applying takeParetoFromList[list, 0.8, 2] we get:

{{"Lanitis Extra",91},{"Hero",90},{"Ayataka",80},{"Minute Maid Antiox",74},{"Kin",73},{"Fire",69},{"diet Oasis",65},{"Nada",46},{"Bu",46},{"Aquabona",42}}

That is the desirable answer.


Not sure if this is the meaning of Pareto that is wanted but thought I should point out some undocumented functionality for getting at minima (or maxima) in a partially ordered set. I'll work with the extended list setup from kguler's response.

In[115]:= 
newlist = (Join[Transpose[list], 
     RandomInteger[{0, 10}, {2, Length[list]}]] // Transpose)

(*
{{"A&W", 15, 0, 10},
{"Bubbly", 19, 6, 10},
{"Aquabona", 42, 0, 0},
{"Lanitis Extra", 91, 6, 8},
{"Ayataka", 80, 2, 3},
{"DASANI Nutriwater", 12, 4, 8},
{"diet Lift/Lift light", 2, 5, 10},
{"Minute Maid Antiox", 74, 9, 9},
{"Bimbo", 40, 2, 10},
{"Minute Maid Deli", 5, 10, 8},
{"Fire", 69, 10, 0},
{"Club", 14, 6, 5},
{"Nada", 46, 2, 4}, {"Bu", 46, 10, 3},
{"Aybal", 29, 9, 8},
{"Kin", 73, 5, 4},
{"Minute Maid Just 10", 31, 4, 5},
{"Hero", 90, 0, 9},
{"diet Oasis", 65, 5, 6},
{"Canada Dry", 30, 4, 8}}
*)

The minima and maxima can be obtained from Internal`ListMin, as below. One would require a bit more work to put back the string names associated with the numerical values.

Internal`ListMin[newlist[[All, 2 ;; -1]]]

(* {{2, 5, 10}, {5, 10, 8}, {12, 4, 8}, {15, 0, 10}, {14, 6, 
  5}, {31, 4, 5}, {42, 0, 0}} *)

-Internal`ListMin[-newlist[[All, 2 ;; -1]]] 

(* {{91, 6, 8}, {90, 0, 9}, {74, 9, 9}, {69, 10, 0}, {46, 10, 
  3}, {40, 2, 10}, {19, 6, 10}, {5, 10, 8}} *)

Also see this previous thread for related ideas.


 ClearAll[paretoPickF1]; 
 paretoPickF1[list_, ordcol_: 1, quantile_: 1.] := 
 With[{sortedlist = Reverse@list[[Ordering[list[[All, ordcol]]]]]}, 
    With[{selector = Normalize[Accumulate[sortedlist[[All, ordcol]]], Last]}, 
    Pick[sortedlist, # <= quantile & /@ selector]]];

or, with additional optional arguments (to specify the ordering function and to select specific ranks before applying the Pareto calculations):

 ClearAll[paretoPickF2];
 paretoPickF2[list_, ordcol_, quantile_:1., orderingF_: Greater, ranks_: All] :=
    With[{sortedlist = list[[Ordering[list[[All, ordcol]], ranks, orderingF]]]},
      With[{selector = Normalize[Accumulate[sortedlist[[All, ordcol]]], Last]},
    Pick[sortedlist, # <= quantile & /@ selector]]

Examples:

 newlist = (Join[Transpose[list], RandomInteger[{0, 10}, {3, 20}]] // Transpose);
 newlist // TableForm

enter image description here

 Grid[{TableForm[paretoPickF2[newlist, #, .8]] & /@ {2, 3, 4}}, Dividers -> All]

enter image description here

 Grid[{TableForm[paretoPickF2[newlist, #, .5, Less]] & /@ {2, 3, 4}}, Dividers -> All]

enter image description here