Finding local maxima and minima

Question

I'm looking for a computationally efficient way to find local maxima/minima for a large list of numbers in R. Hopefully without for loops...

For example, if I have a datafile like 1 2 3 2 1 1 2 1, I want the function to return 3 and 7, which are the positions of the local maxima.

Goldstone

Answer 1

diff(diff(x)) (or diff(x,differences=2): thanks to @ZheyuanLi) essentially computes the discrete analogue of the second derivative, so should be negative at local maxima. The +1 below takes care of the fact that the result of diff is shorter than the input vector.

edit: added @Tommy's correction for cases where delta-x is not 1...

tt <- c(1,2,3,2,1, 1, 2, 1)
which(diff(sign(diff(tt)))==-2)+1

My suggestion above ( http://statweb.stanford.edu/~tibs/PPC/Rdist/ ) is intended for the case where the data are noisier.

Emanuele

You beat me by a few seconds - and with a better solution :) But it should be which(diff(sign(diff(x)))==-2)+1 if the values aren't always changing by one. – Spicate

As Tommy had pointed out, Ben's solution also doesn't works when the input list is in increasing order. e.g. tt <- c(2,3,4,5,6,7) expected answer: index of last element of the list – Jaimeejaimes

The link ...ppc.peaks.html does not work, use statweb.stanford.edu/~tibs/PPC/Rdist instead. – Mediatory

@BenBolker Is this just for max or is this minima too? – Kirtley

you should change ==-2 to ==2 if you want to look for minima (or use abs() appropriately if you want to look for both) – Emanuele

Answer 2

@Ben's solution is pretty sweet. It doesn't handle the follwing cases though:

# all these return numeric(0):
x <- c(1,2,9,9,2,1,1,5,5,1) # duplicated points at maxima 
which(diff(sign(diff(x)))==-2)+1 
x <- c(2,2,9,9,2,1,1,5,5,1) # duplicated points at start
which(diff(sign(diff(x)))==-2)+1 
x <- c(3,2,9,9,2,1,1,5,5,1) # start is maxima
which(diff(sign(diff(x)))==-2)+1

Here's a more robust (and slower, uglier) version:

localMaxima <- function(x) {
  # Use -Inf instead if x is numeric (non-integer)
  y <- diff(c(-.Machine$integer.max, x)) > 0L
  rle(y)$lengths
  y <- cumsum(rle(y)$lengths)
  y <- y[seq.int(1L, length(y), 2L)]
  if (x[[1]] == x[[2]]) {
    y <- y[-1]
  }
  y
}

x <- c(1,2,9,9,2,1,1,5,5,1)
localMaxima(x) # 3, 8
x <- c(2,2,9,9,2,1,1,5,5,1)
localMaxima(x) # 3, 8
x <- c(3,2,9,9,2,1,1,5,5,1)
localMaxima(x) # 1, 3, 8

Spicate

thanks I tried this code, and it works! How do you modify this for local-minima without changing the input? – Doucette

Hi Tommy, I wanted to use your localMinima function in a package, could you please contact me so that I can properly acknowledge you? – Frazil

@VahidMir Basically this functions is a (smart!) way to get the positions where the first derivative of the vector switches from positive to negative. Hence the local-minima would be given where it switches from negative to positive: just replace the first line by y <- diff(c(.Machine$integer.max, x)) < 0L (this conserves the possibility to detect an initial minimum) – Carnes

good however localMaxima() false triggers on points of inflection localMaxima(c(1, 2, 2, 3, 2, 1)) returns 2 4 instead of just 4 – Meza

Why is rle(y)$lengths called twice? I mean I understand y <- cumsum(rle(y)$lengths) but not the preceding standalone rle(y)$lengths – Rebeca

Answer 3

Use the zoo library function rollapply:

x <- c(1, 2, 3, 2, 1, 1, 2, 1)
library(zoo)
 xz <- as.zoo(x)
 rollapply(xz, 3, function(x) which.min(x)==2)
#    2     3     4     5     6     7 
#FALSE FALSE FALSE  TRUE FALSE FALSE 
 rollapply(xz, 3, function(x) which.max(x)==2)
