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 list, such as:

testdata = {{1, 317}, {2, 317}, {3, 317}, {4, 317}, {5, 317}, {6, 
    317}, {7, 318}, {8, 318}, {9, 318}, {10, 318}, {11, 319}, {12, 
    319}, {13, 319}, {14, 319}, {15, 314}, {16, 314}, {17, 314}, {18, 
    314}, {19, 314}, {20, 314}, {21, 314}, {22, 314}, {23, 314}, {24, 
    314}, {25, 314}, {26, 314}, {27, 314}, {28, 306}, {29, 306}, {30, 
    306}, {31, 306}, {32, 293}, {33, 293}, {34, 293}, {35, 293}, {36, 
    293}, {37, 293}, {38, 293}, {39, 223}, {40, 223}, {41, 223}, {42, 
    223}, {43, 154}, {44, 154}, {45, 154}, {46, 154}, {47, 219}, {48, 
    219}, {49, 219}, {50, 219}, {51, 267}, {52, 267}, {53, 267}, {54, 
    267}, {55, 293}, {56, 293}, {57, 293}, {58, 293}, {59, 300}, {60, 
    300}, {61, 300}, {62, 300}, {63, 287}, {64, 287}, {65, 287}, {66, 
    287}, {67, 273}, {68, 273}, {69, 273}, {70, 248}, {71, 248}, {72, 
    248}, {73, 248}, {74, 232}, {75, 232}, {76, 232}, {77, 232}, {78, 
    203}, {79, 203}, {80, 203}, {81, 203}, {82, 180}, {83, 180}, {84, 
    180}, {85, 180}, {86, 163}, {87, 163}, {88, 163}, {89, 163}, {90, 
    158}, {91, 158}, {92, 158}, {93, 158}, {94, 179}, {95, 179}, {96, 
    179}, {97, 179}, {98, 203}, {99, 203}, {100, 203}, {101, 
    203}, {102, 228}, {103, 228}, {104, 228}, {105, 228}, {106, 
    228}, {107, 228}, {108, 228}, {109, 228}, {110, 228}, {111, 
    228}, {112, 228}, {113, 228}, {114, 228}, {115, 230}, {116, 
    230}, {117, 230}, {118, 230}, {119, 225}, {120, 225}, {121, 
    225}, {122, 225}, {123, 214}, {124, 214}, {125, 214}, {126, 
    224}, {127, 224}, {128, 224}, {129, 224}, {130, 228}, {131, 
    228}, {132, 228}, {133, 228}, {134, 239}, {135, 239}, {136, 
    239}, {137, 239}, {138, 244}, {139, 244}, {140, 244}, {141, 
    244}, {142, 232}, {143, 232}, {144, 232}, {145, 232}, {146, 
    231}, {147, 231}, {148, 231}, {149, 231}, {150, 192}, {151, 
    192}, {152, 192}, {153, 192}, {154, 128}, {155, 128}, {156, 
    128}, {157, 128}, {158, 112}, {159, 112}, {160, 112}, {161, 
    192}, {162, 192}, {163, 192}, {164, 192}, {165, 249}, {166, 
    249}, {167, 249}, {168, 249}, {169, 257}, {170, 257}, {171, 
    257}, {172, 257}, {173, 240}, {174, 240}, {175, 240}, {176, 
    240}, {177, 214}, {178, 214}, {179, 214}, {180, 214}, {181, 
    200}, {182, 200}, {183, 200}, {184, 200}, {185, 212}, {186, 
    212}, {187, 212}, {188, 212}, {189, 201}, {190, 201}, {191, 
    201}, {192, 201}, {193, 173}, {194, 173}, {195, 173}, {196, 
    140}, {197, 140}, {198, 140}, {199, 140}, {200, 137}, {201, 
    137}, {202, 137}, {203, 137}, {204, 149}, {205, 149}, {206, 
    149}, {207, 149}, {208, 164}, {209, 164}, {210, 164}, {211, 
    164}, {212, 203}, {213, 203}, {214, 203}, {215, 203}, {216, 
    242}, {217, 242}, {218, 242}, {219, 242}, {220, 270}, {221, 
    270}, {222, 270}, {223, 270}, {224, 275}, {225, 275}, {226, 
    275}, {227, 275}, {228, 266}, {229, 266}, {230, 266}, {231, 
    275}, {232, 275}, {233, 275}, {234, 275}, {235, 285}, {236, 
    285}, {237, 285}, {238, 285}, {239, 291}, {240, 291}, {241, 
    291}, {242, 291}, {243, 277}, {244, 277}, {245, 277}, {246, 
    277}, {247, 271}, {248, 271}, {249, 271}, {250, 271}, {251, 
    271}, {252, 271}, {253, 271}, {254, 271}, {255, 271}, {256, 
    271}, {257, 271}, {258, 271}, {259, 271}, {260, 266}, {261, 
    266}, {262, 266}, {263, 266}, {264, 195}, {265, 195}, {266, 
    195}, {267, 195}, {268, 128}, {269, 128}, {270, 128}, {271, 
    128}, {272, 193}, {273, 193}, {274, 193}, {275, 193}, {276, 
    252}, {277, 252}, {278, 252}, {279, 276}, {280, 276}, {281, 
    276}, {282, 276}, {283, 271}, {284, 271}, {285, 271}, {286, 
    271}, {287, 256}, {288, 256}, {289, 256}, {290, 256}, {291, 
    250}, {292, 250}, {293, 250}, {294, 250}, {295, 236}, {296, 
    236}, {297, 236}, {298, 236}, {299, 211}, {300, 211}, {301, 
    211}, {302, 211}, {303, 188}, {304, 188}, {305, 188}, {306, 
    188}, {307, 165}, {308, 165}, {309, 165}, {310, 165}, {311, 
    156}, {312, 156}, {313, 156}, {314, 153}, {315, 153}, {316, 
    153}, {317, 153}, {318, 165}, {319, 165}, {320, 165}, {321, 
    165}, {322, 191}, {323, 191}, {324, 191}, {325, 191}, {326, 
    228}, {327, 228}, {328, 228}, {329, 228}, {330, 261}, {331, 
    261}, {332, 261}, {333, 261}, {334, 267}, {335, 267}, {336, 
    267}, {337, 267}, {338, 267}, {339, 267}, {340, 267}, {341, 
    267}, {342, 267}, {343, 267}, {344, 267}, {345, 267}, {346, 
    267}, {347, 266}, {348, 266}, {349, 266}, {350, 266}, {351, 
    259}, {352, 259}, {353, 259}, {354, 259}, {355, 258}, {356, 
    258}, {357, 258}, {358, 258}, {359, 251}, {360, 251}, {361, 
    251}, {362, 251}, {363, 254}, {364, 254}, {365, 254}, {366, 
    252}, {367, 252}, {368, 252}, {369, 252}, {370, 260}, {371, 
    260}, {372, 260}, {373, 260}, {374, 275}, {375, 275}, {376, 
    275}, {377, 275}, {378, 209}, {379, 209}, {380, 209}, {381, 
    209}, {382, 136}, {383, 136}, {384, 136}, {385, 136}, {386, 
    175}, {387, 175}, {388, 175}, {389, 175}, {390, 240}, {391, 
    240}, {392, 240}, {393, 240}, {394, 267}, {395, 267}, {396, 
    267}, {397, 267}, {398, 255}, {399, 255}, {400, 255}, {401, 
    243}, {402, 243}, {403, 243}, {404, 243}, {405, 227}, {406, 
    227}, {407, 227}, {408, 227}, {409, 218}, {410, 218}, {411, 
    218}, {412, 218}, {413, 207}, {414, 207}, {415, 207}, {416, 
    207}, {417, 196}, {418, 196}, {419, 196}, {420, 196}, {421, 
    195}, {422, 195}, {423, 195}, {424, 195}, {425, 200}, {426, 
    200}, {427, 200}, {428, 200}, {429, 214}, {430, 214}, {431, 
    214}, {432, 214}, {433, 229}, {434, 229}, {435, 229}, {436, 
    229}, {437, 256}, {438, 256}, {439, 256}, {440, 283}, {441, 
    283}, {442, 283}, {443, 283}, {444, 285}, {445, 285}, {446, 
    285}, {447, 285}, {448, 293}, {449, 293}, {450, 293}, {451, 
    293}, {452, 294}, {453, 294}, {454, 294}, {455, 294}, {456, 
    294}, {457, 294}, {458, 294}, {459, 294}, {460, 293}, {461, 
    293}, {462, 293}, {463, 293}, {464, 278}, {465, 278}, {466, 
    278}, {467, 278}, {468, 277}, {469, 277}, {470, 277}, {471, 
    277}, {472, 266}, {473, 266}, {474, 266}, {475, 251}, {476, 
    251}, {477, 251}, {478, 251}, {479, 250}, {480, 250}, {481, 
    250}, {482, 250}, {483, 250}, {484, 250}, {485, 250}, {486, 
    250}, {487, 250}, {488, 250}, {489, 250}, {490, 250}, {491, 
    250}, {492, 239}, {493, 239}, {494, 239}, {495, 239}, {496, 
    159}, {497, 159}, {498, 159}, {499, 159}, {500, 139}, {501, 
    139}, {502, 139}, {503, 139}, {504, 215}, {505, 215}, {506, 
    215}, {507, 215}, {508, 267}, {509, 267}, {510, 267}, {511, 
    267}, {512, 289}, {513, 289}, {514, 289}, {515, 289}, {516, 
    267}, {517, 267}, {518, 267}, {519, 267}, {520, 256}, {521, 
    256}, {522, 256}, {523, 256}, {524, 222}, {525, 222}, {526, 
    222}, {527, 194}, {528, 194}, {529, 194}, {530, 194}, {531, 
    185}, {532, 185}, {533, 185}, {534, 185}, {535, 181}, {536, 
    181}, {537, 181}, {538, 181}, {539, 195}, {540, 195}, {541, 
    195}, {542, 195}, {543, 199}, {544, 199}, {545, 199}, {546, 
    199}, {547, 199}, {548, 199}, {549, 199}, {550, 199}, {551, 
    214}, {552, 214}, {553, 214}, {554, 214}, {555, 226}, {556, 
    226}, {557, 226}, {558, 226}, {559, 255}, {560, 255}, {561, 
    255}, {562, 268}, {563, 268}, {564, 268}, {565, 268}, {566, 
    274}, {567, 274}, {568, 274}, {569, 274}, {570, 274}, {571, 
    274}, {572, 274}, {573, 274}, {574, 274}, {575, 274}, {576, 
    274}, {577, 274}, {578, 274}, {579, 268}, {580, 268}, {581, 
    268}, {582, 268}, {583, 270}, {584, 270}, {585, 270}, {586, 
    270}, {587, 260}, {588, 260}, {589, 260}, {590, 260}, {591, 
    250}, {592, 250}, {593, 250}, {594, 250}, {595, 230}, {596, 
    230}, {597, 230}, {598, 230}, {599, 227}, {600, 227}, {601, 
    227}, {602, 227}, {603, 240}, {604, 240}, {605, 240}, {606, 
    240}, {607, 240}, {608, 240}, {609, 240}, {610, 235}, {611, 
    235}, {612, 235}, {613, 235}, {614, 156}, {615, 156}, {616, 
    156}, {617, 156}, {618, 108}, {619, 108}, {620, 108}, {621, 
    108}, {622, 190}, {623, 190}, {624, 190}, {625, 190}, {626, 
    237}, {627, 237}, {628, 237}, {629, 237}, {630, 261}, {631, 
    261}, {632, 261}, {633, 261}, {634, 242}, {635, 242}, {636, 
    242}, {637, 242}, {638, 215}, {639, 215}, {640, 215}, {641, 
    215}, {642, 191}, {643, 191}, {644, 191}, {645, 162}, {646, 
    162}, {647, 162}, {648, 162}, {649, 160}, {650, 160}, {651, 
    160}, {652, 160}, {653, 148}, {654, 148}, {655, 148}, {656, 
    148}, {657, 147}, {658, 147}, {659, 147}, {660, 147}, {661, 
    160}, {662, 160}, {663, 160}, {664, 160}, {665, 177}, {666, 
    177}, {667, 177}, {668, 177}, {669, 211}, {670, 211}, {671, 
    211}, {672, 211}, {673, 234}, {674, 234}, {675, 234}, {676, 
    234}, {677, 252}, {678, 252}, {679, 252}, {680, 261}, {681, 
    261}, {682, 261}, {683, 261}, {684, 261}, {685, 261}, {686, 
    261}, {687, 261}, {688, 259}, {689, 259}, {690, 259}, {691, 
    259}, {692, 245}, {693, 245}, {694, 245}, {695, 245}, {696, 
    252}, {697, 252}, {698, 252}, {699, 252}, {700, 267}, {701, 
    267}, {702, 267}, {703, 267}, {704, 278}, {705, 278}, {706, 
    278}, {707, 278}, {708, 277}, {709, 277}, {710, 277}, {711, 
    277}, {712, 267}, {713, 267}, {714, 267}, {715, 267}, {716, 
    267}, {717, 267}, {718, 267}, {719, 267}, {720, 267}, {721, 
    267}, {722, 267}, {723, 267}, {724, 267}, {725, 267}, {726, 
    267}, {727, 267}, {728, 267}, {729, 259}, {730, 259}, {731, 
    259}, {732, 259}, {733, 177}, {734, 177}, {735, 177}, {736, 
    132}, {737, 132}, {738, 132}, {739, 132}, {740, 202}, {741, 
    202}, {742, 202}, {743, 202}, {744, 258}, {745, 258}, {746, 
    258}, {747, 258}, {748, 285}, {749, 285}, {750, 285}, {751, 
    285}, {752, 278}, {753, 278}, {754, 278}, {755, 278}, {756, 
    268}, {757, 268}, {758, 268}, {759, 268}, {760, 251}, {761, 
    251}, {762, 251}, {763, 251}, {764, 242}, {765, 242}, {766, 
    242}, {767, 251}, {768, 251}, {769, 251}, {770, 251}, {771, 
    222}, {772, 222}, {773, 222}, {774, 222}, {775, 186}, {776, 
    186}, {777, 186}, {778, 186}, {779, 164}, {780, 164}, {781, 
    164}, {782, 164}, {783, 161}, {784, 161}, {785, 161}, {786, 
    161}, {787, 177}, {788, 177}, {789, 177}, {790, 177}, {791, 
    198}, {792, 198}, {793, 198}, {794, 198}, {795, 234}, {796, 
    234}, {797, 234}, {798, 249}, {799, 249}, {800, 249}, {801, 
    249}, {802, 249}, {803, 249}, {804, 249}, {805, 249}, {806, 
    249}, {807, 249}, {808, 249}, {809, 249}, {810, 249}, {811, 
    249}, {812, 256}, {813, 256}, {814, 256}, {815, 244}, {816, 
    244}, {817, 244}, {818, 244}, {819, 239}, {820, 239}, {821, 
    239}, {822, 239}, {823, 248}, {824, 248}, {825, 248}, {826, 
    248}, {827, 256}, {828, 256}, {829, 256}, {830, 256}, {831, 
    244}, {832, 244}, {833, 244}, {834, 244}, {835, 228}, {836, 
    228}, {837, 228}, {838, 228}, {839, 225}, {840, 225}, {841, 
    225}, {842, 225}, {843, 224}, {844, 224}, {845, 224}, {846, 
    224}, {847, 222}, {848, 222}, {849, 222}, {850, 222}, {851, 
    154}, {852, 154}, {853, 154}, {854, 128}, {855, 128}, {856, 
    128}, {857, 128}, {858, 206}, {859, 206}, {860, 206}, {861, 
    206}, {862, 262}, {863, 262}, {864, 262}, {865, 262}, {866, 
    289}, {867, 289}, {868, 289}, {869, 289}, {870, 271}, {871, 
    271}, {872, 271}, {873, 271}, {874, 244}, {875, 244}, {876, 
    244}, {877, 244}, {878, 222}, {879, 222}, {880, 222}, {881, 
    222}, {882, 206}, {883, 206}, {884, 206}, {885, 206}, {886, 
    196}, {887, 196}, {888, 196}, {889, 183}, {890, 183}, {891, 
    183}, {892, 183}, {893, 178}, {894, 178}, {895, 178}, {896, 
    178}, {897, 172}, {898, 172}, {899, 172}, {900, 172}, {901, 
    171}, {902, 171}, {903, 171}, {904, 171}, {905, 192}, {906, 
    192}, {907, 192}, {908, 192}, {909, 213}, {910, 213}, {911, 
    213}, {912, 213}, {913, 249}, {914, 249}, {915, 249}, {916, 
    279}, {917, 279}, {918, 279}, {919, 279}, {920, 282}};

