Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
    
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

3 Answers 3

up vote 6 down vote accepted

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]

enter image description here

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.

share|improve this answer
    
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
1  
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
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}]
share|improve this answer
    
Thanks again Belisarius. –  Amatya Sep 21 '12 at 1:45

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]]
share|improve this answer
    
Thanks a lot! This really helped! –  Amatya Sep 21 '12 at 1:44

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.