16
$\begingroup$

Given a list:

lis = {37.21, 37.21, 37.2, 44, 44, 44, 101, 101}

What is a simple way to extract the second largest elements?

In[]:= someFunction[lis]

Out[]= {44, 44, 44}
$\endgroup$
18
$\begingroup$

One way, not highly efficient:

lis = {37.21, 37.21, 37.2, 44, 44, 44, 101, 101};

lis ~Cases~ Union[lis][[-2]]
{44, 44, 44}

This should be a bit more efficient:

ConstantArray @@ Sort[Tally@lis][[-2]]

Caveat: both of these methods rely on sorting and therefore require numeric data.


flinty's method with refinements by both C. E. and me:

Pick[lis, lis, RankedMax[DeleteDuplicates@lis, 2]]

This appears to be the fastest overall and it avoids the sorting issue referenced above.


Benchmarking

A quick test of the methods posted so far reveals an interesting pattern. Note that in the benchmark I use a list of a fixed length of one million and vary the number of unique elements within that list.

Adding methods f5, f6, and f7, and a second test with unpackable data.

Performed in Mathematica 10.1

Needs["GeneralUtilities`"]

SetOptions[Benchmark, TimeConstraint -> 30];

f1[lis_] := lis ~Cases~ Union[lis][[-2]]
f2[lis_] := ConstantArray @@ Sort[Tally@lis][[-2]]
f3[lis_] := MaximalBy[DeleteCases[lis, Max@lis], # &] (* Conor/kglr *)
f4[lis_] := Split[Sort@lis][[-2]]  (* kglr *)
f5[lis_] := Pick[lis, lis - RankedMax[DeleteDuplicates@lis, 2], 0]; (* flinty/C. E. *)
f6[lis_] := Extract[List/@KeySort[PositionIndex[lis]][[-2]]][lis] (* CA Trevillian *)
f7[lis_] := Pick[lis, lis, RankedMax[DeleteDuplicates@lis, 2]] (* flinty/C.E./me *)

BenchmarkPlot[{f1, f2, f3, f4, f5, f6, f7},
  RandomInteger[#, 1*^6] &, 10^Range[6], Joined -> True]

BenchmarkPlot[{f1, f2, f3, f4, f5, f6, f7},
  Prepend[0.5]@RandomInteger[#, 1*^6] &, 10^Range[6], Joined -> True]

enter image description here

enter image description here

| improve this answer | |
$\endgroup$
  • 2
    $\begingroup$ +1 Using v12.1 on my Mac, the benchmarks for f1, f3, and f4 all stop at n == 10^5, only f2 goes up to n == 10^6. Also, the PlotMarkers are visible in the plot just like in the PlotLegends. $\endgroup$ – Bob Hanlon Jun 13 at 14:19
  • $\begingroup$ flinty's DeleteDuplicates + RankedMax approach appears to be competitive when used in conjunction with Pick to select all elements. Benchmark - f5 is flinty's method. $\endgroup$ – C. E. Jun 13 at 20:41
  • $\begingroup$ @BobHanlon Try SetOptions[BenchmarkPlot, TimeConstraint -> 30]. I don't need this in version 10.1 when explicitly specifying test points, but I think that should do it. $\endgroup$ – Mr.Wizard Jun 13 at 22:36
  • 1
    $\begingroup$ @C.E. Benchmark updated. $\endgroup$ – Mr.Wizard Jun 13 at 22:37
  • 1
    $\begingroup$ @Mr.Wizard - that fixed everything. Thanks. $\endgroup$ – Bob Hanlon Jun 14 at 1:42
11
$\begingroup$

another way...

MaximalBy[DeleteCases[lis, Max@lis], # &]
{44, 44, 44}
| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ shorter: MaximalBy[DeleteCases[lis, Max@lis], # &]? $\endgroup$ – kglr Jun 13 at 12:43
  • $\begingroup$ @kglr your right. updated $\endgroup$ – Conor Cosnett Jun 14 at 6:30
9
$\begingroup$
Split[ Sort @ lis][[-2]]
 {44, 44, 44}

Also

Nearest[DeleteCases[Max @ #] @ #, Max @ #] & @ lis
{44, 44, 44}
| improve this answer | |
$\endgroup$
8
$\begingroup$

Find the second largest unique element:

RankedMax[DeleteDuplicates@lis, 2]

... or alternatively:

Last@TakeLargest[DeleteDuplicates@lis, 2]

There are multiple ways to get them all:

Cases[lis, RankedMax[DeleteDuplicates@lis, 2]]
Cases[lis, Last@TakeLargest[DeleteDuplicates@lis, 2]]
Select[lis, # == Last@TakeLargest[DeleteDuplicates@lis, 2] &]
| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ +1. It's faster to use Pick to get all, e.g. Pick[lis, lis - RankedMax[DeleteDuplicates@lis, 2], 0]; The Select one can be sped up by using With to inject the sought after value into the anonymous function (but it will still be much slower than alternatives). $\endgroup$ – C. E. Jun 13 at 20:16
  • 1
    $\begingroup$ @C.E. This seems faster still: Pick[lis, lis, RankedMax[DeleteDuplicates@lis, 2]] $\endgroup$ – Mr.Wizard Jun 14 at 6:58
  • $\begingroup$ @Mr.Wizard Thank you. I was messing around and somehow didn’t notice... $\endgroup$ – C. E. Jun 14 at 8:35
5
$\begingroup$

This is probably terribly expensive compared to other methods, but I think it could be done better too, regardless...also I find it odd that Ordering doesn't manage for duplicated values...

Extract[List/@KeySort[PositionIndex[lis]][[-2]]][lis]
{44, 44, 44}

You can just grab the positions directly with

KeySort[PositionIndex[lis]][[-2]]
{4, 5, 6}

Though, I will say this is the only presented method so far that "Extracts" the second-largest value(s) in a list ;)

This is better to look at:

lis[[KeySort[PositionIndex[lis]][[-2]]]]
| improve this answer | |
$\endgroup$
5
$\begingroup$

Another solution:

lis // DeleteCases[#, Max@#]& // Cases[#, Max@#]&
| improve this answer | |
$\endgroup$
2
$\begingroup$
Select[Select[c=Sort[lis],#!=Last[c] &],#==Last[Select[c,#!=Last[c] &]]&]
| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.