#    2     3     4     5     6     7 
#FALSE  TRUE FALSE FALSE FALSE  TRUE 

Then pull the index using the 'coredata' for those values where 'which.max' is a "center value" signaling a local maximum. You could obviously do the same for local minima using which.min instead of which.max.

 rxz <- rollapply(xz, 3, function(x) which.max(x)==2)
 index(rxz)[coredata(rxz)]
#[1] 3 7

I am assuming you do not want the starting or ending values, but if you do , you could pad the ends of your vectors before processing, rather like telomeres do on chromosomes.

(I'm noting the ppc package ("Peak Probability Contrasts" for doing mass spectrometry analyses, simply because I was unaware of its availability until reading @BenBolker's comment above, and I think adding these few words will increase the chances that someone with a mass-spec interest will see this on a search.)

Hialeah

This has a very significant advantage over the others. By increasing the interval to something larger than 3, we can ignore cases where one point happens to be very slightly higher than its two nearest neighbors even though there are other nearby points larger. This can be useful for measured data with small, random variations. – Heavyladen

Thanks for the comment, and thanks to dbaupp, and credit to @GGrothendieck and Achim Zeileis for writing zoo so cleanly that I am able to apply it cleanly. – Hialeah

This is a fantastic solution, but a word of warning: it is a good idea to explicitly define the align argument. zoo:::rollapply.zoo uses align = "center" by default, but xts:::rollapply.xts uses align = "right". – Threecornered

What does the "== 2" do in these examples? If i do not put this, I get numbers, but when I do, I get TRUE/FALSE – Nerte

@dleal, you roll a window of the width 3 over the array xz. The content of this window is the argument x of the function that returns index of the maximum. If this index points to the center of the window, then you are staying on the local maximum! In this particular case the window width is 3, so the middle element has index of 2. Basically, you are looking for a condition which.max(x) == m for a window with the width equal to 2*m–1. – Abert

Although interestingly, the suggestion by @42- fails in the cases when you have more repeating values than your width (e.g. 3). In other words a saddle point will mistaken for an extreme. A simple case is: x <- c(3, 2, 2, 2, 2, 1, 3), then rx <- rollapply(as.zoo(x), 3, function(x) {which.min(x)==2)}, and index(rx)[coredata(rx)] falsely gives [1] 2 6 (where it should have been [1] 6). – Tabriz

to add to @Heavyladen with data like this x <- c(1, 2, 3, 2, 3, 4, 5, 6, 6, 5 ,4, 3, 2) using an interval of 5 ( rxz <- rollapply(xz, 5, function(x) which.max(x)==2) ) the early noise glitch 3,2,3 is ignored but the plateau 6,6 is correctly detected – Meza

Answer 4

I took a stab at this today. I know you said hopefully without for loops but I stuck with using the apply function. Somewhat compact and fast and allows threshold specification so you can go greater than 1.

The function:

inflect <- function(x, threshold = 1){
  up   <- sapply(1:threshold, function(n) c(x[-(seq(n))], rep(NA, n)))
  down <-  sapply(-1:-threshold, function(n) c(rep(NA,abs(n)), x[-seq(length(x), length(x) - abs(n) + 1)]))
  a    <- cbind(x,up,down)
  list(minima = which(apply(a, 1, min) == a[,1]), maxima = which(apply(a, 1, max) == a[,1]))
}

To a visualize it/play with thresholds you can run the following code:

