find peak position

library(zoo)

## Warning: package 'zoo' was built under R version 3.6.3

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

library(xml2)

## Warning: package 'xml2' was built under R version 3.6.3

library(tidyverse)

## Warning: package 'tidyverse' was built under R version 3.6.3

## -- Attaching packages ------------------------------------------------------------------------------------------------- tidyverse 1.3.0 --

## v ggplot2 3.3.0     v purrr   0.3.3
## v tibble  3.0.0     v dplyr   0.8.5
## v tidyr   1.0.2     v stringr 1.4.0
## v readr   1.3.1     v forcats 0.5.0

## Warning: package 'tibble' was built under R version 3.6.3

## Warning: package 'tidyr' was built under R version 3.6.3

## Warning: package 'readr' was built under R version 3.6.3

## Warning: package 'purrr' was built under R version 3.6.3

## Warning: package 'dplyr' was built under R version 3.6.3

## Warning: package 'stringr' was built under R version 3.6.3

## Warning: package 'forcats' was built under R version 3.6.3

## -- Conflicts ---------------------------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(tidyquant)

## Warning: package 'tidyquant' was built under R version 3.6.3

## Loading required package: lubridate

## Warning: package 'lubridate' was built under R version 3.6.3

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:dplyr':
## 
##     intersect, setdiff, union

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

## Loading required package: PerformanceAnalytics

## Warning: package 'PerformanceAnalytics' was built under R version 3.6.3

## Loading required package: xts

## Warning: package 'xts' was built under R version 3.6.3

## 
## Attaching package: 'xts'

## The following objects are masked from 'package:dplyr':
## 
##     first, last

## 
## Attaching package: 'PerformanceAnalytics'

## The following object is masked from 'package:graphics':
## 
##     legend

## Loading required package: quantmod

## Warning: package 'quantmod' was built under R version 3.6.3

## Loading required package: TTR

## Warning: package 'TTR' was built under R version 3.6.3

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

## Version 0.4-0 included new data defaults. See ?getSymbols.

## == Need to Learn tidyquant? ==============================================================================================================
## Business Science offers a 1-hour course - Learning Lab #9: Performance Analysis & Portfolio Optimization with tidyquant!
## </> Learn more at: https://university.business-science.io/p/learning-labs-pro </>

library(dygraphs)

## Warning: package 'dygraphs' was built under R version 3.6.3

library(reshape2)

## Warning: package 'reshape2' was built under R version 3.6.3

## 
## Attaching package: 'reshape2'

## The following object is masked from 'package:tidyr':
## 
##     smiths

#https://rpubs.com/mengxu/peak_detection
#http://r-statistics.co/Loess-Regression-With-R.html

set.seed(123)
x <- 1:1000 / 100 - 5
y <- exp(abs(x)/20) * sin(2 * x + (x/5)^2) + cos(10*x) / 5 + rnorm(length(x), sd=0.05)

y.smooth <- loess(y ~ x, span=0.05)$fitted


plot(x, y, col = 'black', type = 'l')+lines(x, y.smooth, col='red', type = 'l')

## integer(0)

w=50
y.max <- rollapply(zoo(y.smooth), 2*w+1, max, align="center")
x.max <- rollapply(zoo(x), 2*w+1, median, align="center")
length(y.max)

## [1] 900

length(x)

## [1] 1000

plot(x,y, col = 'Gray', type='l')
lines(x.max, y.max, col = 'SkyBlue', lwd = 2)

plot(x, y, col = 'Gray', type = 'l')
lines(x, y.smooth, col = 'Black')
lines(x.max, y.max, col = 'SkyBlue', lwd = 2)

legend('topleft', c('1', '2', '3'), cex=0.8, col=c('Gray', 'Black', 'SkyBlue'), lty=c(1,1,1))

n <- length(y)
delta <- y.max - y.smooth[-c(1:w, n+1-1:w)]
plot(x.max, delta, type='l')
abline(h = 0, lty='dotted', col = 'red')

argmax <- function(x, y, w=1, ...) {
  require(zoo)
  n <- length(y)
  y.smooth <- loess(y ~ x, ...)$fitted
  y.max <- rollapply(zoo(y.smooth), 2*w+1, max, align="center")
  delta <- y.max - y.smooth[-c(1:w, n+1-1:w)]
  i.max <- which(delta <= 0) + w
  list(x=x[i.max], i=i.max, y.hat=y.smooth)
  
}

 peaks<-argmax(x,y,w=50,span=0.05)

