# How to find local peaks/valleys in a series of data?

Here is my experiment:

I am using the findPeaks function in the quantmod package:

I want to detect "local" peaks within a tolerance 5, i.e. the first locations after the time series drops from the local peaks by 5:

aa=100:1
bb=sin(aa/3)
cc=aa*bb
plot(cc, type="l")
p=findPeaks(cc, 5)
points(p, cc[p])
p


The output is

[1] 3 22 41


It seems wrong, as I am expecting more "local peaks" than 3...

Any thoughts?

-
I don't have this package. Can you describe the numerical routine being used? – AdamO Feb 16 '12 at 17:36
The full source code for findPeaks appears in my reply, @Adam. BTW, the package is "quantmod". – whuber Feb 16 '12 at 19:02
Cross posted on R-SIG-Finance‌​. – Joshua Ulrich Feb 17 '12 at 13:12
Luna, it may be time to look back to earlier responses that were given to you, and start upvoting/accepting answers, no? – chl Feb 28 '12 at 21:43

The source of this code is obtained by typing its name at the R prompt. The output is

function (x, thresh = 0)
{
pks <- which(diff(sign(diff(x, na.pad = FALSE)), na.pad = FALSE) < 0) + 2
if (!missing(thresh)) {
pks[x[pks - 1] - x[pks] > thresh]
}
else pks
}


The test x[pks - 1] - x[pks] > thresh compares each peak value to the value immediately succeeding it in the series (not to the next trough in the series). It uses a (crude) estimate of the size of the slope of the function immediately after the peak and selects only those peaks where that slope exceeds thresh in size. In your case, only the first three peaks are sufficiently sharp to pass the test. You will detect all the peaks by using the default:

> findPeaks(cc)
[1]  3 22 41 59 78 96

-

I agree with whuber's response but just wanted to add that the "+2" portion of the code, which attempts to shift the index to match the newly found peak actually 'overshoots' and should be "+1". for instance in the example at hand we obtain:

> findPeaks(cc)
[1]  3 22 41 59 78 96


when we highlight these found peaks on a graph (bold red):

we see that they are consistently 1 point away from the actual peak.

consequenty

pks[x[pks - 1] - x[pks] > thresh]


should be pks[x[pks] - x[pks + 1] > thresh] or pks[x[pks] - x[pks - 1] > thresh]

BIG UPDATE

following my own quest to find an adequate peak finding function i wrote this:

find_peaks <- function (x, m = 3){
shape <- diff(sign(diff(x, na.pad = FALSE)))
pks <- sapply(which(shape < 0), FUN = function(i){
z <- i - m + 1
z <- ifelse(z > 0, z, 1)
w <- i + m + 1
w <- ifelse(w < length(x), w, length(x))
if(all(x[c(z : i, (i + 2) : w)] <= x[i + 1])) return(i + 1) else return(numeric(0))
})
pks <- unlist(pks)
pks
}


a 'peak' is defined as a local maxima with m points either side of it being smaller than it. hence, the bigger the parameter m, the more stringent is the peak funding procedure. so:

find_peaks(cc, m = 1)
[1]  2 21 40 58 77 95


the function can also be used to find local minima of any sequential vector x via find_peaks(-x).

-

Firstly: The algorithm also falsely calls a drop to the right of a flat plateau since sign(diff(x, na.pad = FALSE)) will be 0 then -1 so that its diff will also be -1. A simple fix is to ensure that the sign-diff preceding the negative entry is not zero but positive:

    n <- length(x)
dx.1 <- sign(diff(x, na.pad = FALSE))
pks <- which(diff(dx.1, na.pad = FALSE) < 0 & dx.1[-(n-1)] > 0) + 1


Second: The algorithm gives very local results, e.g. an 'up' followed by a 'down' in any run of three consecutive terms in the sequence. If one is interested instead in local maxima of a noised continuous function, then -- there are probably other better things out there, but this is my cheap and immediate solution

1. identify the peaks first using running average of 3 consecutive points to
smooth the data ever so slightly. Also employ the above mentioned control against flat then drop-off.
2. filter these candidates by comparing, for a loess-smoothed version, the average inside a window centered at each peak with the average of local terms outside.

"myfindPeaks" <-
function (x, thresh=0.05, span=0.25, lspan=0.05, noisey=TRUE)
{
n <- length(x)
y <- x
mu.y.loc <- y
if(noisey)
{
mu.y.loc <- (x[1:(n-2)] + x[2:(n-1)] + x[3:n])/3
mu.y.loc <- c(mu.y.loc[1], mu.y.loc, mu.y.loc[n-2])
}
y.loess <- loess(x~I(1:n), span=span)
y <- y.loess[[2]]
sig.y <- var(y.loess\$resid, na.rm=TRUE)^0.5
DX.1 <- sign(diff(mu.y.loc, na.pad = FALSE))
pks <- which(diff(DX.1, na.pad = FALSE) < 0 & DX.1[-(n-1)] > 0) + 1
out <- pks
if(noisey)
{
n.w <- floor(lspan*n/2)
out <- NULL
for(pk in pks)
{
inner <- (pk-n.w):(pk+n.w)
outer <- c((pk-2*n.w):(pk-n.w),(pk+2*n.w):(pk+n.w))
mu.y.outer <- mean(y[outer])
if(!is.na(mu.y.outer))
if (mean(y[inner])-mu.y.outer > thresh*sig.y) out <- c(out, pk)
}
}
out
}

-