BTC plot + WMA

WMA_Plot.R

WMA_Plot <- function(Dat, term=c("2020-01-01", as.character(lubridate::today())),
                     lag=10, xax = 0.1, yax = 0.999, xcex=0.9, ycex=0.8,rou=0,
                     M1=0.15, m1=0.9){
  
  oldpar <- graphics::par(no.readonly = TRUE)
  on.exit(graphics::par(oldpar))
  
  if(!all(colnames(Dat) == c("Date", "Close", "Month"))){
    stop("Incorrect format of Dat object")
  }
  
  aa <- c(sum(Dat$Date <= term[1]):sum(Dat$Date <= term[2]))
  M <- max(Dat$Close[aa]) + abs(max(Dat$Close[aa]) - min(Dat$Close[aa]))*M1
  m <- min(Dat$Close[aa])*m1
  
  par(family= "HiraKakuPro-W3", xpd =F)
  layout(matrix(c(1), 1, 1, byrow = TRUE),
         widths=c(1),
         heights=c(1)
  )
  par(mar = c(4,  4, 2, 2))
  plot(Dat$Date, Dat$Close, 
       ylim = c(m, M),
       xlim = c(min(as.numeric(Dat$Date)[aa]),
                max(as.numeric(Dat$Date)[aa])+as.numeric(lag)),
       xlab = "", ylab = "", 
       type = "l", col = "white", 
       lwd = 1,
       xaxt = "n",
       yaxt = "n",
       main="USD Price",
       xaxs="i", yaxs="i")
  
  #X-axis
  par(family= "HiraKakuPro-W3", xpd =F)
  lab <- seq.Date(as.Date(term[1]), as.Date(term[2]), length.out = 5, format="%Y年%B")
  axis.Date(1, at=lab, labels = FALSE, format="%Y年%B", cex=0.7)
  text(lab, m - (M-m)*xax,
       labels = format(lab, "%Y年%B"), srt = 35, pos = 1, xpd = TRUE, cex=xcex)
  
  #Y-axis
  par(family= "HiraKakuPro-W3", xpd =F)
  lab <- round(seq(signif(m, 1), signif(M, 1), length.out = 7),rou)
  lab <- lab[lab > m]
  lab <- lab[lab < M]
  axis(2, at = lab, labels = F)
  text(par("usr")[1]*yax, lab, labels = lab, srt = 0, pos = 2, xpd = TRUE, cex=ycex)
  
  #Plot
  lines(Dat$Date, Dat$Close, type = "l", lwd = 1, col="grey")
  
  WMA_periods=c(1800, 2200, 2750, 3250, 3600)
  #WMA: EMA with linear weighting
  a <- as.numeric(Dat$Date)
  lines(a, WMA(Dat$Close, n = WMA_periods[1]), col="#709bf870", lwd=2)
  lines(a, WMA(Dat$Close, n = WMA_periods[2]), col="#709bf880", lwd=2)
  lines(a, WMA(Dat$Close, n = WMA_periods[3]), col="#709bf890", lwd=2)
  lines(a, WMA(Dat$Close, n = WMA_periods[4]), col="#709bf890", lwd=2)
  lines(a, WMA(Dat$Close, n = WMA_periods[5]), col="#709bf890", lwd=2)
  
  lines(a, WMA(Dat$Close, n = WMA_periods[2])*2, col="#56bc8260", lwd=2)
  lines(a, WMA(Dat$Close, n = WMA_periods[2])*2.5, col="#56bc8250", lwd=2)
  lines(a, WMA(Dat$Close, n = WMA_periods[2])*3, col="#56bc8270", lwd=2)
  lines(a, WMA(Dat$Close, n = WMA_periods[2])*4, col="#56bc8280", lwd=2)
  lines(a, WMA(Dat$Close, n = WMA_periods[2])*5, col="#56bc8290", lwd=2)
  lines(a, WMA(Dat$Close, n = WMA_periods[2])*6, col="#56bc82", lwd=2)
  
  dd <- Dat$Close < WMA(Dat$Close, n = WMA_periods[2])
  for(n in 2:length(dd)){
    if(!any(c(is.na(dd[n-1]), is.na(dd[n])))){
      if(any(c(dd[n-1], dd[n]))){
        lines(a[(n-1):n], Dat$Close[(n-1):n], type="l", col="#709bf8")
      }}}
  
  dd <- Dat$Close > WMA(Dat$Close, n = WMA_periods[2])*3
  for(n in 2:length(dd)){
    if(!any(c(is.na(dd[n-1]), is.na(dd[n])))){
      if(any(c(dd[n-1], dd[n]))){
        lines(a[(n-1):n], Dat$Close[(n-1):n], type="l", col="#56bc82")
      }}}
}