w=50
span=0.05
test <- function(w, span) {
  peaks <- argmax(x, y, w=w, span=span)

  plot(x, y, cex=0.75, col="Gray", main=paste("w = ", w, ", span = ", span, sep=""))
  lines(x, peaks$y.hat, col='blue',  lwd=2) #$
  y.min <- min(y)
  sapply(peaks$i, function(i) lines(c(x[i],x[i]), c(y.min, peaks$y.hat[i]), col="Red", lty=2))
  points(x[peaks$i], peaks$y.hat[peaks$i], col="Red", pch=19, cex=1.25)
}

test(50,0.05)

P<-as.data.frame(cbind(x,y))


P$peak<-NA

for (j in 1: length(peaks$i)) {
P$peak[c(peaks$i[j])]<-P$y[c(peaks$i[j])]
}

data<-as.data.frame(P)

dates<-seq(as.Date("2010-01-01"), length=1000,by="days" )
data_T<-xts(data[,1:3],dates)
dateWindow <- c("2010-01-29", "2012-11-10")
dygraph(data_T[,c('y','peak')])%>% dySeries("peak", pointSize = 4, color = 'red', label = "Peak")

data_P<-data
data_P$peakc<-NA
for (j in 1: length(peaks$i)) {
data_P$peakc[c(peaks$i[j])]<-'peak'
}

which(data_P$peakc=='peak')

## [1] 250 565 875

data_P$pct<-NA
data_P$pct[260]=20

#find cloest peak
BeforeAfter<-which(data_P$pct==20)>=which(data_P$peakc=='peak')

BeforeAfter

## [1]  TRUE FALSE FALSE

#find valley
w=50
y.min <- rollapply(zoo(y.smooth), 2*w+1, min, align="center")
x.min <- rollapply(zoo(x), 2*w+1, median, align="center")
length(y.min)

## [1] 900

length(x)

## [1] 1000

plot(x, y, col = 'Gray', type = 'l')
lines(x, y.smooth, col = 'Black')
lines(x.min, y.min, col = 'SkyBlue', lwd = 2)

legend('topleft', c('1', '2', '3'), cex=0.8, col=c('Gray', 'Black', 'SkyBlue'), lty=c(1,1,1))

#valley detection

n <- length(y)
delta <- y.min - y.smooth[-c(1:w, n+1-1:w)]
plot(x.min, delta, type='l')
abline(h = 0, lty='dotted', col = 'red')

#valley
argmin <- function(x, y, w=1, ...) {
  require(zoo)
  n <- length(y)
  y.smooth <- loess(y ~ x, ...)$fitted
  y.min <- rollapply(zoo(y.smooth), 2*w+1, min, align="center")
  delta <- y.min - y.smooth[-c(1:w, n+1-1:w)]
  i.min <- which(delta >= 0) + w
  list(x=x[i.min], i=i.min, y.hat=y.smooth)
  
}

 valley<-argmin(x,y,w=50,span=0.05)

w=50
span=0.05
test <- function(w, span) {
  peaks <- argmin(x, y, w=w, span=span)

  plot(x, y, cex=0.75, col="Gray", main=paste("w = ", w, ", span = ", span, sep=""))
  lines(x, peaks$y.hat, col='blue',  lwd=2) #$
  y.min <- min(y)
  sapply(peaks$i, function(i) lines(c(x[i],x[i]), c(y.min, peaks$y.hat[i]), col="Red", lty=2))
  points(x[peaks$i], peaks$y.hat[peaks$i], col="Red", pch=19, cex=1.25)
}

test(50,0.05)

V<-as.data.frame(cbind(x,y))


V$valley<-NA

for (j in 1: length(valley$i)) {
V$valley[c(valley$i[j])]<-V$y[c(valley$i[j])]
}

data<-as.data.frame(V)

dates<-seq(as.Date("2010-01-01"), length=1000,by="days" )
data_T<-xts(data[,1:3],dates)
dateWindow <- c("2010-01-29", "2012-11-10")
dygraph(data_T[,c('y','valley')])%>% dySeries("valley", pointSize = 4, color = 'blue', label = "valley")

PV<-cbind(P,V)
PV<-xts(PV,dates)
dygraph(PV[,c('y','peak','valley')])%>% dySeries("valley", pointSize = 4, color = 'blue', label = "valley")%>% dySeries("peak", pointSize = 4, color = 'red', label = "peak")