Нахождение локальных максимумов и минимумов в R

Question

Я пытаюсь создать функцию, чтобы найти "максимумы" и "минимумы". У меня есть следующие данные:

  y
  157
  144
   80
  106
  124
   46
  207
  188
  190
  208
  143
  170
  162
  178
  155
  163
  162
  149
  135
  160
  149
  147
  133
  146
  126
  120
  151
   74
  122
  145
  160
  155
  173
  126
  172
   93

Я пробовал эту функцию, чтобы найти "максимумы"

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
}

maks <- localMaxima(x)

И функция найти "минимумы"

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
    }

    mins <- localMinima(x)

И результат не на 100% прав

maks = 1  5  7 10 12 14 16 20 24 27 31 33 35
mins = 3  6  8 11 13 15 19 23 26 28 32 34 36

Результат должен

maks = 5  7 10 12 14 16 20 24 27 31 33 35
mins = 3  6  8 11 13 15 19 23 26 28 32 34

Поиск локальных максимумов и минимумов в R близок, но не совсем подходит.

Как я могу это исправить?

Большое вам спасибо

Answer 1

Вы можете определить две функции, подобные приведенным ниже, которые создают нужные вам векторы:

library(data.table)
#shift lags or leads a vector by a certain amount defined as the second argument
#the default is to lag a vector.
#The rationale behind the below code is that each local minimum's adjucent
#values will be greater than itself. The opposite is true for a local 
#maximum. I think this is what you are trying to achieve and one way to do 
#it is the following code
maximums <- function(x) which(x - shift(x, 1) > 0  & x - shift(x, 1, type='lead') > 0)
minimums <- function(x) which(x - shift(x, 1) < 0  & x - shift(x, 1, type='lead') < 0)

Выход:

> maximums(y)
 [1]  5  7 10 12 14 16 20 24 27 31 33 35
> minimums(y)
 [1]  3  6  8 11 13 15 19 23 26 28 32 34

Answer 2

Это функция, которую я написал некоторое время назад (и она более общая, чем вам нужно). он находит пики в последовательных данных xгде я определяю пик как локальные максимумы с m указывает на любую сторону этого, имеющую более низкое значение, чем это (так больше m приводит к более строгим критериям нахождения пиков):

 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
}

так что для вашего случая m = 1:

 find_peaks(x, m = 1)
 #[1]  5  7 10 12 14 16 20 24 27 31 33 35

и для минимумов:

 find_peaks(-x, m = 1)
 #[1]  3  6  8 11 13 15 19 23 26 28 32 34