24

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
Darren Lee
  • 587
  • 4
  • 11
  • 2
    Welcome to the site! You usually get better answers here if you show some effort. What have you tried? – Dr. belisarius Feb 19 '13 at 12:53
  • 3
    That semicolon at the end of ListLinePlot[testdata]; isn't useful. See http://mathematica.stackexchange.com/a/18617/61 – cormullion Feb 19 '13 at 13:03
  • 2
    This question may give you some ideas http://mathematica.stackexchange.com/questions/5575/how-to-find-all-the-local-minima-maxima-in-a-range – 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
  • @image_doctor do you think this is a duplicate? – Mr.Wizard Feb 19 '13 at 22:52
  • 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

4 Answers4

32

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

cormullion
  • 24,243
  • 4
  • 64
  • 133
  • 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
  • @cormullion: no problem. One more reason to get Mathematica 9! Thanks for posting this nice solution! – partial81 Feb 19 '13 at 18:27
23

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

Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
tzelleke
  • 331
  • 1
  • 6
19

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.

Leonid Shifrin
  • 114,335
  • 15
  • 329
  • 420
  • Would you care to benchmark vs. the MinDetect/MaxDetect solution by @cormullion? – Yves Klett Feb 19 '13 at 15:53
  • @YvesKlett It is about 1.5-2 times faster than my code. – Leonid Shifrin Feb 19 '13 at 16:10
  • 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
  • +1 for two reasons: (1) the code returns intervals of locations rather than (arbitrarily) selecting one point within each interval and (2) it is remarkably efficient. (I was hoping that converting the sign-sequence of differences into strings and searching by means of a regular expression could do better--and it does, by about an order of magnitude--but the overhead of string conversion causes the total time to be 10% slower.) – whuber Feb 19 '13 at 19:59
  • @whuber Thanks. I have solved this problem a while back, originally for a new book I am slowly working on, where this is one of the performance-tuning / multiparadigm programming case study problems. I have compiled to C version which is a few times faster still, but it is also uglier. The real point here is that I beat the built-in 10 times - which speaks both in favor of my approach and not so well of the built-in code. I'll probably ask around about this, or at least let those who work on it know that that code is suboptimal, performance-wise. – Leonid Shifrin Feb 19 '13 at 20:03
  • 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
  • @whuber Apart from some value in itself, the actual reason I posted this answer is that this seems to be a good example of a not-too-trivial application of APL-style (vectorized) top-level coding. Sometimes I use SE as a way to document some of my things, since by posting an answer I can embed it into a wider SE context with cool answers of others, and I can easily reconstruct this full context just by finding my answer in my list of answers. A kind of a special way of bookmarking :-). – Leonid Shifrin Feb 19 '13 at 20:12
  • 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
  • @whuber I am by far not an R expert (it is actually funny how little one really needs to know about the language to write a basic link to it :-)), although from what I know I can see that in R this style will also be beneficial. But R surely took this vectorized paradigm from APL, or at least APL was AFAIK the first language to emphasize and embrace this paradigm (not that I know APL - I just know a little about it). As to the book, well, good to know, I am in good company :-) – Leonid Shifrin Feb 19 '13 at 20:39
  • @whuber Darn, I just looked at the links - I swear I did not see your code! :-). It looks very elegant in R. I actually wanted to learn R better by re-implementing in it a bunch of my Mathematica solutions - now with RLink I can work from within Mathematica, and at the same time this will increase the test suite for RLink. But I've never had the time alas :). Returning to your R code, this leads me to the question - why didn't you recode that one in Mathematica and post it? – Leonid Shifrin Feb 19 '13 at 20:44
  • That's not my code--I was helping the OP find the source of the code they were using. I don't think their code works as fully or completely as your solution either. BTW, I agree that R borrows many ideas from APL (and rather poorly and inconsistently, at that); I did not mean to suggest otherwise. (Sometime before MMA v. 1 came out I had been researching writing an APL interpreter for PCs: it's a fun language! I bet someone could implement that interpreter in about a page of MMA code now. :-) – whuber Feb 19 '13 at 23:59
  • @whuber Re:code - I see. I did not read your post carefully, just saw the code, sorry :-). Re: APL - it is on my wish list, but Lisp/Scheme/Closure and ML/Ocaml are higher on the list (and so far I did not manage to move along that list to any significant extent either :)). Also, when I come to it, I may as well start with J or K or Q, rather than APL proper. Pipe dreams, all of it :-) – Leonid Shifrin Feb 20 '13 at 00:43
18

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.

whuber
  • 20,544
  • 2
  • 59
  • 111