# Pick a desired threshold # to plot up to
n <- 2
# Generate Data
randomwalk <- 100 + cumsum(rnorm(50, 0.2, 1)) # climbs upwards most of the time
bottoms <- lapply(1:n, function(x) inflect(randomwalk, threshold = x)$minima)
tops <- lapply(1:n, function(x) inflect(randomwalk, threshold = x)$maxima)
# Color functions
cf.1 <- grDevices::colorRampPalette(c("pink","red"))
cf.2 <- grDevices::colorRampPalette(c("cyan","blue"))
plot(randomwalk, type = 'l', main = "Minima & Maxima\nVariable Thresholds")
for(i in 1:n){
  points(bottoms[[i]], randomwalk[bottoms[[i]]], pch = 16, col = cf.1(n)[i], cex = i/1.5)
}
for(i in 1:n){
  points(tops[[i]], randomwalk[tops[[i]]], pch = 16, col = cf.2(n)[i], cex = i/1.5)
}
legend("topleft", legend = c("Minima",1:n,"Maxima",1:n), 
       pch = rep(c(NA, rep(16,n)), 2), col = c(1, cf.1(n),1, cf.2(n)), 
       pt.cex =  c(rep(c(1, c(1:n) / 1.5), 2)), cex = .75, ncol = 2)

Pryor

My data has repeated values for maxima and minima e.g. c(1,2,3,3,2,1,1,2,3) and this generates multiple hits for each max/min. Experimenting with threshold only seems to change the dot size on the plot but doesn't fix this. Any suggestions? – Meza

Hi there, what exactly are you expecting to happen when values are tied? The function is treating them as if they are the same point -- to be ignored. On the top of a flat mountain, everywhere you walk is the peak, even if there is a crevice in the middle. What kind of data are you working with that has equal values? And by the way, the dots will vary differently if the adjacent heights are not identical. See vector c(0,0,0,1,0.7,3,2,3,3,2,1,1,2,3,0.7, 0.5,0,0,0) at threshold = 3 – Pryor

Answer 5

Late to the party, but this might be of interest for others. You can nowadays use the (internal) function find_peaks from ggpmisc package. You can parametrize it using threshold, span and strict arguments. Since ggpmisc package is aimed for using with ggplot2 you can directly plot minima and maxima using thestat_peaks and stat_valleys functions:

set.seed(1)
x <- 1:10
y <- runif(10)
# Maxima
x[ggpmisc:::find_peaks(y)]
[1] 4 7
y[ggpmisc:::find_peaks(y)]
[1] 0.9082078 0.9446753
# Minima
x[ggpmisc:::find_peaks(-y)]
[1] 5
y[ggpmisc:::find_peaks(-y)]
[1] 0.2016819    
# Plot
ggplot(data = data.frame(x, y), aes(x = x, y = y)) + geom_line() + stat_peaks(col = "red") + stat_valleys(col = "green")

Harbin

Thank you for this. But how do I make use of stat_peaks outside of a ggplot2 environment? – Visor

@Visor IMHO using stat_peaks outside of a ggplot2 environment doesn't make much sense. Since stat_peaks is aimed at being used inside a ggplot call. On the other hand, the first part of my answer does work anywhere. Calculating Minima and Maxima using ggpmisc:::find_peaks is universal.. – Harbin

Answer 6

There are some good solutions provided, but it depends on what you need.

Just diff(tt) returns the differences.

You want to detect when you go from increasing values to decreasing values. One way to do this is provided by @Ben:

 diff(sign(diff(tt)))==-2

The problem here is that this will only detect changes that go immediately from strictly increasing to strictly decreasing.

A slight change will allow for repeated values at the peak (returning TRUE for last occurence of the peak value):

 diff(diff(x)>=0)<0

Then, you simply need to properly pad the front and back if you want to detect maxima at the beginning or end of

Here's everything wrapped in a function (including finding of valleys):

 which.peaks <- function(x,partial=TRUE,decreasing=FALSE){
     if (decreasing){
         if (partial){
             which(diff(c(FALSE,diff(x)>0,TRUE))>0)
         }else {
             which(diff(diff(x)>0)>0)+1
         }
     }else {
         if (partial){
             which(diff(c(TRUE,diff(x)>=0,FALSE))<0)
         }else {
             which(diff(diff(x)>=0)<0)+1
         }
     }
 }

Warmedover

FAO future visitors, I tried a few of the suggested solutions here and this worked best for me. – Meza

Answer 7

Answer by @42- is great, but I had a use case where I didn't want to use zoo. It's easy to implement this with dplyr using lag and lead:

