0

Hoew can I apply vector of observations to find the local maximum between each observation in R. I do the following code, but according to plot the result should be just two local maximum. How can I do this in R?

    x = c(0.0000005, 0.1578947, 0.3157895, 0.4736842, 0.6315789, 0.7894737, 
      0.9473684, 1.1052632,1.2631579, 1.4210526, 1.5789474, 1.7368421,
      1.8947368, 2.0526316, 2.2105263, 2.3684211, 2.5263158 ,
      2.6842105, 2.8421053, 3.000000)     
    f = function(x) (x+1)*(x-2)*(x-1)*(x)*(x+1)*(x-2)*(x-3)
    plot(x, f(x), type="l")
     maximums = sapply(x, function(x)optimize(f, c(0, x), maximum = TRUE)$maximum)
Waldir Leoncio
  • 10,853
  • 19
  • 77
  • 107
rose
  • 1,971
  • 7
  • 26
  • 32
  • It seems to be giving you the correct result. If you inspect `maximums`, you will see that it is giving you `0.46` and `2.00` as your maximums which is consistent with your plot. – Ramnath Oct 14 '13 at 02:40
  • yes, of course, but I want to get at the end just the local maximums , not other points. How can I get rid of others? – rose Oct 14 '13 at 02:42
  • well you asked it to give the local maximum in every interval, and it is giving you that. to make sure that it is a local peak, you will have to check if the second derivative is negative at the point. – Ramnath Oct 14 '13 at 03:41

1 Answers1

0

I'm not sure how to apply optimize to that sequence for that purpose but it surely wouldn't be applied pointwise.. You could conceivably make a polynomial spline and then differentiate it. The numerical analog of differentiation is diff and the conditions for a local maximum are that the first derivative be small and the second derivative be negative. Here is a plot of conditions that satisfy those (shifting the coloring by one to account for the shortening of the vector when you diff it:

plot(x,f(x), 
     col=c("red","blue")[1+seq_along(x) %in%    # adding one to the logical values 0,1
                         c(0, which( diff(diff(f(x)))<0 & diff(f(x)) < 0.1))])
IRTFM
  • 258,963
  • 21
  • 364
  • 487