Mathematica, как эффективно найти минимальное значение с помощью функции упорядочения

Question

У меня есть следующий список пар данных:

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

Я хотел бы найти пару данных с минимальным первым значением.В приведенном выше примере я ищу пару: {1, "Bob"} или {1, "Beth"}, но не оба из них.

Я могу использовать Sort[pairs, #1[[1]] < #2[[1]] &][[1]] для достижения этой цели.Однако, поскольку даже самые быстрые сортировки с большим O> O (n) заставляют меня думать, что должен быть более эффективный способ сделать это.

Следующий ответ дает мне правильный ответ:

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

но это медленнее, чем использование Sort выше.Я знаю, что моего Mathematica-fu просто еще нет, поэтому мой вопрос.

Время

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]] &]];

Результаты (размер списка 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}

Результаты (размер списка 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

Вы можете найти все минимумы, как это:

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

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

Если вы хотите только один из них, то

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

pairs[[pos]]

На моей машине это быстрее, чем методы, перечисленные в вашемвопрос, и я ожидаю, что это будет намного быстрее для больших списков.

Редактировать

На самом деле это еще быстрее - для вашего небольшого списка.

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

Лучше всего проверить все это в своих реальных списках на время.(Обратите внимание, что SortBy[pairs,First] быстрее Sort)

Answer 2

Как насчет этого:

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]]]

Лучшее, что вы можете ожидать, это O (n), так как вам придется пройти по списку один раз, чтобы найти минимальное значение.

Вот вторая идея:

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]

дает

{{1, "Bob"}}

или, альтернативно:

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

Я прошу Select вернуть только первый элемент, для которого выбран критерий выбора (следовательно,третий аргумент)

Редактировать

Другая возможность:

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