library(dplyr)
test = data_frame(x = sample(1:10, 20, replace = TRUE))
mutate(test, local.minima = if_else(lag(x) > x & lead(x) > x, TRUE, FALSE)

Like the rollapply solution, you can control the window size and edge cases through the lag/lead arguments n and default, respectively.

Threecornered

A difference between this solution and the rollapply solution occurs when the window is larger than 1. Let's say we want to look within 3 positions in either direction. With the rollapply solution, we can look at 7 values, and it will tell us if the middle one is the minima. In this solution, using if_else(lag(x, 3) > x & lead(x, 3) > x would only look at the third position away, not 1 and 2 as well. I like the idea of using a dplyr solution, but writing out 6 & conditions seems a bit tedious – Jitters

See my answer for a solution that builds on this – Jitters

Answer 8

In the case I'm working on, duplicates are frequent. So I have implemented a function that allows finding first or last extrema (min or max):

locate_xtrem <- function (x, last = FALSE)
{
  # use rle to deal with duplicates
  x_rle <- rle(x)

  # force the first value to be identified as an extrema
  first_value <- x_rle$values[1] - x_rle$values[2]

  # differentiate the series, keep only the sign, and use 'rle' function to
  # locate increase or decrease concerning multiple successive values.
  # The result values is a series of (only) -1 and 1.
  #
  # ! NOTE: with this method, last value will be considered as an extrema
  diff_sign_rle <- c(first_value, diff(x_rle$values)) %>% sign() %>% rle()

  # this vector will be used to get the initial positions
  diff_idx <- cumsum(diff_sign_rle$lengths)

  # find min and max
  diff_min <- diff_idx[diff_sign_rle$values < 0]
  diff_max <- diff_idx[diff_sign_rle$values > 0]

  # get the min and max indexes in the original series
  x_idx <- cumsum(x_rle$lengths)
  if (last) {
    min <- x_idx[diff_min]
    max <- x_idx[diff_max]
  } else {
    min <- x_idx[diff_min] - x_rle$lengths[diff_min] + 1
    max <- x_idx[diff_max] - x_rle$lengths[diff_max] + 1
  }
  # just get number of occurences
  min_nb <- x_rle$lengths[diff_min]
  max_nb <- x_rle$lengths[diff_max]

  # format the result as a tibble
  bind_rows(
    tibble(Idx = min, Values = x[min], NB = min_nb, Status = "min"),
    tibble(Idx = max, Values = x[max], NB = max_nb, Status = "max")) %>%
    arrange(.data$Idx) %>%
    mutate(Last = last) %>%
    mutate_at(vars(.data$Idx, .data$NB), as.integer)
}

The answer to the original question is:

> x <- c(1, 2, 3, 2, 1, 1, 2, 1)
> locate_xtrem(x)
# A tibble: 5 x 5
    Idx Values    NB Status Last 
  <int>  <dbl> <int> <chr>  <lgl>
1     1      1     1 min    FALSE
2     3      3     1 max    FALSE
3     5      1     2 min    FALSE
4     7      2     1 max    FALSE
5     8      1     1 min    FALSE

The result indicates that the second minimum is equal to 1 and that this value is repeated twice starting at index 5. Therefore, a different result could be obtained by indicating this time to the function to find the last occurrences of local extremas:

> locate_xtrem(x, last = TRUE)
# A tibble: 5 x 5
    Idx Values    NB Status Last 
  <int>  <dbl> <int> <chr>  <lgl>
1     1      1     1 min    TRUE 
2     3      3     1 max    TRUE 
3     6      1     2 min    TRUE 
4     7      2     1 max    TRUE 
5     8      1     1 min    TRUE 

Depending on the objective, it is then possible to switch between the first and the last value of a local extremas. The second result with last = TRUE could also be obtained from an operation between columns "Idx" and "NB"...

Finally to deal with noise in the data, a function could be implemented to remove fluctuations below a given threshold. Code is not exposed since it goes beyond the initial question. I have wrapped it in a package (mainly to automate the testing process) and I give below a result example:

x_series %>% xtrem::locate_xtrem()

x_series %>% xtrem::locate_xtrem() %>% remove_noise()

Nonalcoholic

Nice! I had a cumulative value graph, and as such had flat ranges. Yours is the only solution here that worked. Would be nice to have included the plotting code too. – Lorettalorette

This is an awesome function! Being able to control first vs last within a sequence of duplicates is very handy. – Fiord

Answer 9

This function by Timothée Poisot is handy for noisy series:

May 3, 2009
An Algorithm To Find Local Extrema In A Vector
Filed under: Algorithm — Tags: Extrema, Time series — Timothée Poisot @ 6:46pm

I spend some time looking for an algorithm to find local extrema in a vector (time series). The solution I used is to “walk” through the vector by step larger than 1, in order to retain only one value even when the values are very noisy (see the picture at the end of the post).

It goes like this :

findpeaks <- function(vec,bw=1,x.coo=c(1:length(vec)))
{
    pos.x.max <- NULL
    pos.y.max <- NULL
    pos.x.min <- NULL
    pos.y.min <- NULL   for(i in 1:(length(vec)-1))     {       if((i+1+bw)>length(vec)){
                sup.stop <- length(vec)}else{sup.stop <- i+1+bw
                }
        if((i-bw)<1){inf.stop <- 1}else{inf.stop <- i-bw}
        subset.sup <- vec[(i+1):sup.stop]
        subset.inf <- vec[inf.stop:(i-1)]

        is.max   <- sum(subset.inf > vec[i]) == 0
        is.nomin <- sum(subset.sup > vec[i]) == 0

        no.max   <- sum(subset.inf > vec[i]) == length(subset.inf)
        no.nomin <- sum(subset.sup > vec[i]) == length(subset.sup)

        if(is.max & is.nomin){
            pos.x.max <- c(pos.x.max,x.coo[i])
            pos.y.max <- c(pos.y.max,vec[i])
        }
        if(no.max & no.nomin){
            pos.x.min <- c(pos.x.min,x.coo[i])
            pos.y.min <- c(pos.y.min,vec[i])
        }
    }
    return(list(pos.x.max,pos.y.max,pos.x.min,pos.y.min))
}

Link to original blog post

Coggins

I like that function. It gives a nice way to determine envelopes. – Overhaul

Answer 10

Here's the solution for minima:

@Ben's solution

x <- c(1,2,3,2,1,2,1)
which(diff(sign(diff(x)))==+2)+1 # 5

Please regard the cases at Tommy's post!

@Tommy's solution:

localMinima <- function(x) {
  # Use -Inf instead if x is numeric (non-integer)
  y <- diff(c(.Machine$integer.max, x)) > 0L
  rle(y)$lengths
  y <- cumsum(rle(y)$lengths)
  y <- y[seq.int(1L, length(y), 2L)]
  if (x[[1]] == x[[2]]) {
    y <- y[-1]
  }
  y
}

x <- c(1,2,9,9,2,1,1,5,5,1)
localMinima(x) # 1, 7, 10
x <- c(2,2,9,9,2,1,1,5,5,1)
localMinima(x) # 7, 10
x <- c(3,2,9,9,2,1,1,5,5,1)
localMinima(x) # 2, 7, 10

Please regard: Neither localMaxima nor localMinima can handle duplicated maxima/minima at start!

Soursop

Not sure what your answer really brings to the table given other answers include same algorithms. – Revels

True, but it gives a solution for minima, such as originally asked. Plus the case of duplicated maxima/minima at start was not mentioned yet. – Soursop

Well... I can't argue with that even if it's basically the same answer. So I won't downvote but not upvote either. You should try answering question not already answered (even if this one is not officially answered, the fact that the top 2 answer have 18 and 20 votes makes it the same). – Revels

By the way, I could need help finding a way to adapt the function for maxima/minima with bigger intervalls, so 'delta x > 1'. Anyone an idea? – Soursop

@Soursop if not seen already, please see my answer for bigger intervals. – Pryor

Answer 11

I had some trouble getting the locations to work in previous solutions and came up with a way to grab the minima and maxima directly. The code below will do this and will plot it, marking the minima in green and the maxima in red. Unlike the which.max() function this will pull all indices of the minima/maxima out of a data frame. The zero value is added in the first diff() function to account for the missing decreased length of the result that occurs whenever you use the function. Inserting this into the innermost diff() function call saves from having to add an offset outside of the logical expression. It doesn't matter much, but i feel it's a cleaner way to do it.

# create example data called stockData
stockData = data.frame(x = 1:30, y=rnorm(30,7))

# get the location of the minima/maxima. note the added zero offsets  
# the location to get the correct indices
min_indexes = which(diff(  sign(diff( c(0,stockData$y)))) == 2)
max_indexes = which(diff(  sign(diff( c(0,stockData$y)))) == -2)

# get the actual values where the minima/maxima are located
min_locs = stockData[min_indexes,]
max_locs = stockData[max_indexes,]

# plot the data and mark minima with red and maxima with green
plot(stockData$y, type="l")
points( min_locs, col="red", pch=19, cex=1  )
points( max_locs, col="green", pch=19, cex=1  )

Permeance

Almost very nice - it doesn't seem to work with a maximum at the end> histData$counts [1] 18000 0 0 0 0 0 0 0 0 0 0 0 [217] 0 0 0 0 0 0 0 0 5992 – Junette

max_indexes = sign(diff( c(0,histData$counts,0)))) works though but I don't know if it breaks anything else. – Junette

