Finding local maxima and minima

前端 未结 14 1658
说谎
说谎 2020-11-22 07:24

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 exampl

14条回答
  •  粉色の甜心
    2020-11-22 08:17

    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)
    

提交回复
热议问题