I'm looking for a function that will do simple hill climbing on a vector, from a starting point that I provide. More formally: given a vector like y <- c(1,2,3,1,1)
, I want a function hill(y, x0)
such that hill(y, 1) == 3
(climbing from left gets to the top) and hill(y, 5) == 5
(it moves left and right, but discovering it's on a plateau, just returns the starting value). I have trouble believing this doesn't exist, but haven't been able to find it so far. Anyone got a lead?
Here's a recursive solution, from https://gist.github.com/3000200. Tests elided for brevity.
climb <- function(y, x0) {
x <- index(y)
n <- length(y)
if (n == 0) { return(NA) }
if (x0 < min(x) | x0 > max(x)) {
warning(sprintf("x0 of %f lies outside data range [%f, %f]", x0, min(x), max(x)))
}
# TODO: beautify this.
w <- which.min(abs(as.numeric(x - x0)))
i <- x[w]
ii <- index(x)[w] # 1-based index
l <- x[ii-1]
r <- x[ii+1]
yl <- if (ii == 1) { -Inf } else { as.numeric(y[l]) }
yr <- if (ii == n) { -Inf } else { as.numeric(y[r]) }
yi <- as.numeric(y[i])
# At a maximum?
if (yl <= yi && yr <= yi) {
return(i)
}
# Nope; go in the direction of greatest increase, breaking ties to the right.
if (yl > yr) {
return(climb(y, l))
} else {
return(climb(y, r))
}
}
I don't think there is a function that will do that, the task is too simple and specialized. The more general case is that of finding local maxima in a vector or time series:
Given x
, then [could be written as one-liner]
lmax <- function(x) {
x <- c(x[1], x, x[length(x)])
d <- diff(sign(diff(x)))
which(d < 0)
}
will return the indices of all (local) maxima in x
. Starting with some index i
it is now easy to find the highest maximum in its vicinity. Example:
x <- c(10,10, 9, 4,10,10,10, 1, 2, 5, 4, 4)
lmax(x) # 2 5 7 10
If you start with i = 4
you will have to look -- applying findInterval
, for instance -- which one is higher, x[2]
or x[5]
. If you don't want to wade through flat valleys (or plateaus), e.g. i=6
, some if
statements will march in. Therefore a pedestrian's approach seems more appropriate:
hill <- function(x, i) {
stopifnot(is.numeric(x), 1 <= i, i <= length(x))
i1 <- i2 <- i
while (i1 < length(x))
if (x[i1 + 1] > x[i1]) i1 <- i1 + 1 else break
while (i2 > 1)
if (x[i2 - 1] > x[i2]) i2 <- i2 - 1 else break
# return
if (x[i1] >= x[i2]) i1 else i2
}
Of course, I would like to see a more vectorized solution.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With