21
$\begingroup$

For example, given

list = {{1, -3, -5}, {2, 1, 6}, {0, 2, 4}, {-9, 2, 6}}

should return:

{-5, 6, 4, -9}

Updated

I found a undocumented function called Internal`MaxAbs,but it only accept two args,for example:

Internal`MaxAbs[2, -3]
Internal`MaxAbs[{1, -3, -5}, {2, 1, 6}]
(*
 3
 {2, 3, 6}
*)

How can I make it can accept multiple parameters?

$\endgroup$
8
  • 3
    $\begingroup$ To be sure: what happens if a sublist is e.g. {1,2,2}? You'd pick 2 just once or twice? $\endgroup$ Aug 30, 2013 at 8:39
  • 2
    $\begingroup$ @PinguinDirk or even more interesting what if {1,-2,2} :) $\endgroup$
    – Kuba
    Aug 30, 2013 at 9:22
  • $\begingroup$ @Kuba, Just pick once, if {1,-2,2} should return 2. $\endgroup$
    – expression
    Aug 30, 2013 at 10:17
  • $\begingroup$ @explorer -2 is single result which fits too:) My MapIndexed method will give you the first of "equal" numbers. Switching to <= will result in the last one of them but there is a case of {-2,2,-2}. Then You will always get -2 unless you restate the question to be more precise that you want positive value from the "equal" set. $\endgroup$
    – Kuba
    Aug 30, 2013 at 10:22
  • 1
    $\begingroup$ Possible duplicate: mathematica.stackexchange.com/q/11795/5 $\endgroup$
    – rm -rf
    Aug 30, 2013 at 11:12

14 Answers 14

24
$\begingroup$

(Edited with a slight tweak for a tiny bit more speed)

For the non-duplicate version I am finding this quite fast:

f = If[+## > 0, ##] & @@ {Max[#], Min[#]} &

f /@ list
(* {-5, 6, 4, -9} *)
$\endgroup$
6
  • $\begingroup$ Oh dear, I'm afraid to try this, because I think I'm about to lose. :o) $\endgroup$
    – Mr.Wizard
    Aug 30, 2013 at 11:08
  • $\begingroup$ Well, in v7 and with my particular test mine is still #1, but +1 for a nice method and making me sweat. :-) $\endgroup$
    – Mr.Wizard
    Aug 30, 2013 at 11:11
  • $\begingroup$ @Mr.Wizard, saved by the version number! On v9 I am getting about 150 ms for your method and 20 ms for mine. $\endgroup$ Aug 30, 2013 at 11:26
  • 1
    $\begingroup$ Interesting; I wonder why Max and Min are so much faster in v9. By the way, I think this can be written If[+## > 0, ##] &[Max @ #, Min @ #] & which I find a little cleaner. $\endgroup$
    – Mr.Wizard
    Aug 30, 2013 at 20:19
  • $\begingroup$ Simon, is my method any faster in v9 using RankedMax? $\endgroup$
    – Mr.Wizard
    Aug 30, 2013 at 20:24
14
$\begingroup$

I'd use Ordering, as Nasser did, but with the default sort as it will be much faster:

# ~Extract~ Ordering[Abs@#, -1] & /@ list
{-5, 6, 4, -9}

If duplicates are required we can substitute Position but Pinguin Dirk's method is faster.

list = {{1, -3, -5}, {2, 1, 6}, {0, 2, 4}, {-9, 2, 6}, {1, -2, 2}}

# ~Extract~ (Position[#, Max@#] &@Abs@#) & /@ list
{{-5}, {6}, {4}, {-9}, {-2, 2}}

Here is a concise use of Pick that appears to be competitive for the with-duplicates case:

f[a_] := Pick[a, #, Max@#] & @ Abs @ a

f /@ list
{{-5}, {6}, {4}, {-9}, {-2, 2}}

Timings in version 7 (Pick should be faster in v8 and after):

SetAttributes[timeAvg, HoldFirst]
timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]

list = RandomInteger[{-30, 30}, {50000, 20}];

# ~Extract~ (Position[#, Max@#] &@Abs@#) & /@ list  // timeAvg
Pick[list, UnitStep[# - Max[#]] & /@ (Abs@list), 1] // timeAvg
f /@ list                                           // timeAvg

0.2496

0.2184

0.1996

Nasser's timings in version 9 are: 0.328, 0.112, 0.203 showing that Pinguin Dirk's code is by far the fastest in recent versions.

And timings for the non-duplicate methods:

list = RandomReal[{-9, 9}, {50000, 20}];

# ~Extract~ Ordering[Abs@#, -1] & /@ list                                  // timeAvg
(SortBy[#, Abs] & /@ list)[[All , -1]]                                     // timeAvg
If[+## > 0, ##] & @@ {Max[#], -Max[-#]} & /@ list                          // timeAvg
Pick[Flatten@#, Flatten[Ordering@Ordering@Abs[#] & /@ #], 3] &@list        // timeAvg
MapThread[Extract, {list, Ordering[#, -1, (Abs@#1 < Abs@#2) &] & /@ list}] // timeAvg
Max /@ Pick[list, UnitStep[# - Max[#]] & /@ (Abs@list), 1]                 // timeAvg

0.078

0.1092

0.128

0.2308

0.842

0.2652

$\endgroup$
6
  • $\begingroup$ Now why did I not use the simpler Abs[#] instead of (Abs@#1 < Abs@#2) ? I do not know. I need more coffee :) $\endgroup$
    – Nasser
    Aug 30, 2013 at 10:08
  • $\begingroup$ @Nasser And I need more sleep. :^) $\endgroup$
    – Mr.Wizard
    Aug 30, 2013 at 10:12
  • $\begingroup$ @Nasser You're running v8 or v9 right? Could you run my timings on that platform? $\endgroup$
    – Mr.Wizard
    Aug 30, 2013 at 10:16
  • 1
    $\begingroup$ OK, here is the timing again !Mathematica graphics $\endgroup$
    – Nasser
    Aug 30, 2013 at 10:20
  • $\begingroup$ @Nasser Thanks. It looks like Pinguin Dirk's code is the best so far if duplicates are required. $\endgroup$
    – Mr.Wizard
    Aug 30, 2013 at 10:22
13
$\begingroup$

With the clarification, I think I can reuse my solution I initially provided by just mapping Max over it again:

Old:

Pick[list, UnitStep[# - Max[#]] & /@ (Abs@list), 1]

New:

Max /@ Pick[list, UnitStep[# - Max[#]] & /@ (Abs@list), 1]

(note: the old solution returned any value that has max abs value, i.e. {1,2,-2} returned 2,-2).

Based on this new information, this approach is definitely not the best out there, see @Mr.Wizard's answer.

$\endgroup$
4
  • $\begingroup$ Yes, I don't expect anything non-compiled to beat my first method for the non-duplicate version, but your method is very nice for the duplicate version; it's a great complement. $\endgroup$
    – Mr.Wizard
    Aug 30, 2013 at 10:32
  • $\begingroup$ yes, totally agree, @Mr.Wizard. Based on this new information in the question, this is how I tried to save my skin (and the upvotes I got) :) & thanks! $\endgroup$ Aug 30, 2013 at 10:34
  • $\begingroup$ Actually since the original didn't specify your answer is entirely valid. If you feel it isn't I'll edit the question to specifically request both ways. :-) $\endgroup$
    – Mr.Wizard
    Aug 30, 2013 at 10:38
  • $\begingroup$ Thanks for the offer :) I gotta run now anyway, and I think my answer now works in both ways - not as quickly as your idea, but I think the disclaimer is in my answer :) $\endgroup$ Aug 30, 2013 at 10:40
11
$\begingroup$

Using the function introduced here, it becomes a trivial exercise:

MaxBy[#, Abs] & /@ list

(* ==> {-5, 6, 4, -9} *)

It's probably not the fastest, but if you're familiar with the pattern, it's the least mental effort solution.

$\endgroup$
6
  • $\begingroup$ fyi, just added your test to the test cases above in my post. (too many ways to do the same thing in Mathematica) ! $\endgroup$
    – Nasser
    Aug 30, 2013 at 13:27
  • $\begingroup$ Thanks @Nasser! So it turns out that mine is the slowest in your benchmark. But it's good to point out that the timings (and the ranking of methods) depends on the dimensions of the input---small list length vs number of small lists. If I change it to {5000, 200} from {50000, 20}, the results change considerably. $\endgroup$
    – Szabolcs
    Aug 30, 2013 at 13:58
  • $\begingroup$ @Nasser Simon's seems to win in all situations, regardless of the dimensions of the input. $\endgroup$
    – Szabolcs
    Aug 30, 2013 at 14:06
  • 1
    $\begingroup$ @Szabolcs, presumably the relative slowness of MaxBy comes from explicitly mapping Abs over the list. Perhaps you could include a check to use f[list] when f is Listable. $\endgroup$ Aug 30, 2013 at 14:19
  • 1
    $\begingroup$ @Mr.Wizard I see it as a mental abstraction that helps me arrive at the solution with less effort/thinking and allows me to concentrate on the problem at hand instead of the implementation of a detail. If you put any effort into solving this particular problem, then you'll necessarily arrive at a faster/better solution, such as yours (which is pretty much the same as this one except with better use of Abs). $\endgroup$
    – Szabolcs
    Aug 30, 2013 at 21:14
11
$\begingroup$

Update: Added to test table below new 3 answers.

I came up with an improvement to my earlier method. Instead of running the Ordering on the original list, why not run it on a much smaller list? of only 3 items !

This new list is first generated from the original list like this:

{Abs[#], Max[#], Min[#]} & /@ list

Now with only 3 elements in each list, it is much faster to do the same thing as before. The idea is to check if first element same as Abs of 3rd element. If not, then use the middle element, else use the third. So it is only an If added to each element. Min/Max/Abs so the heavy work:

If[#[[1]] == Abs@#[[3]],#[[3]], #[[2]]] & /@({Max@Abs[#], Max[#], Min[#]}& /@ list) 

UPDATE TIMING

All run on V 9.01, windows 7, 64 bit. Intel core i7. Using this list

  list = RandomInteger[{-30, 30}, {50000, 20}];

Mathematica graphics

Using this list

list = RandomReal[{-9, 9}, {50000, 20}];

Mathematica graphics

Appendix

Test code:

SetAttributes[timeAvg, HoldFirst]
timeAvg[func_] := 
 Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]
MrWizardPick[a_] := Pick[a, #, Max@#] &@Abs@a  ;
(*list=RandomInteger[{-30,30},{50000,20}];*)
MaxBy[list_, fun_] := list[[First@Ordering[fun /@ list, -1]]];
list = RandomInteger[{-30, 30}, {50000, 20}];
gpap = Block[{M, m}, M = Max@#;
    m = Min@#;
    If[M > -m, M, m]] &;

Grid[{
  {"Gpap", gpap /@ list // timeAvg},
  {"Simon", If[+## > 0, ##] & @@ {Max[#], Min[#]} & /@ list // timeAvg},
  {"Nasser", If[#[[1]] == Abs@#[[3]], #[[3]], #[[2]]] & /@ ({Max@Abs[#], Max[#], 
         Min[#]} & /@ list) // timeAvg},
  {"Blackbird",Table[If[
      Min[list[[i]]] < 0 && Abs[Min[list[[i]]]] > Max[list[[i]]], 
      Min[list[[i]]], Max[list[[i]]]], {i, Length[list]}] // timeAvg},
  {"Tom",Pick[Flatten@#, Flatten[Ordering@Ordering@Abs[#] & /@ #], 3] &@ list // timeAvg},
  {"MrWizard", #~Extract~Ordering[Abs@#, -1] & /@ list // timeAvg},
  {"Pinguin",Max /@ Pick[list, UnitStep[# - Max[#]] & /@ (Abs@list), 1] // timeAvg},
  {"Kuba", (SortBy[#, Abs] & /@ list)[[;; , -1]] // timeAvg},
  {"Rojo", Pick[list, 
      With[{absList = Abs@list}, 
       With[{max = Max /@ absList}, # - max & /@ Transpose@absList] //
          Unitize // Transpose], 0] // Flatten // timeAvg},
  {"MrWizardPick", MrWizardPick /@ list // timeAvg},
  {"Szabolcs", MaxBy[#, Abs] & /@ list // timeAvg}
  }, Frame -> All, Alignment -> Left, Spacings -> {.5, 1}]
$\endgroup$
1
  • $\begingroup$ @Mr.Wizard corrected and updated. Gpap and Simon tests seem to give an almost identical performance on these 2 lists. $\endgroup$
    – Nasser
    Aug 30, 2013 at 20:56
10
$\begingroup$
list = {{1, -3, -5}, {2, 1, 6}, {0, 2, 4}, {2, -9, 6}};

One way would be:

(SortBy[#, Abs] & /@ list)[[;; , -1]]
{-5, 6, 4, -9}

But I bet it is not effective since we do not have to sort each list to obtain this. However for short sublists it may be good approach.


Ok, this scans only once but maybe MapIndexed is not the fastest scanner:

max[_] = 0;
f[z_, {i_, j_}] := max[i] = If[Abs[max[i]] > Abs@z, max[i], z]

MapIndexed[f, list, {2}];

max /@ Range[Length[list]]
{-5, 6, 4, -9}
$\endgroup$
8
$\begingroup$

Ok, so a bit late but I want to play as well. It's a variation on a theme by @SimonWoods:

ClearAll@f

f = Block[{M, m},
   M = Max@#;
   m = Min@#;
   If[M < -m, m, M]
   ] &

but in my machine it works slightly faster.

list = {{1, -3, -5}, {2, 1, 6}, {0, 2, 4}, {-9, 2, 6}};
f /@ list
(*out*) {-5, 6, 4, -9}

--EDIT--

Changed If[M > -m, M, m] to If[M < -m, m, M] to pick the positive of two numbers with equal absolute value.

$\endgroup$
1
  • $\begingroup$ make that >= for the + to win the tie.. $\endgroup$
    – george2079
    Aug 30, 2013 at 20:51
6
$\begingroup$

I'll join the fun:

r = Ordering[#, -1, (Abs@#1 < Abs@#2) &] & /@ list;
MapThread[Extract, {list, r}]

Mathematica graphics

$\endgroup$
4
$\begingroup$

More fun:

Pick[Flatten@#, Flatten[Ordering@Ordering@Abs[#] & /@ #], 3] &@list

=> {-5, 6, 4, -9}

$\endgroup$
1
  • $\begingroup$ Clever, but it's worth noting that this only works if each sub-list is the same length. $\endgroup$
    – Mr.Wizard
    Aug 30, 2013 at 10:21
4
$\begingroup$

I saw so many answers that I just had to participate. This won't work for a ragged array

Pick[list,
  With[{absList = Abs@list},
   With[{max = Max /@ absList},
      # - max & /@ Transpose@absList] // Unitize // Transpose
   ], 0] // Flatten
$\endgroup$
4
$\begingroup$
Table[If[Min[list[[i]]] < 0, Min[list[[i]]], Max[list[[i]]]], {i, 
  Length[list]}]

{-5, 6, 4, -9}

For list = RandomInteger[{-30, 30}, {50000, 20}];

Time = 0.040058

list = RandomReal[{-9, 9}, {50000, 20}];

Time = 0.050072

Edit: As a valid mistake found by @simonWoods, I have rectified the snippet and now its generating better result.

Table[If[Min[list[[i]]] < 0 && Abs[Min[list[[i]]]] > Max[list[[i]]], 
  Min[list[[i]]], Max[list[[i]]]], {i, Length[list]}]

For list = {{-1, 10}}; (*{10}*)

For list = {{1, -3, -5}, {2, 1, 6}, {0, 2, 4}, {-9, 2, 6}} (*{-5, 6, 4, -9}*)

For list = {{-1, -10, 10}}; (*{10}*)

For list = RandomInteger[{-30, 30}, {50000, 20}];

Time = 0.120173

For list = RandomReal[{-9, 9}, {50000, 20}];

Time = 0.130187(Ranging from .012.. to .014.. on my system)

$\endgroup$
3
  • $\begingroup$ Unfortunately this one doesn't work - try list = {{-1,10}} for example $\endgroup$ Aug 30, 2013 at 18:13
  • $\begingroup$ @SimonWoods: thanks for pointing out the mistake, I have tried fixing it. Can you please verify it once for me. $\endgroup$
    – Sejwal
    Aug 30, 2013 at 18:43
  • $\begingroup$ Yes, it's working now. $\endgroup$ Aug 30, 2013 at 18:46
4
$\begingroup$

One way to ensure the + wins in the case of equal Abs..

(Last@SortBy[ #, {Abs[#], #} & ]) & /@
   {{1, 2, -2}, {1, 5, -5}, {1, -3, 3}, {1, -4}}

(* {2, 5, 3, -4} *)

or this may be faster..dont feel like running for time.

(Last@SortBy[{Max[#], Min[#]}, Abs]) & /@
  {{1, 2, -2}, {1, -5, 5}, {1, -3, 3}, {1, -4}}

Edit -- oops not nesessary SortBy autmaticaly breaks the tie based on signed value so just this works..

(Last@SortBy[ #, Abs ]) & /@
   {{1, 2, -2}, {1, 5, -5}, {1, -3, 3}, {1, -4}}

" If some of the f[e_i] are the same, then the canonical order of the corresponding e_i is used. "

$\endgroup$
2
$\begingroup$

In versions 10+, you can use MaximalBy and TakeLargestBy:

list = {{1, -3, -5}, {2, 1, 6}, {0, 2, 4}, {-9, 2, 6}};

Flatten[MaximalBy[Abs]/@list]

 {-5, 6, 4, -9}

Flatten[TakeLargestBy[Abs, 1]/@list]

 {-5, 6, 4, -9}

TakeLargestBy is the faster of the two. Both are much slower than other methods posted so far.

$\endgroup$
1
$\begingroup$

As first pointed out by @rm-rf, there exist internal, undocumented functions Random`Private`MapThreadMin and Random`Private`MapThreadMax, and these are useful for this purpose. Here is a function that uses these internal functions:

maxByAbs[list_] := With[{t = Transpose@list},
    With[{min = Random`Private`MapThreadMin[t], max = Random`Private`MapThreadMax[t]},
        max + UnitStep[Abs[min] - max] (min-max)
    ]
]

The basic idea is to get the minimum and maximum values of each list, and then use arithmetic to figure out which one is larger. Here is the OP example:

maxByAbs[{{1, -3, -5}, {2, 1, 6}, {0, 2, 4}, {-9, 2, 6}}]

{-5, 6, 4, -9}

And here is a brief timing comparison with the chosen answer:

list=RandomInteger[{-30,30}, {50000,20}];

f = If[+## > 0, ##] & @@ {Max[#], Min[#]} &;

r1 = f/@list; //RepeatedTiming
r2 = maxByAbs[list]; //RepeatedTiming

r1===r2

{0.0068, Null}

{0.0028, Null}

True

$\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.