Search code examples
rplotline

R Fit linear line or exponential curve through peaks and lows of timeseries


I would like to plot a linear or log line through the peaks and lows in a times series with decreased peaks and lows like in the images. How do I do that?

In oher words: a line with its origin at the data series' peak, with the most negative slope possible, that doesn't intersect the data series at any other point. Which also accounts for the lows. Preferably both a lineair line as an exponential line.

The red lines I had drawn manually cause I dont know how to get them via R, hence thats the goal of the question. The following code gives the timeseries.

set.seed(123)

# Generate time series 
n <- 10000
x <- cumsum(rnorm(n, 0, 1))
sigma <- seq(2, 0.1, length.out = n)
x <- x * sigma

# Plot the time series
plot(x, type = "l")

enter image description here enter image description here


Solution

  • 1) max/min slope Determine the maximum slope between the maximum and points to the right of the maximum and the minimum slope from the minimum to points to the right of the minimum.

    plot(x, type = "l")
    n <- length(x)
    
    w.mn <- which.min(x)
    x1 <- x[w.mn:n]
    m1 <- min((x1[-1] - min(x1)) / ((w.mn+1):n - (w.mn)))
    segments(w.mn, min(x), n, min(x) + m1 * (n - w.mn), col = "red", lwd = 2)
    
    w.mx <- which.max(x)
    x2 <- x[w.mx:n]
    m2 <- max((x2[-1] - max(x2)) / ((w.mx+1):n - (w.mx)))
    segments(w.mx, max(x), n, max(x) + m2 * (n - w.mx), col = "red", lwd = 2)
    

    screenshot

    2) quantile regression. Another way to do this is to use quantile regression. We show the lines in red and the log upper curve in green. The lower curve does not really make sense for log due to negative values in x.

    library(quantreg)
    
    xx <- seq_along(x)
    plot(x ~ xx, type = "l")
    
    fm <- rq(x ~ xx, tau = 0:1)
    yy <- predict(fm)
    lines(yy[, 1] ~ xx, col = "red", lwd = 2)
    lines(yy[, 2] ~ xx, col = "red", lwd = 2)
    
    fm.log <- rq(log(x) ~ xx, tau = 1)
    yy.log <- cbind(1, xx) %*% coef(fm.log)
    lines(exp(yy.log) ~ xx, col = "green", lwd = 2)
    

    screenshot