寻找局部最大值和最小值

Question

我正在寻找一种计算有效的方法来查找R中大量数字的局部最大值/最小值。 希望没有for循环......

例如，如果我有一个像1 2 3 2 1 1 2 1这样的数据文件，我希望函数返回3和7，它们是局部最大值的位置。

Answer 1

diff(diff(x))（或diff(x,differences=2)：感谢@ZheyuanLi）基本上计算二阶导数的离散模拟，因此在局部最大值处应为负。下面的+1会考虑到diff的结果比输入向量短的事实。

编辑：在delta-x不是1的情况下添加了@ Tommy的修正...

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

我上面的建议（http://statweb.stanford.edu/~tibs/PPC/Rdist/）适用于数据嘈杂的情况。

Answer 2

@ Ben的解决方案很可爱。它不通过以下方式处理以下情况：

# 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

这是一个更强大（更慢，更丑陋）的版本：

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

Answer 3

使用动物园库函数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 

然后使用'coredata'为这些值拉取索引，其中'which.max'是表示局部最大值的“中心值”。显然，您可以使用which.min而不是which.max为本地最小值执行相同操作。

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

我假设你不想要起始值或结束值，但是如果你这样做，你可以在处理之前填充载体的末端，就像端粒在染色体上那样。

（我正在注意ppc软件包（用于进行质谱分析的“峰值概率对比”），因为在阅读@BenBolker上面的评论之前我没有意识到它的可用性，我认为添加这几个字会增加机会有兴趣的人会在搜索中看到这个。）

Answer 4

今天我对此进行了抨击。我知道你希望没有for循环，但我坚持使用apply函数。有点紧凑和快速，并允许阈值规范，所以你可以超过1。

功能：

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

要使用阈值可视化/播放，您可以运行以下代码：

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

Answer 5

提供了一些很好的解决方案，但这取决于您的需求。

只需diff(tt)即可返回差异。

您想要检测从增加值到减少值的时间。一种方法是由@Ben提供：

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

这里的问题是，这只会检测从严格增加到严格减少的变化。

稍微改变将允许峰值处的重复值（对于峰值的最后一次出现返回TRUE）：

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

然后，如果要在

的开头或结尾检测到最大值，您只需要正确填充正面和背面。

这是功能中包含的所有内容（包括发现山谷）：

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

Answer 6

回答@ 42-很棒，但我有一个用例，我不想使用zoo。使用dplyr和lag 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)

与rollapply解决方案类似，您可以分别通过lag / lead参数n和default控制窗口大小和边缘情况。< / p>

Answer 7

以下是 的解决方案：

@ Ben的解决方案

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

请在Tommy的帖子中查看案例！

@ Tommy的解决方案：

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

请注意：localMaxima和localMinima都不能在开始时处理重复的最大值/最小值！

Answer 8

我在以前的解决方案中找到工作位置时遇到了一些麻烦，想出了一种直接获取最小值和最大值的方法。下面的代码将执行此操作并绘制它，将最小值标记为绿色，最大值标记为红色。与which.max()函数不同，这将从数据帧中提取最小值/最大值的所有索引。在第一个diff()函数中添加零值，以说明每次使用该函数时丢失的减少的结果长度。将其插入最里面的diff()函数调用可以避免在逻辑表达式之外添加偏移量。这并不重要，但我觉得这是一种更清洁的方式。

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

Answer 9

在我正在研究的情况下，重复经常发生。因此，我实现了一个功能，可以找到第一个或最后一个极值（最小或最大）：

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

原始问题的答案是：

> 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

结果表明第二个最小值等于1，并且该值从索引5开始重复两次。因此，通过将此时间指示给函数以查找最后出现的局部极端，可以得到不同的结果：

> 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 

然后根据目标，可以在局部极值的第一个和最后一个值之间切换。 last = TRUE的第二个结果也可以从列“ Idx”和“ NB”之间的操作中获得...

最后，为了处理数据中的噪声，可以实施一项功能来消除低于给定阈值的波动。代码不公开，因为它超出了最初的问题。我将其包装在一个包中（主要是为了自动化测试过程），下面给出一个结果示例：

x_series %>% xtrem::locate_xtrem()

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

Answer 10

我们在这里看到了许多具有不同功能的不错的功能和想法。几乎所有例子的一个问题是效率。很多时候我们看到使用复杂的函数，比如 diff() 或 for()-loops，当涉及到大数据集时，它们会变得很慢。让我介绍一个我每天都在使用的高效函数，功能最少，但速度非常快：

局部极大值函数amax()

目的是检测实值向量中的所有局部最大值。 如果第一个元素 x[1] 是全局最大值，则忽略它， 因为没有关于前一个元素的信息。如果有 是高原，检测到第一个边缘。

@param x 数值向量

@return 返回局部最大值的索引。如果 x[1] = max，则 它被忽略。

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

Answer 11

我在其他地方发布了这个，但我认为这是一个有趣的方式。我不确定它的计算效率是多少，但它是解决问题的一种非常简洁的方法。

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

Answer 12

在pracma包中，使用

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

返回一个包含4列的矩阵。 第一列显示了当地的峰值。绝对值。 第二列是指数 第3和第4列是峰的起点和终点（可能有重叠点）。

有关详细信息，请参阅https://www.rdocumentation.org/packages/pracma/versions/1.9.9/topics/findpeaks。

一个警告：我在一系列非整数中使用它，并且峰值是一个指数太晚（对于所有峰值）并且我不知道为什么。所以我不得不手动删除＆＃34; 1＆＃34;从我的索引向量（没什么大不了的）。

Answer 13

该聚会迟到了，但这可能会让其他人感兴趣。如今，您可以使用[[ ]]包中的（内部）函数find_peaks。您可以使用ggpmisc，threshold和span参数对它进行参数化。由于strict软件包旨在用于ggpmisc，因此您可以使用ggplot2和{{1}直接绘制 minima 和 maxima }函数：

stat_peaks

Answer 14

查找局部最大值和最小值，以获得不太容易的序列，例如1 0 1 1 2 0 1 1 0 1 1 1 0 1我的最大位置为（1），5、7.5、11和（14），最小位置为2、6、9、13。

#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

Answer 15

TimothéePoisot的此功能在嘈杂的系列中很方便：

2009年5月3日
一种在向量中找到局部极值的算法
提起下：算法-标签：极值，时间序列-TimothéePoisot @ 6:46 pm

我花了一些时间寻找一种算法来查找局部极值 一个向量（时间序列）。我使用的解决方案是“遍历” 逐步大于1的向量，以便仅保留一个值，甚至 当值非常嘈杂时（请参见 发布）。

它是这样的：

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

Answer 16

对@BEN 提出的公式以及@TOMMY 提出的案例的增强（快速而简单的方法）：

以下递归公式处理任何情况：

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

现在，@Ben Bolker 提供的公式只需稍作改动即可使用：

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.