# Argmax in a List

I have a sequence of 100 lists. A sample list, list[1], looks like this:

list[1]=Table[{N[i/10], 25 - (i - 2)^2, 25 - (i - 8)^2}, {i, 1, 10}]

{{0.1, 24, -24},
{0.2, 25, -11},
{0.3, 24, 0},
{0.4, 21, 9},
{0.5, 16,16},
{0.6, 9, 21},
{0.7, 0, 24},
{0.8, -11, 25},
{0.9, -24,24},
{1., -39, 21}}


I would like to see where the 3rd column, $list[1][[*, 3]]$ is maximized.

The 8th Row in this example. Then I want to note the value of the first column in the 8th row, namely

$list[1][[8,1]]=0.8$.

Then I would like to delete all records where the 1st column is > 0.8, i.e. where

$list[1][[*,1]]>list[1][[8,1]]$ .

In this example, since the numbers are monotonic, that means the last two rows get deleted. I'll be left with:

    {{0.1, 24, -24},
{0.2, 25, -11},
{0.3, 24, 0},
{0.4, 21, 9},
{0.5, 16,16},
{0.6, 9, 21},
{0.7, 0, 24},
{0.8, -11, 25}}


Then, I would like to see where the 2nd column, $list[1][[*, 2]]$ is maximized.

The 2nd Row in this example. Then I want to note the value of the first column in the 2nd row, namely

$list[1][[2,1]]=0.2$.

Then I would like to delete all records where the 1st column is < 0.2, i.e. where

$list[1][[*,1]]<list[1][[2,1]]$ .

In this example, since the numbers are monotonic, that means the first row get deleted. I'll be left with:

    {
{0.2, 25, -11},
{0.3, 24, 0},
{0.4, 21, 9},
{0.5, 16,16},
{0.6, 9, 21},
{0.7, 0, 24},
{0.8, -11, 25}}


I guess both transformations are identical so if I know how to do one, I can do the other. I just mentioned both simply because it might be feasible to do both in one shot and that code might teach me more than learning the code for a single transformation.

Also, I have a hundred different lists and I'd like to be able to do this transformation to all 100 of them in one shot, using Table or something.

Thanks, PS: I have read advanced help but I can't seem to figure out how to get the shaded grey background on certain text so I have instead put  to get things like $list[1][[*, 2]]$ as latex math above in my question to appear distinguished from the rest of the text.

-
 Is it to be assumed that the first column of the data is always monotonic? – Mr.Wizard♦ Oct 21 '12 at 22:13 @Mr.Wizard no but I suppose I could always sort it on the first column. – Amatya Oct 23 '12 at 1:16

There might be a more efficient way, but here is a first shot, that keeps the order of the list

valueMax = First@list[1][[First@Flatten@Position[list[1][[All, 3]],Max@list[1][[All, 3]]]]]


0.8

valueMin = First@list[1][[First@Flatten@Position[list[1][[All, 2]],Max@list[1][[All, 2]]]]]


0.2

Complement[list[1],Select[list[1], #[[1]] > valueMax || #[[1]] < valueMin &]]


{{0.2, 25, -11}, {0.3, 24, 0}, {0.4, 21, 9}, {0.5, 16, 16}, {0.6, 9, 21}, {0.7, 0, 24}, {0.8, -11, 25}}

## The improved version

(My value selection, wxffles' "DeleteCases")

t3[a_] :=  With[{valueMax = First@a[[First@Flatten@Position[a[[All, 3]], Max@a[[All, 3]]]]],
valueMin = First@a[[First@Flatten@Position[a[[All, 2]], Max@a[[All, 2]]]]]},
DeleteCases[ a, {first_, _, _} /; first > valueMax || first < valueMin]]


We can compare the timing of this one (t3), the old version(t2), belisarius'(t4) and wxffles (t3)

 t1[a_] := With[{max2 = Ordering[a, 1, #1[[2]] > #2[[2]] &][[1]],
max3 = Ordering[a, 1, #1[[3]] > #2[[3]] &][[1]]},
DeleteCases[a, {first_, _, _} /; first > a[[max3, 1]] || first < a[[max2,1]]]]

t2[a_] := With[{valueMax = First@a[[First@Flatten@Position[a[[All, 3]], Max@a[[All, 3]]]]],
valueMin = First@a[[First@Flatten@Position[a[[All, 2]],Max@a[[All, 2]]]]]},
Complement[a, Select[a, #[[1]] > valueMax || #[[1]] < valueMin &]]]

maxC[l_List, col_Integer] := l[[First[Ordering[-l[[All, col]]]]]]
sel[l_List, colsel_, colcomp_, op_] := Select[l, op[#[[colcomp]], maxC[l, colsel][[colcomp]]] &];
t4[l_List] := sel[sel[l, 3, 1, LessEqual], 2, 1, GreaterEqual]


And make a little plot:

 ListPlot[Transpose@
Table[list[1] = Table[{N[i/10], 25 - (i - 2)^2, 25 - (i - 8)^2}, {i, 1, n}];
{First@AbsoluteTiming@t1[list[1]],
First@AbsoluteTiming@t2[list[1]],
First@AbsoluteTiming@t3[list[1]],
First@AbsoluteTiming@t4[list[1]]}, {n, 1, 100}], Joined -> True, ImageSize -> 500]


It looks like the calculation of the limiting values of t2 and t3 are the fastest. And using DeleteCases is a faster than Complement. So for long lists method t3 is the fastest.

-
So you could a Timing worksheet :) – belisarius Sep 21 '12 at 0:57
@belisarius I think he accidentally the timing worksheet. – wxffles Sep 21 '12 at 1:11
@wxffles Yep. You are – belisarius Sep 21 '12 at 1:22
Re: Timings. Nice work. If you search the site you will find a few Timing functions that we usually use. Nothing special, but they are "standard" , so to speak – belisarius Sep 21 '12 at 1:35
And now I went off to the obscure world of checking the performance of the code the right way. Spoiler: I did it horribly careless :) and, yes, it is great to read other peoples code. So many things to learn from it. – jenson Sep 21 '12 at 2:15

To find where the maximum is you can use Ordering:

which = Ordering[list, 1, #1[[3]] > #2[[3]] &][[1]]


where we have sorted by the 3rd column and just taken the first element.

Then to delete the cases we don't want, we use DeleteCases

DeleteCases[list, {first_, _, _} /; first > list[[which, 1]]]


We can put your transformation all together in a function:

ClearAll[t];
t[a_] :=
With[{max2 = Ordering[a, 1, #1[[2]] > #2[[2]] &][[1]],
max3 = Ordering[a, 1, #1[[3]] > #2[[3]] &][[1]]},
DeleteCases[a, {first_, _, _} /; first > a[[max3, 1]] || first < a[[max2, 1]]]]


Then apply as so:

t[list[1]]

-
 Thanks a lot! This really helped! – Amatya Sep 21 '12 at 1:44
list[1] = Table[{N[i/10], 25 - (i - 2)^2, 25 - (i - 8)^2}, {i, 1, 10}];
maxC[l_List, col_Integer] := l[[First[Ordering[-l[[All, col]]]]]]
sel[l_List,colsel_,colcomp_, op_]:=Select[l, op[#[[colcomp]], maxC[l, colsel][[colcomp]]] &];
selF[l_List] := sel[sel[l, 3, 1, LessEqual], 2, 1, GreaterEqual];
selF@list[1]


And of course you can do

selF /@ Table[list[i],{i,n}]

-
 Thanks again Belisarius. – Amatya Sep 21 '12 at 1:45