Finding Local Extremes
J - 19 char
Couldn't help it ;)
(}:#~0,0>2*/\2-/\])
Explanation follows:
2-/\]
- Over each pair of elements in the argument (each 2-item long infix), take the difference.2*/\
- Now over each pair of the new list, take the product.0>
- Test whether each result is less than 0. This only happens if the multiplicands had alternating signs, i.e. it doesn't happen if they had the same sign or either was zero.0,
- Declare that the first element isn't an extreme element.}:
- Cut off the last element, because that can't possibly be an extreme either.#~
- Use the true values on the right side to pick items from the list on the left side.
Usage:
(}:#~0,0>2*/\2-/\]) 1 2 1
2
(}:#~0,0>2*/\2-/\]) 0 1 0 1 0
1 0 1
(}:#~0,0>2*/\2-/\]) i.0 NB. i.0 is the empty list (empty result also)
(}:#~0,0>2*/\2-/\]) 3 4 4 4 2 5
2
Mathematica 66 58 51
Current Solution
Shortened thanks to a contribution by Calle.
Cases[Partition[#,3,1],{a_,b_,c_}/;(a-b) (b-c)<0⧴b]&
Partition[#,3,1]
finds the triples.
(a-b) (b-c)<0
is true if and only if b
is below a
, c
, or above a
,c
.
and looks at takes the signs of the differences. A local extreme will return either {-1,1}
or {1,-1}
.
Examples
Cases[Partition[#, 3, 1], {a_, b_, c_} /; (a - b) (b - c) < 0 :> b] &[{1, 2, 1}]
Cases[Partition[#, 3, 1], {a_, b_, c_} /; (a - b) (b - c) < 0 :> b] &[{0, 1, 0, 1, 0}]
Cases[Partition[#, 3, 1], {a_, b_, c_} /; (a - b) (b - c) < 0 :> b] &[{}]
Cases[Partition[#, 3, 1], {a_, b_, c_} /; (a - b) (b - c) < 0 :> b] &[{9, 10, 7, 6, 9, 0, 3, 3, 1, 10}]
{2}
{1, 0, 1}
{}
{10, 6, 9, 0, 1}
Earlier Solution
This looks examples all triples (generated by Partition
) and determines whether the middle element is less than both extremes or greater than the extremes.
Cases[Partition[#,3,1],{a_,b_,c_}/;(b<a∧b<c)∨(b>a∧b>c)⧴b]& ;
First Solution
This finds the triples, and looks at takes the signs of the differences. A local extreme will return either {-1,1}
or {1,-1}
.
Cases[Partition[#,3,1],x_/;Sort@Sign@Differences@x=={-1,1}⧴x[[2]]]&
Example
Cases[Partition[#,3,1],x_/;Sort@Sign@Differences@x=={-1,1}:>x[[2]]]&[{9, 10, 7, 6, 9, 0, 3, 3, 1, 10}]
{10, 6, 9, 0, 1}
Analysis:
Partition[{9, 10, 7, 6, 9, 0, 3, 3, 1, 10}]
{{9, 10, 7}, {10, 7, 6}, {7, 6, 9}, {6, 9, 0}, {9, 0, 3}, {0, 3, 3}, {3, 3, 1}, {3, 1, 10}}
%
refers to the result from the respective preceding line.
Differences/@ %
{{1, -3}, {-3, -1}, {-1, 3}, {3, -9}, {-9, 3}, {3, 0}, {0, -2}, {-2, 9}}
Sort@Sign@Differences@x=={-1,1}
identifies the triples from {{9, 10, 7}, {10, 7, 6}, {7, 6, 9}, {6, 9, 0}, {9, 0, 3}, {0, 3, 3}, {3, 3, 1}, {3, 1, 10}} such that the sign (-, 0, +) of the differences consists of a -1
and a 1
. In the present case those are:
{{9, 10, 7}, {7, 6, 9}, {6, 9, 0}, {9, 0, 3}, {3, 1, 10}}
For each of these cases, x, x[[2]]
refers to the second term. Those will be all of the local maxima and minima.
{10, 6, 9, 0, 1}
Javascript - 62 45 Characters
f=a=>a.filter((x,i)=>i&&i<a.length-1&&(a[i-1]-x)*(a[i+1]-x)>0)
Edit
f=a=>a.filter((x,i)=>(a[i-1]-x)*(a[i+1]-x)>0)