Pick elements of largest absolute value

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 "InternalMaxAbs",but it only accept two args，for example：

InternalMaxAbs[2, -3]
InternalMaxAbs[{1, -3, -5}, {2, 1, 6}]
(*
3
{2, 3, 6}
*)


How can I make it can accept Multiple parameters?

-
To be sure: what happens if a sublist is e.g. {1,2,2}? You'd pick 2 just once or twice? – Pinguin Dirk Aug 30 '13 at 8:39
@PinguinDirk or even more interesting what if {1,-2,2} :) – Kuba Aug 30 '13 at 9:22
@Kuba, Just pick once, if {1,-2,2} should return 2. – expression Aug 30 '13 at 10:17
@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. – Kuba Aug 30 '13 at 10:22
Possible duplicate: mathematica.stackexchange.com/q/11795/5 – R. M. Aug 30 '13 at 11:12

(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} *)

-
Oh dear, I'm afraid to try this, because I think I'm about to lose. :o) – Mr.Wizard Aug 30 '13 at 11:08
Well, in v7 and with my particular test mine is still #1, but +1 for a nice method and making me sweat. :-) – Mr.Wizard Aug 30 '13 at 11:11
@Mr.Wizard, saved by the version number! On v9 I am getting about 150 ms for your method and 20 ms for mine. – Simon Woods Aug 30 '13 at 11:26
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. – Mr.Wizard Aug 30 '13 at 20:19
Simon, is my method any faster in v9 using RankedMax? – Mr.Wizard Aug 30 '13 at 20:24

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.

-
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. – Mr.Wizard Aug 30 '13 at 10:32
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! – Pinguin Dirk Aug 30 '13 at 10:34
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. :-) – Mr.Wizard Aug 30 '13 at 10:38
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 :) – Pinguin Dirk Aug 30 '13 at 10:40

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

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

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.

-
fyi, just added your test to the test cases above in my post. (too many ways to do the same thing in Mathematica) ! – Nasser Aug 30 '13 at 13:27
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. – Szabolcs Aug 30 '13 at 13:58
@Nasser Simon's seems to win in all situations, regardless of the dimensions of the input. – Szabolcs Aug 30 '13 at 14:06
@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. – Simon Woods Aug 30 '13 at 14:19
@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). – Szabolcs Aug 30 '13 at 21:14
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}

-

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


Using this list

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


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

-
@Mr.Wizard corrected and updated. Gpap and Simon tests seem to give an almost identical performance on these 2 lists. – Nasser Aug 30 '13 at 20:56

I'll join the fun:

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


-

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.

-
make that >= for the + to win the tie.. – george2079 Aug 30 '13 at 20:51

More fun:

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

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

-
Clever, but it's worth noting that this only works if each sub-list is the same length. – Mr.Wizard Aug 30 '13 at 10:21
@Mr. Wizard. That is true. Didn't think of that. Thanks – TomD Aug 30 '13 at 10:33

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

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

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

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. "

-