Q1: I would like to get the peak and valley in the graph and draw it,

Q2: I would like to find how many valleys are in this list,

Q3: I would like to get the first 200 points and minimum valleys.

This is what I've tried so far:

ListLinePlot[testdata]

Thanks for your help, I have been successful :)

this is my code

mins=Pick[testdata,MinDetect[testdata[[All,2]]],1];
maxs=Pick[testdata,MaxDetect[testdata[[All,2]]],1];
Show[ListLinePlot[testdata[[All,2]],Filling->Axis,AxesLabel->{number,ECG_Data}],ListPlot[maxs,PlotStyle->Red,PlotLegends->{"Peak"}],ListPlot[mins,PlotStyle->Blue,PlotLegends->{"Valley"}]]
Thr=200;

findpeak=Position[Differences[MaxDetect[testdata[[All,2]]]],-1];
findvalley=Position[Differences[MinDetect[testdata[[All,2]]]],-1];
peak=Extract[testdata,findpeak];
valley=Extract[testdata,findvalley];
valleysmin200=Select[valley,#[[2]]<Thr&];
f1=ListLinePlot[testdata,AxesLabel->{number,ECG_Data},Filling->Axis,FillingStyle->Automatic];
f2=ListPlot[peak,PlotStyle->{Red,PointSize[Large]},PlotLegends->{"Peak"}];
f3=ListPlot[valley,PlotStyle->{Blue,PointSize[Large]},PlotLegends->{"Valley"}];
f4=ListPlot[valleysmin200,PlotStyle->{Blue,PointSize[Large]},PlotLegends->{"Valley"}];
f5=ListLinePlot[Table[Thr,{Length[testdata]}],PlotStyle -> Pink];
Show[f1,f2,f3] (*modify peak & valley*)
Show[f1,f4,f5] (*valley<200*)
Length[valleysmin200]/2*12
share|improve this question
2  
Welcome to the site! You usually get better answers here if you show some effort. What have you tried? –  belisarius Feb 19 '13 at 12:53
3  
That semicolon at the end of ListLinePlot[testdata]; isn't useful. See mathematica.stackexchange.com/a/18617/61 –  cormullion Feb 19 '13 at 13:03
2  
This question may give you some ideas mathematica.stackexchange.com/questions/5575/… –  image_doctor Feb 19 '13 at 13:31
    
It would help to clarify what you mean exactly by a "peak" or "valley." Let's focus on valleys: in the sequence $(0,1,1,1,5,2,2,4,3,6)$ how many "valleys" are there and where are they located? A local search would return valleys of heights 1,2,2, and 3 at positions 3,6,7, and 9; a more careful but still local search would return heights of 2,2, and 3 at positions 6,7, and 9; the currently most popular solution returns only positions 7 and 9. –  whuber Feb 19 '13 at 18:53
1  
@Mr.Wizard Although at one level this question appears to duplicate the one referenced by image_doctor, it asks a question about sequences of data as opposed to a function. Some, but not all, solutions of the latter could be applied here (by replacing a data sequence with a linear interpolator), but not vice versa; nevertheless, the present question invites solutions not applicable to the other one. Therefore these questions are not duplicates of each other. –  whuber Feb 20 '13 at 16:37
show 1 more comment

4 Answers 4

up vote 19 down vote accepted

Perhaps you could try this (only in the current version of Mathematica):

mins =  Pick[testdata, MinDetect[testdata[[All, 2]]], 1]
maxs =  Pick[testdata, MaxDetect[testdata[[All, 2]]], 1]

Show[ListLinePlot[testdata[[All, 2]], Filling -> Axis], 
     ListPlot[mins, PlotStyle -> Red], 
     ListPlot[maxs, PlotStyle -> Blue]]

minmax

share|improve this answer
2  
Seems to work nice, but not with my Mathematica 8.0.1. MinDetect expects an image or graphics instead of such a list. Has this changed in the newer Mathematica version? Or did you make some operations on the testdata before using MinDetect? –  partial81 Feb 19 '13 at 15:25
    
@partial81 Yes, this is functionality introduced in version 9. I've added a note to this effect. –  cormullion Feb 19 '13 at 15:29
    
Great to hear that MinDetect was expanded in the newer Mathematica version. So, MinDetect is something I will use often for sure in the future - but at the moment I have to wait until I can install Mathematica 9. Is there an easy way to make some operation on the testdata so that MinDetect can be used as you did with Mathematica 8.0.1? –  partial81 Feb 19 '13 at 15:33
    
@partial81 sorry, I haven't a clue... :( –  cormullion Feb 19 '13 at 15:44
    
This was very much not on my radar - nice one! –  Yves Klett Feb 19 '13 at 15:52
show 3 more comments

A fast functional implementation

Here is a functional implementation which I think should be fairly fast:

Clear[localExtremaPositionsUnique, localExtremaPositions];
localExtremaPositionsUnique[lst_List, type : (Min | Max) : Min] :=
   Pick[Range[Length[lst] - 2] + 1, 
     Differences[Sign[Differences@lst] + 1], 
     If[type === Min, 2, -2]
   ]; 

localExtremaPositions[lst_, type : (Min | Max) : Min, uniqueF_: localExtremaPositionsUnique] := 
With[{split = Split[lst]},
    With[{lengths = Length /@ split, unique  = split[[All, 1]]},
      Transpose[MapAt[# + 1 &, #, 1] &@Partition[#, Length[#]/2] &@
        Accumulate[lengths][[Flatten[{#, # + 1}] &@uniqueF[unique,type] - 1]]
      ]]];

The first function works for data which does not have valleys. The second function works for data with valleys and uses the first one.

Usage

Here is what it gives for your data:

localExtremaPositions[testdata[[All,2]],Min]

(*
  {{43,46},{90,93},{123,125},{158,160},{181,184},{200,203},{228,230},
   {268,271},{314,317},{359,362},{366,369},{382,385},{421,424},{500,503},
   {535,538},{579,582},{599,602},{618,621},{657,660},{692,695},{736,739},
   {764,766},{783,786},{819,822},{854,857},{901,904}}
*)

localExtremaPositions[testdata[[All,2]],Max]

(*
   {{11,14},{59,62},{115,118},{138,141},{169,172},{185,188},{224,227},
   {239,242},{279,282},{334,346},{363,365},{374,377},{394,397},{452,459},
   {512,515},{566,578},{583,586},{603,609},{630,633},{680,687},{704,707},
   {748,751},{767,770},{812,814},{827,830},{866,869}}
*)

It returns a list of position intervals for valleys of minima or maxima.

Benchmarks

Here is some power test:

large = RandomInteger[100,10^5];

(ints = localExtremaPositions[large,Min]);//AbsoluteTiming

(* {0.095703,Null} *)

Let us compare with the MinDetect-based solution:

(pos= Pick[Range[Length[large ]],MinDetect[large] ,1]);//AbsoluteTiming

(* {0.999023,Null}  *)

We can see that the results are the same (although my code gives intervals while the one which uses MinDetect gives individual positions), by executing

Flatten[Range@@@ints]==pos

(*  True  *)

So, at least for this particular sample, it appears that the above top-level functional implementation is an order of magnitude more efficient than a built-in function - a rare case.

share|improve this answer
    
Would you care to benchmark vs. the MinDetect/MaxDetect solution by @cormullion? –  Yves Klett Feb 19 '13 at 15:53
1  
@YvesKlett Actually, I was wrong, since I used testdata for MinDetect and large for my code. My code is 10 times faster than MinDetect, it seems. –  Leonid Shifrin Feb 19 '13 at 16:22
1  
@YvesKlett I added a benchmark to my post. –  Leonid Shifrin Feb 19 '13 at 16:33
2  
@whuber Normally I don't care about vote counts too much, but they determine answers' visibility, and here I'd like to somehow let people know about the fact that, as long as efficiency is concerned, the current implementation of a built-in is not the best way to go (usually folks stop reading as soon as they see a short code based on a built-in). But I don't see a way of doing this without obvious self-promotion of this answer, and also the performance aspect was not emphasized in the question, so I guess we'll live with that until a specific performance-tuning question on this topic appears. –  Leonid Shifrin Feb 19 '13 at 20:07
1  
What you say about APL style coding is interesting, because your approach has a distinct R flavor to it, too. As far as promotion goes, in another 41 hours or so we can place a small bounty here if your answer doesn't get enough attention :-). (FWIW, I know you are not alone in your strategy of developing material for a book out of SE contributions. :-) –  whuber Feb 19 '13 at 20:35
show 9 more comments

This is my first answer at mma.se -- please bear with me... I'm still learning Mathematica!

Nevertheless, I'd like to share the following approach to find the extremal points in a list:

findExtremaPos[list_List] := Module[
  {signs, extremaPos, minPos, maxPos},
  signs = Sign[Differences[list]];
  signs = signs //. {a___, q_, 0, z__} -> {a, q, q, z};
  extremaPos = 1 + Accumulate@(Length /@ Split[signs]);
  If[First@signs == 1,
   minPos = extremaPos[[2 ;; -2 ;; 2]]; maxPos = extremaPos[[1 ;; -2 ;; 2]],
   minPos = extremaPos[[1 ;; -2 ;; 2]]; maxPos = extremaPos[[2 ;; -2 ;; 2]]
   ];
  {minPos, maxPos}
 ]

Basically, what the code does is taking the signs of the forward differences.
Whenever the sign changes, there should be either a minimum (from -1 to 1) or a maximum (from 1 to -1).

A possible pitfall arises when the forward differences take on 0, i.e. consecutive values in the initial list are exactly the same.
Here, I solve this issue by changing all 0-signs to the previous non-0-sign.

signs = signs //. {a___, q_, 0, z__} -> {a, q, q, z};

Effectively, this means that when a maximum or minimum is not sharp but forms a plateau only the position of the last value of the plateau is returned.

Here's an example that shows:

  • the code is working
  • what happens when the extremum forms a plateau

Example:

data = {1, 2, 1, 1, 3, 4, 3, 3, 3, 2, 1, 0, -1, 0, 1, 2, 3};
{minPos, maxPos} = findExtremaPos[data];
ListPlot[data, Joined -> True,
 Epilog -> {PointSize[Large],
   Red, Point[{#, data[[#]]} & /@ minPos],
   Blue, Point[{#, data[[#]]} & /@ maxPos]},
 PlotRange -> All
]

enter image description here

share|improve this answer
    
Thanks for your answer :) –  user5990 Feb 20 '13 at 7:50
add comment

Cormullion's solution, which invokes built-in procedures MinDetect and MaxDetect, can be made to work in earlier versions of Mathematica than 9.0 using identically named (but differently functional) procedures. Image processing functionality was introduced in version 7 and included in that are MinDetect and MaxDetect for finding "regional" or "extended" extrema.

The idea is to represent this one-dimensional data series as a 2D image by replicating it in the second dimension. Although two rows will do, I use more here in order increase the visibility of the images, which otherwise would be too slender to see well. First convert the data into an image:

nrow = 32;
i = Image[SparseArray[Flatten[Table[{i, #1} -> #2 , {i, 1, nrow}] & @@@ testdata]]] // ImageAdjust

(ImageAdjust makes the data visible by means of a linear rescaling of values, which will not change the locations of any extrema.)

Image

This immediately makes available some intriguing ways to visualize the extrema, such as with a strip-like chart:

ColorCombine[{MaxDetect[i], i, MinDetect[i]}]

Image 2

In this case blues mark minima and yellows mark maxima, all superimposed on a graduated green representation of the data.

We can readily post-process the images of "peaks" and "valleys" to obtain more traditional representations of the locations of extrema, such as sorted lists of those positions:

{minima, maxima} = Flatten[Position[First[ImageData[#[i]]], 1]] & /@ {MinDetect, MaxDetect};

Show[ListPlot[testdata, Joined -> True, PlotStyle -> Gray],
 ListPlot[testdata[[minima]], PlotStyle -> Red],
 ListPlot[testdata[[maxima]], PlotStyle -> Blue], 
 AxesOrigin -> Min /@ (testdata\[Transpose])]

Image 3

Number of valleys:

Length[minima]

$106$

"First 200 points and minimum valleys": I'm not sure what this means, but obviously we have obtained the relevant information in a sufficiently convenient form to answer any such questions, however they might be interpreted.

Although this is a cute method (and might inspire some compact and effective visualizations), it is relatively slow: about 0.014 seconds are needed to obtain the minima and maxima lists for this short sequence of data. About $10^5$ points can be processed per second.

share|improve this answer
    
That is an intriguing method. I could find use for it, +1. –  rcollyer Feb 19 '13 at 20:57
    
The Function is cool!!! Thanks a lot :) –  user5990 Feb 20 '13 at 7:26
    
Great! Thanks for posting this solution! –  partial81 Feb 20 '13 at 14:14
1  
Used it here mathematica.stackexchange.com/a/19919/193 –  belisarius Feb 21 '13 at 13:19
add comment

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.