BTC polygon Plot + SMA

SMA_polygon_Plot.R

SMA_polygon_Plot <- function(Dat, term=c("2020-01-01", as.character(lubridate::today())),
                             lag=5, xax = 0.05, yax = 0.999, xcex=0.8, ycex=0.8, rou=0,
                             SMA_periods=c(1600, 2200, 2600, 3000, 3650),
                             M1=0.15, m1=0.9, line_col=F, LogY=F, Main_text="SMA Polygon Plot"){
  
  #term=c("2019-01-01", as.character(lubridate::today())); lag=5; xax = 0.05; yax = 0.999; xcex=0.9; ycex=0.8; rou=0; M1=0.15; m1=0.9; line_col=T; LogY=F; Main_text="SMA Polygon Plot"
  
  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))
  if(LogY){
    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", 
         log="y",
         lwd = 1,
         xaxt = "n",
         yaxt = "n",
         main=Main_text,
         xaxs="i", yaxs="i")    
  }else{
    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=Main_text,
         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)
  if(LogY){
    lab <- as.numeric(c(c(1,1.5,2,3,4, 5, 6, 8, 10) %o% 10^(-2:7)))  
  }else{
    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)
  
  #SMA
  #SMA_periods=c(1600, 2200, 2600, 3000, 3650)
  a <- as.numeric(Dat$Date)
  aa1 <- TTR::SMA(Dat$Close, n = SMA_periods[1])
  aa2 <- TTR::SMA(Dat$Close, n = SMA_periods[2])
  aa3 <- TTR::SMA(Dat$Close, n = SMA_periods[3])
  aa4 <- TTR::SMA(Dat$Close, n = SMA_periods[4])
  aa5 <- TTR::SMA(Dat$Close, n = SMA_periods[5])
  
  #Blue zone
  polygon( c(a, rev(a)), c(aa1, rev(aa2)), col="#709bf820", border = NA)
  polygon( c(a, rev(a)), c(aa2, rev(aa3)), col="#709bf840", border = NA)
  polygon( c(a, rev(a)), c(aa3, rev(aa4)), col="#709bf870", border = NA)
  polygon( c(a, rev(a)), c(aa4, rev(aa5)), col="#709bf890", border = NA)
  
  #Green zone
  polygon( c(a, rev(a)), c(aa2*2.5, rev(aa2)*3), col="#56bc8220", border = NA)
  polygon( c(a, rev(a)), c(aa2*3, rev(aa2)*4), col="#56bc8230", border = NA)
  polygon( c(a, rev(a)), c(aa2*4, rev(aa2)*5), col="#56bc8240", border = NA)
  polygon( c(a, rev(a)), c(aa2*5, rev(aa2)*6), col="#56bc8250", border = NA)
  polygon( c(a, rev(a)), c(aa2*6, rev(aa2)*8), col="#56bc8280", border = NA)
  
  lines(a, aa1, col="#709bf850", lwd=2)
  lines(a, aa2, col="#709bf860", lwd=2)
  lines(a, aa3, col="#709bf870", lwd=2)
  lines(a, aa4, col="#709bf880", lwd=2)
  lines(a, aa5, col="#709bf890", lwd=2)
  
  lines(a, aa2*2, col="#56bc8250", lwd=2)
  lines(a, aa2*2.5, col="#56bc8260", lwd=2)
  lines(a, aa2*3, col="#56bc8270", lwd=2)
  lines(a, aa2*4, col="#56bc8280", lwd=2)
  lines(a, aa2*5, col="#56bc8290", lwd=2)
  lines(a, aa2*6, col="#56bc82", lwd=2)
  lines(a, aa2*8, col="#56bc82", lwd=2)
  
  #Plot
  lines(Dat$Date, Dat$Close, type = "l", lwd = 1, col="grey")
  
  if(line_col){
    dd <- Dat$Close < TTR::SMA(Dat$Close, n = SMA_periods[1])
    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 > TTR::SMA(Dat$Close, n = SMA_periods[2])*4
    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")
        }}}
  }
}