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
Grid[{TableForm[paretoPickF2[newlist, #, .8]] & /@ {2, 3, 4}}, Dividers -> All]
Grid[{TableForm[paretoPickF2[newlist, #, .5, Less]] & /@ {2, 3, 4}}, Dividers -> All]