Существует ли алгоритм R для нахождения локальных экстремумов (пиков)?

Question

В настоящее время я работаю с данными, которые содержат 4 переменные. Я использую только один на данный момент. Эта переменная содержит низкие и высокие значения.

Я хотел бы извлечь все значения, которые представляют пик. Тогда я мог бы изучить их изменчивость (облако точек).

Вот график моих исходных данных (он представляет 300 первых значений):

Вот другой цикл, который перекрывает цикл:

Вот значения, которые я хотел бы извлечь (я не окружил все значения):

Первые 300 значений:

c(0.096, 0.088, 0.082, 0.078, 0.06, 0.057, 0.048, 0.047, 0.044,
0.044, 0.039, 0.038, 0.037, 0.037, 0.035, 0.035, 0.034, 0.034,
0.033, 0.033, 0.032, 0.032, 0.031, 0.031, 0.031, 0.031, 0.03,
0.03, 0.03, 0.03, 0.03, 0.029, 0.029, 0.029, 0.029, 0.2, 1100,
1100, 27, 15, 3.2, 2.2, 1, 0.65, 0.37, 0.3, 0.19, 0.16, 0.12,
0.12, 0.099, 0.096, 0.085, 0.082, 0.064, 0.06, 0.051, 0.05, 0.046,
0.045, 0.041, 0.041, 0.039, 0.038, 0.037, 0.036, 0.035, 0.035,
0.034, 0.033, 0.032, 0.032, 0.032, 0.031, 0.031, 0.031, 0.03,
0.03, 0.03, 0.03, 0.029, 0.029, 0.029, 0.029, 0.029, 0.028, 0.028,
0.028, 4.4, 1100, 1100, 120, 21, 9.4, 3.1, 1.6, 0.85, 0.51, 0.33,
0.23, 0.18, 0.18, 0.13, 0.11, 0.1, 0.092, 0.085, 0.077, 0.065,
0.058, 0.053, 0.05, 0.047, 0.045, 0.043, 0.042, 0.039, 0.038,
0.037, 0.036, 0.035, 0.035, 0.034, 0.033, 0.033, 0.032, 0.031,
0.031, 0.031, 0.03, 0.03, 0.03, 0.029, 0.029, 0.029, 0.029, 0.028,
0.028, 0.028, 0.028, 0.028, 37, 1100, 98, 17, 6.2, 2.7, 1.3,
1, 0.47, 0.31, 0.23, 0.16, 0.14, 0.11, 0.1, 0.093, 0.087, 0.079,
0.066, 0.057, 0.053, 0.049, 0.046, 0.044, 0.041, 0.04, 0.037,
0.036, 0.035, 0.035, 0.033, 0.033, 0.032, 0.032, 0.031, 0.031,
0.03, 0.03, 0.029, 0.029, 0.029, 0.029, 0.028, 0.028, 0.028,
0.027, 0.027, 0.027, 0.026, 0.026, 0.026, 2.6, 1100, 1100, 190,
22, 7.8, 3.2, 2.2, 0.91, 0.51, 0.37, 0.23, 0.18, 0.14, 0.12,
0.11, 0.098, 0.09, 0.085, 0.071, 0.061, 0.055, 0.051, 0.049,
0.045, 0.043, 0.04, 0.039, 0.037, 0.036, 0.035, 0.034, 0.033,
0.032, 0.032, 0.031, 0.031, 0.03, 0.03, 0.03, 0.029, 0.029, 0.028,
0.028, 0.028, 0.027, 0.027, 0.027, 0.026, 0.026, 0.026, 0.026,
0.026, 8.8, 1100, 160, 21, 7.5, 3.4, 1.6, 0.89, 0.52, 0.33, 0.23,
0.17, 0.14, 0.13, 0.1, 0.094, 0.087, 0.078, 0.065, 0.056, 0.051,
0.049, 0.045, 0.043, 0.039, 0.039, 0.036, 0.035, 0.034, 0.033,
0.032, 0.032, 0.031, 0.03, 0.03, 0.03, 0.029, 0.029, 0.028, 0.028,
0.027, 0.027, 0.026, 0.026, 0.026, 0.026, 0.025, 0.025, 0.025,
0.025, 0.025, 0.025, 13, 1100, 170)

Я прошу прощения за то, что я не идеален в английском языке.

Спасибо.

Answer 1