@idontgetoutmuch... the method essentially uses first derivative calculations of the data and won't find a relative maxima or minima at an endpoint of the series being evaluated. it would work for the second to last value of the series if that was a relative max/min because the derivative can be approximated there. if you are looking for the max in a series the max() function should work fine. combining that with the code above should get you the info you need on max/mins. – Permeance

i should have been more clear on the first sentence of my comment above... the method essentially uses first derivative approximations of the data and won't find a relative maxima or minima at an endpoint of the series being evaluated because there is no way to know if the endpoints are relative max/mins. – Permeance

Answer 12

In the pracma package, use the

tt <- c(1,2,3,2,1, 1, 2, 1)
tt_peaks <- findpeaks(tt, zero = "0", peakpat = NULL,
       minpeakheight = -Inf, minpeakdistance = 1, threshold = 0, npeaks = 0, sortstr = FALSE)

  [,1] [,2] [,3] [,4]
  [1,]  3    3    1    5
  [2,]  2    7    6    8

That returns a matrix with 4 columns. The first column is showing the local peaks' absolute values. The 2nd column are the indices The 3rd and 4th column are the start and end of the peaks (with potential overlap).

See https://www.rdocumentation.org/packages/pracma/versions/1.9.9/topics/findpeaks for details.

One caveat: I used it in a series of non-integers, and the peak was one index too late (for all peaks) and I do not know why. So I had to manually remove "1" from my index vector (no big deal).

