# Extracting Pareto elements from a list

How can I extract the Pareto elements from a list? For example, for that list:

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


I want to get this result:

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


So that these products represent approximately 80% of the total value. The final list can be sorted or not and the real case has 15,000 elements. Make no difference for my purpose that is to tag these products as special ones.

• This is a functions that I use a lot. So I decided to share, and at the same time, see if someone has a better way to implement it. Nov 27, 2012 at 1:31
• How long are your lists? My guess is that a quickselect-like partitionining algorithm would be ideal in theory, because it can be done in O(n) time. But unless n is huge, the optimized Sort function will probably still be faster than even a Compile'd quickselect implementation in Mathematica. Nov 27, 2012 at 9:20
• @nikie tks for the tip, I updated the question. In the real case I have 20 lists with 15,000 each. Not so big. Nov 27, 2012 at 11:27
• It looks like you simply want to sort based on second position, then extract the top 20% (or whatever) elements. Not sure how that relates to Pareto-optimal elements. Nov 27, 2012 at 15:38
• @DanielLichtblau the problem is not about Pareto-optimal elements, but about Pereto Rule - 80x20 Nov 27, 2012 at 20:26

## 3 Answers

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 InternalListMin, as below. One would require a bit more work to put back the string names associated with the numerical values.

InternalListMin[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}} *)

-InternalListMin[-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


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


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


• Nice way to solve without sort. I didn't get why you use With insite With instead of Module. It's faster? Nov 27, 2012 at 20:30
• @Murta, I was going with the hunch that With would make it faster; but, based on limited tests, it actually doesn't seem to make much difference. list[[Ordering[list[[..]]..]] is generally much faster than Sort/SortBy[..]` but in this case, your method seems to be as fast or faster.
– kglr
Nov 27, 2012 at 20:44