взгляните на пакет ggpmisc (https://github.com/cran/ggpmisc).

функция, которую вы ищете: ggpmisc::stat_peaks

library(ggplot2)
library(ggpmisc)
#> For news about 'ggpmisc', please, see https://www.r4photobiology.info/

ggplot(lynx, as.numeric = FALSE) + geom_line() + 
  stat_peaks(colour = "red") +
  stat_peaks(geom = "text", colour = "red", angle = 66,
             hjust = -0.1, x.label.fmt = "%Y") +
  expand_limits(y = 8000)

^{Создано в 2019-04-30 пакетом представ. (v0.2.1)}

Answer 2

Мой ответ основан на https://rtricks.wordpress.com/2009/05/03/an-algorithm-to-find-local-extrema-in-a-vector/ Вы можете использовать эту функцию, как показано ниже.Измените параметр bw по мере необходимости.Если у вас есть соответствующие координаты x, используйте аргумент x.coo.

y <- c(0.096, 0.088, 0.082, 0.078, 0.06, 0.057, 0.048, 0.047, 0.044,
       0.044, 0.039, 0.038, 0.037, 0.037, 0.035, 0.035, 0.034, 0.034,
       0.033, 0.033, 0.032, 0.032, 0.031, 0.031, 0.031, 0.031, 0.03,
       0.03, 0.03, 0.03, 0.03, 0.029, 0.029, 0.029, 0.029, 0.2, 1100,
       1100, 27, 15, 3.2, 2.2, 1, 0.65, 0.37, 0.3, 0.19, 0.16, 0.12,
       0.12, 0.099, 0.096, 0.085, 0.082, 0.064, 0.06, 0.051, 0.05, 0.046,
       0.045, 0.041, 0.041, 0.039, 0.038, 0.037, 0.036, 0.035, 0.035,
       0.034, 0.033, 0.032, 0.032, 0.032, 0.031, 0.031, 0.031, 0.03,
       0.03, 0.03, 0.03, 0.029, 0.029, 0.029, 0.029, 0.029, 0.028, 0.028,
       0.028, 4.4, 1100, 1100, 120, 21, 9.4, 3.1, 1.6, 0.85, 0.51, 0.33,
       0.23, 0.18, 0.18, 0.13, 0.11, 0.1, 0.092, 0.085, 0.077, 0.065,
       0.058, 0.053, 0.05, 0.047, 0.045, 0.043, 0.042, 0.039, 0.038,
       0.037, 0.036, 0.035, 0.035, 0.034, 0.033, 0.033, 0.032, 0.031,
       0.031, 0.031, 0.03, 0.03, 0.03, 0.029, 0.029, 0.029, 0.029, 0.028,
       0.028, 0.028, 0.028, 0.028, 37, 1100, 98, 17, 6.2, 2.7, 1.3,
       1, 0.47, 0.31, 0.23, 0.16, 0.14, 0.11, 0.1, 0.093, 0.087, 0.079,
       0.066, 0.057, 0.053, 0.049, 0.046, 0.044, 0.041, 0.04, 0.037,
       0.036, 0.035, 0.035, 0.033, 0.033, 0.032, 0.032, 0.031, 0.031,
       0.03, 0.03, 0.029, 0.029, 0.029, 0.029, 0.028, 0.028, 0.028,
       0.027, 0.027, 0.027, 0.026, 0.026, 0.026, 2.6, 1100, 1100, 190,
       22, 7.8, 3.2, 2.2, 0.91, 0.51, 0.37, 0.23, 0.18, 0.14, 0.12,
       0.11, 0.098, 0.09, 0.085, 0.071, 0.061, 0.055, 0.051, 0.049,
       0.045, 0.043, 0.04, 0.039, 0.037, 0.036, 0.035, 0.034, 0.033,
       0.032, 0.032, 0.031, 0.031, 0.03, 0.03, 0.03, 0.029, 0.029, 0.028,
       0.028, 0.028, 0.027, 0.027, 0.027, 0.026, 0.026, 0.026, 0.026,
       0.026, 8.8, 1100, 160, 21, 7.5, 3.4, 1.6, 0.89, 0.52, 0.33, 0.23,
       0.17, 0.14, 0.13, 0.1, 0.094, 0.087, 0.078, 0.065, 0.056, 0.051,
       0.049, 0.045, 0.043, 0.039, 0.039, 0.036, 0.035, 0.034, 0.033,
       0.032, 0.032, 0.031, 0.03, 0.03, 0.03, 0.029, 0.029, 0.028, 0.028,
       0.027, 0.027, 0.026, 0.026, 0.026, 0.026, 0.025, 0.025, 0.025,
       0.025, 0.025, 0.025, 13, 1100, 170)


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))
}

ex <- findpeaks(y,bw=10) # Vary bw till you get the results you expect
plot(y,type = 'l')
lines(ex[[1]],ex[[2]])

^{Создан в 2019-05-13 пакетом представ. (v0.2.1)}