Almagest

Answer 13

Finding local maxima and minima for a not so easy sequence e.g. 1 0 1 1 2 0 1 1 0 1 1 1 0 1 I would give their positions at (1), 5, 7.5, 11 and (14) for maxima and 2, 6, 9, 13 for minima.

#Position                1 1 1 1 1
#      1 2 3 4 5 6 7 8 9 0 1 2 3 4
x <- c(1,0,1,1,2,0,1,1,0,1,1,1,0,1) #Frequency
#      p v     p v  p  v   p   v p  p..Peak, v..Valey

peakPosition <- function(x, inclBorders=TRUE) {
  if(inclBorders) {y <- c(min(x), x, min(x))
  } else {y <- c(x[1], x)}
  y <- data.frame(x=sign(diff(y)), i=1:(length(y)-1))
  y <- y[y$x!=0,]
  idx <- diff(y$x)<0
  (y$i[c(idx,F)] + y$i[c(F,idx)] - 1)/2
}

#Find Peaks
peakPosition(x)
#1.0  5.0  7.5 11.0 14.0

#Find Valeys
peakPosition(-x)
#2  6  9 13

peakPosition(c(1,2,3,2,1,1,2,1)) #3 7

Clave

Answer 14

We see many nice functions and ideas with different features here. One issue of almost all examples is the efficiency. Many times we see the use of complex functions like diff() or for()-loops, which become slow when large data sets are involved. Let me introduce an efficient function I use every day, with minimal features, but very fast:

