Mathematica how to efficiently find the minimum value using an ordering function

Question

I have the following list of pairs of data:

pairs = {{3, "John"}, {1, "Bob"}, {2, "Jane"}, {1, "Beth"}};

I would like to find the pair of data with the minimum first value. In the example above the pair I am looking for is: {1, "Bob"} or {1, "Beth"}, but not both of them.

I can use Sort[pairs, #1[[1]] < #2[[1]] &][[1]] to accomplish this. However, since even the fastest sorts having a big O > O(n), it leads me to think there has to be a more efficient way to do this.

The following gives me the correct answer:

minPair = pairs[[1]];
Map[Function[x, If[x[[1]] < minPair[[1]], minPair = x]], pairs];
minPair;

but, it is slower than using Sort above. I know, my Mathematica-fu is just not there yet, hence my question.

Timings

SetAttributes[TimingDo, HoldRest];
TimingDo[note_String, func_] := 
  results = 
   Append[results, {note , func, Timing[Do[func, {iterations}]][[1]]}];

pairs = {{3, "John"}, {1, "Bob "}, {2, "Jane"}, {1, "Beth"}};
results = {};
iterations = 10000;

TimingDo[ "mmorris[Sort]:               ",
  Sort[pairs, #1[[1]] < #2[[1]] &][[1]]];

TimingDo["mmorris[Map]:                ",
  minPair = pairs[[1]];
  Map[Function[x, If[x[[1]] < minPair[[1]], minPair = x;]], pairs];
  minPair];

TimingDo["mmorris[Map2]:               ",
  minPair = pairs[[1]];
  minValue = minPair[[1]];
  Map[Function[x, 
    If[x[[1]] < minValue, minPair = x; minValue = minPair[[1]];]], 
   pairs];
  minPair];

TimingDo["Mike Honeychurch[Position]:  ",
  pairs[[Position[pairs, Min[pairs[[All, 1]]]][[1, 1]]]]];

TimingDo["Mike Honeychurch[Ordering]:  ",
  pairs[[First@Ordering[pairs[[All, 1]]]]]];

TimingDo["Mike Honeychurch[Ordering']: ",
  pairs[[First@Ordering[pairs[[All, 1]], 1]]]];

TimingDo["Mike Honeychurch[SortBy]:    ",
  SortBy[pairs, First][[1]]];

cf = Compile[{{in, _Integer, 1}}, Block[{x, pos}, x = Part[in, 1];
    pos = 0;
    Do[If[Part[in, i] < x, x = Part[in, i];
       pos = i;];, {i, Length[in]}];
    pos]];

TimingDo["ruebenko[Compile]:           ",
  {p1, p2} = Developer`ToPackedArray /@ Transpose[pairs];
  pairs[[cf[p1]]]];

TimingDo[ "ruebenko[Ordering]:          ",
  {p1, p2} = Developer`ToPackedArray /@ Transpose[pairs];
  pairs[[Ordering[p1][[1]]]]];

TimingDo["TomD[Select]:                ",
  Select[pairs, #[[1]] == Min[pairs[[All, 1]]] &, 1][[1]]];

TimingDo["TomD[Function]:              ",
  (Function[xx, Select[xx, #[[1]] == Min[xx[[All, 1]]] &, 1]]@
     pairs)[[1]]];

Map[Print, Sort[results, #1[[3]] < #2[[3]] &]];

Results (List size of 4)

pairs = {{3, "John"}, {1, "Bob "}, {2, "Jane"}, {1, "Beth"}};

{Mike Honeychurch[Ordering']: ,{1,Bob },0.01381}

{Mike Honeychurch[Ordering]:  ,{1,Bob },0.016171}

{Mike Honeychurch[SortBy]:    ,{1,Beth},0.036649}

{TomD[Select]:                ,{1,Bob },0.042448}

{Mike Honeychurch[Position]:  ,{1,Bob },0.042909}

{ruebenko[Ordering]:          ,{1,Bob },0.048088}

{ruebenko[Compile]:           ,{1,Bob },0.050277}

{TomD[Function]:              ,{1,Bob },0.054296}

{mmorris[Sort]:               ,{1,Beth},0.06838}

{mmorris[Map2]:               ,{1,Bob },0.117905}

{mmorris[Map]:                ,{1,Bob },0.119051}

Results (List size of 1000)

pairs = RandomInteger[1000, {1000, 2}];

{Mike Honeychurch[Ordering']: ,{0,217},0.236041}

{ruebenko[Compile]:           ,{0,217},0.416627}

{ruebenko[Ordering]:          ,{0,217},0.675427}

{Mike Honeychurch[Ordering]:  ,{0,217},0.771243}

{Mike Honeychurch[SortBy]:    ,{0,217},2.68054}

{Mike Honeychurch[Position]:  ,{0,217},2.70455}

{mmorris[Map2]:               ,{0,217},26.7715}

{mmorris[Map]:                ,{0,217},29.8413}

{mmorris[Sort]:               ,{0,217},98.1023}

{TomD[Function]:              ,{0,217},115.968}

{TomD[Select]:                ,{0,217},116.78}

Answer 1

You can find all the minimums like this:

pos = Position[pairs, Min[pairs[[All, 1]]]]

pairs[[pos[[All, 1]]]]

If you only want one of them then

pos = Position[pairs, Min[pairs[[All, 1]]]][[1, 1]]

pairs[[pos]]

On my machine this is faster than the methods listed in your question and I would expect it to be much faster for larger lists.

Edit

Actually this is faster still -- for your small list.

pos = First@Ordering[pairs[[All, 1]]];
pairs[[pos]]

Best to test all these on your real life lists for timings. (Note also that SortBy[pairs,First] is faster than Sort)

Answer 2

How about this:

pairs = {{3, "John"}, {1, "Bob"}, {2, "Jane"}, {1, "Beth"}};
{p1, p2} = Developer`ToPackedArray /@ Transpose[pairs]

cf = Compile[{{in, _Integer, 1}}, Block[{x, pos},
   x = Part[in, 1];
   pos = 0;
   Do[
    If[Part[in, i] < x,
      x = Part[in, i];
      pos = i;
      ];
    , {i, Length[in]}];
   pos
   ]]


pairs[[cf[p1]]]

The best you can expect is O(n) since, you have to walk the list once, to find the min value.

Here is a second idea:

pairs = {{3, "John"}, {1, "Bob"}, {2, "Jane"}, {1, "Beth"}};
{p1, p2} = Developer`ToPackedArray /@ Transpose[pairs]
ord = Ordering[p1]
pairs[[ord[[1]]]]

Answer 3

Select[pairs, #[[1]] == Min[pairs[[All, 1]]] &, 1]

gives

{{1, "Bob"}}

or, alternatively:

Function[xx, Select[xx, #[[1]] == Min[xx[[All, 1]]] &, 1]]@pairs

I am asking Select to return just the first element for which the select criterion is true (hence the third argument)

Edit

Another possibility:

min = Min[pairs[[All, 1]]];
pairs /. {___, {min, x_}, ___} :> {min, x}