# ABC analysis in Mathematica

I would like to take a table with columns for the product name and total profit and segment it into three categories. Each category would have ~1/3 of the total profit (for all products). The first category (A) would have ~1/3 of the total profit, and the smallest amount of unique products. The second category (B) would have more products (but less than the third category).

Any thoughts?

Thanks!

Here is an example data set:

 data = {{"product name","profit"},{"item 1",5},{"item 2", 6},{"item 3",4}, {"item 4",2}}

(* and so on *)

(*or in code:*)

data = Prepend[Table[{"item " ~StringJoin~ ToString[i],
RandomInteger}, {i, 1, 100}], {"product name", "profit"}]



ClearAll[abcF, pw]
pw = Piecewise[{{"A", # >= 2/3}, {"C", # < 1/3}}, "B"] &;
abcF = pw /@ Normalize[Accumulate @ Sort @ #, Last][[Ordering @ Ordering @ #]] &;


Example:

SeedRandom
n = 30;
data = Prepend[Table[{"item "~StringJoin~ToString[i], RandomInteger}, {i, 1,
n}], {"product name", "profit"}];


Use abcF to assign a label to each element of data[[2 ;;, -1]]:

abcF[data[[2 ;;, -1]]]


{"A", "C", "C", "B", "C", "C", "A", "C", "A", "B", "B", "C", "C", \ "C", "A", "A", "A", "B", "C", "C", "C", "C", "C", "B", "B", "C", "C", \ "C", "B", "C"}

Append a column of labels to data:

data2 = Join[data, List /@ Prepend[abcF[data[[2 ;;, -1]]], "ABC"], 2];
Grid[data2] Update: An alternative approach using Clip:

ClearAll[abcF2, clip]
clip = Clip[#, {1/3, 2/3}, {"C", "A"}] /. _?NumericQ -> "B" &;
abcF2 = clip @ Normalize[Accumulate@Sort@#, Last][[Ordering@Ordering@#]] &;

abcF2[data[[2 ;;, -1]]] == abcF[data[[2 ;;, -1]]]


True

• Are you sure Quantile is what you want? In your example you have 12 of the "A" and 9 each of the other two, but the A's are summing up to more than 1/3rd of the profit. – MikeY Jan 28 at 2:45
• Thank you @MikeY for pointing out the error in the previous version. Hope the updated version works. – kglr Jan 28 at 3:25

Generate data, leaving off the header.

RandomSeed;
data = Table[{"item "~StringJoin~ToString[i], RandomInteger}, {i, 1, 100}];


Sort it on the last column, large to small.

sorted = Reverse@SortBy[data, Last];


Get an accumulation of the last column, and the total.

accum = Accumulate@sorted[[All, 2]];
tot = Last@accum;


Calculate a third of the profits and two-thirds of the profits.

p1 = 1 tot/3;
p2 = 2 tot/3;


Get the indices for the split between A and B, and between B and C

ABindex = First@FirstPosition[accum, x_ /; x > p1];
BCindex = First@FirstPosition[accum, x_ /; x > p2];


Now get the groups.

aa = sorted[[ ;; ABindex-1 ]];
bb = sorted[[ ABindex ;; BCindex-1 ]];
cc = sorted[[ BCindex ;; ]];


Check that each has about a third of the profits

Last@Total@aa
(* 1630 *)
Last@Total@bb
(* 1677 *)
Last@Total@cc
(* 1658 *)


See the differences in their lengths

Length@aa
(* 18 *)

Length@bb
(* 23 *)

Length@cc
(* 59 *)