# Counting the number of duplicates in a list

What is the quickest way to count the maximum number of duplicates in a list? For example, the maximum number of duplicates in {1,1,1,3} is 3, in {1,1,2,2} is 2 and in {1,1,1,2,2,2,3,3} is 3. I've unsuccessfully tried combinations of Commonest, Count and CountDistinct. Other questions have dealt with identifying or deleting duplicates rather than counting them.

• Look up Tally. For example, MaximalBy[Tally[lst], Last]. Jun 1, 2019 at 12:03
• Nice. I'd go with Max[Tally[lst][[;; , 2]]] which seems simpler to me. Jan 22, 2023 at 2:56

lst = {1, 1, 1, 2, 2, 2, 3, 3};

ClearAll[f]
f = Max[Counts @ #] /. 1 -> 0 &;

f @ lst


3

f @ {1,2,3,4}


0

• The problem is that e.g. {1,2,3} returns 1, but it contains no duplicates (defined as two or more ocurrences). Jun 1, 2019 at 12:33
• @spaced, good catch. Updated to get 0 when there are no duplicates.
– kglr
Jun 1, 2019 at 12:43

Another way to do this using If and Tally:

f = Function[x, If[Part[x, 2] > 1, Part[x, 2], 0]] @@ Tally[#] &;


Test:

lst1 = {1, 2, 3, 4};
lst2 = {1, 1, 1, 2, 2, 2, 3, 3};
lst3 = {1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 4, 4};
f@lst1
f@lst2
f@lst3
(*0*)
(*3*)
(*6*)


Or using GroupBy:

f = Max@ReplaceAll[1 -> 0][
Normal[GroupBy[Thread[# -> Range[Length[#]]], Keys, Length]][[All, 2]]] &;

alist = {1, 2, 3, 4};
blist = {1, 1, 1, 2, 2, 2, 3, 3};
clist = {1, 1, 1, 3};
dlist = {1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 4, 4};

h = If[DuplicateFreeQ[#], 0, Last@First@Tally[#]] &

h /@ {alist, blist, clist, dlist}


{0, 3, 3, 6}

I've unsuccessfully tried combinations of Commonest, Count and CountDistinct.

arr = {1,1,1,3};
arr // Commonest // Count[arr, First@#]&


3

just one more step :)

la = {1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 4, 4};

lb = {1, 2, 3};


Using SequenceCases

Max @ ReplaceAll[{} :> 0] @ SequenceCases[la, a : {b_, b_ ..} :> Length[a]]


6

No duplicates

Max @ ReplaceAll[{} :> 0] @ SequenceCases[lb, a : {b_, b_ ..} :> Length[a]]


0

lst1 = {1, 2, 3, 4};
lst2 = {1, 1, 1, 2, 2, 2, 3, 3};
lst3 = {1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 4, 4};


Another way using ReplaceList:

f[l_List] := Module[{rep},
rep = ReplaceList[l, {___, a : PatternSequence[b_, b_ ..], ___} :> Length@{a}];
If[rep === {}, 0, Max@rep]]

f /@ {lst1, lst2, lst3}


{0, 3, 6}