24
$\begingroup$

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
$\endgroup$
6
  • 2
    $\begingroup$ Welcome to the site! You usually get better answers here if you show some effort. What have you tried? $\endgroup$ Feb 19, 2013 at 12:53
  • 3
    $\begingroup$ That semicolon at the end of ListLinePlot[testdata]; isn't useful. See mathematica.stackexchange.com/a/18617/61 $\endgroup$
    – cormullion
    Feb 19, 2013 at 13:03
  • 2
    $\begingroup$ This question may give you some ideas mathematica.stackexchange.com/questions/5575/… $\endgroup$ Feb 19, 2013 at 13:31
  • $\begingroup$ 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. $\endgroup$
    – whuber
    Feb 19, 2013 at 18:53
  • 1
    $\begingroup$ @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. $\endgroup$
    – whuber
    Feb 20, 2013 at 16:37

4 Answers 4

32
$\begingroup$

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

$\endgroup$
5
  • 2
    $\begingroup$ 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? $\endgroup$
    – partial81
    Feb 19, 2013 at 15:25
  • $\begingroup$ @partial81 Yes, this is functionality introduced in version 9. I've added a note to this effect. $\endgroup$
    – cormullion
    Feb 19, 2013 at 15:29
  • $\begingroup$ 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? $\endgroup$
    – partial81
    Feb 19, 2013 at 15:33
  • $\begingroup$ @partial81 sorry, I haven't a clue... :( $\endgroup$
    – cormullion
    Feb 19, 2013 at 15:44
  • $\begingroup$ @cormullion: no problem. One more reason to get Mathematica 9! Thanks for posting this nice solution! $\endgroup$
    – partial81
    Feb 19, 2013 at 18:27
23
$\begingroup$

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

$\endgroup$
0
19
$\begingroup$

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.

$\endgroup$
13
  • $\begingroup$ Would you care to benchmark vs. the MinDetect/MaxDetect solution by @cormullion? $\endgroup$
    – Yves Klett
    Feb 19, 2013 at 15:53
  • 1
    $\begingroup$ @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. $\endgroup$ Feb 19, 2013 at 16:22
  • 1
    $\begingroup$ @YvesKlett I added a benchmark to my post. $\endgroup$ Feb 19, 2013 at 16:33
  • 2
    $\begingroup$ @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. $\endgroup$ Feb 19, 2013 at 20:07
  • 1
    $\begingroup$ 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. :-) $\endgroup$
    – whuber
    Feb 19, 2013 at 20:35
18
$\begingroup$

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.

$\endgroup$
4
  • $\begingroup$ That is an intriguing method. I could find use for it, +1. $\endgroup$
    – rcollyer
    Feb 19, 2013 at 20:57
  • $\begingroup$ The Function is cool!!! Thanks a lot :) $\endgroup$
    – Darren Lee
    Feb 20, 2013 at 7:26
  • $\begingroup$ Great! Thanks for posting this solution! $\endgroup$
    – partial81
    Feb 20, 2013 at 14:14
  • 1
    $\begingroup$ Used it here mathematica.stackexchange.com/a/19919/193 $\endgroup$ Feb 21, 2013 at 13:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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