Local Maxima Function amax()

The purpose is to detect all local maxima in a real valued vector. If the first element x[1] is the global maximum, it is ignored, because there is no information about the previous emlement. If there is a plateau, the first edge is detected.

@param x numeric vector

@return returns the indicies of local maxima. If x[1] = max, then it is ignored.

amax <- function(x)
{
  a1 <- c(0,x,0)
  a2 <- c(x,0,0)
  a3 <- c(0,0,x)
  e <- which((a1 >= a2 & a1 > a3)[2:(length(x))])
  if(!is.na(e[1] == 1))
    if(e[1]==1)
      e <- e[-1]
  if(length(e) == 0) e <- NaN
  return (e)
}

a <- c(1,2,3,2,1,5,5,4)
amax(a) # 3, 6

Overhaul

Answer 15

I posted this elsewhere, but I think this is an interesting way to go about it. I'm not sure what its computational efficiency is, but it's a very concise way of solving the problem.

vals=rbinom(1000,20,0.5)

text=paste0(substr(format(diff(vals),scientific=TRUE),1,1),collapse="")

sort(na.omit(c(gregexpr('[ ]-',text)[[1]]+1,ifelse(grepl('^-',text),1,NA),
 ifelse(grepl('[^-]$',text),length(vals),NA))))

Doth

Concise but obfuscated is generally not as useful, unless it's a huge corporation that needs extreme efficiency or a contest where you need to be as unclear as possible :) Care to explain the code or the main gist? Just dumping this weird (and unreadable - why not add some spacing?) code on us like that won't result in people trying to use it – Deipnosophist

This is more inefficient than other methods, but it still works. I think this would fall into the contest that needs to be unclear. The general idea is that you convert the differences in code to text and take the first character of it, which is either a space if it's positive or a - if it's negative. If you see a - - pattern (or a space at either endpoint) you have found a maximum. I tried this on Linux, and I used substr(...,2,2) instead of substr(...,1,1) since there's a leading space to the text. Regular expressions are not ideal for this problem, but it's a fun solution. – Doth

Answer 16

An enhancement (fast and simple method) to the formula proposed by @BEN and regarding to the cases proposed by @TOMMY:

the following recursive formula handle any cases:

dx=c(0,sign(diff(x)))
numberofzeros= length(dx) - sum(abs(dx)) -1 # to find the number of zeros 
                                            # in the dx minus the first one 
                                            # which is added intentionally.
#running recursive formula to clear middle zeros 
# iterate for the number of zeros   
for (i in 1:numberofzeros){ 
    dx = sign(2*dx + c(0,rev(sign(diff(rev(dx))))))
    }

Now, the formula provided by @Ben Bolker can be used with a little change:

plot(x)
points(which(diff(dx)==2),x[which(diff(dx)==2)],col = 'blue')#Local MIN.
points(which(diff(dx)==-2),x[which(diff(dx)==-2)],col = 'red')#Local MAX.

Mantilla

Answer 17

I liked @mikeck's solution so that I wouldn't have to convert my dataframes back and forth from a zoo object. But I also wanted to use a window wider than 1. Their solution only looks at the xth value away from the value of interest, not the values within x distance. Here is what I came up with. You would need to add an extra lag/lead line for every value away from the value of interest that you want to look.

x <- data.frame(AIC = c(98, 97, 96, 97, 98, 99, 98, 98, 97, 96, 95, 94, 93, 92, 93, 94, 95, 96, 95, 94, 93, 92, 91, 90, 89, 88))

x <- x %>%
  mutate(local.minima = if_else(lag(AIC) > AIC & lead(AIC) > AIC & 
                                  lag(AIC, 2) > AIC & lead(AIC, 2) > AIC &
                                  lag(AIC, 3) > AIC & lead(AIC, 3) > AIC, TRUE, FALSE),
         local.minima = if_else(is.na(local.minima), TRUE, local.minima))

Jitters