Heikin_Ashi.R

#From pverspeelt/Quantfunctions
#https://github.com/pverspeelt/Quantfunctions

#パッケージ・インストール
pack <- c("quantmod", "dygraphs", "htmltools", "magrittr", "TTR", "xts", "ggplot2", "gridExtra", "lubridate")
install.packages(pack[!(pack %in% unique(rownames(installed.packages())))], repos="https://cloud.r-project.org/")

#ロード
for(n in 1:length(pack)){ eval(parse(text = paste0("library(", pack[n], ")"))) }; rm("n", "pack")

#平均足の計算
heikin_ashi <- function(x) {
  if(!quantmod::is.OHLC(x)) 
    stop("x must contain OHLC columns", call. = FALSE)
  
  if(any(is.na(x))) 
    stop("x contains NA values, either remove these records or fix them",
         call. = FALSE)
  
  heikin_close <- xts::xts(rowMeans(quantmod::OHLC(x)), 
                           order.by = zoo::index(x))
  heikin_open  <- quantmod::Op(x)
  
  # need a loop: heiki ashi open is dependent on the previous value
  for(i in 2:nrow(x)) {
    heikin_open[i] <- (heikin_open[i-1] + heikin_close[i-1]) / 2
  }
  
  heikin_high <- xts::xts(apply(cbind(quantmod::Hi(x), heikin_open, heikin_close), 1, max), 
                          order.by = zoo::index(x))
  heikin_low <- xts::xts(apply(cbind(quantmod::Lo(x), heikin_open, heikin_close), 1, min), 
                         order.by = zoo::index(x))
  
  out <- merge(heikin_open, heikin_high, heikin_low, heikin_close)
  names(out) <- c("Open", "High", "Low", "Close")
  
  return(out)
}

stochRSI <- function(x, n = 14L){
  
  if (n < 1 || n > NROW(x)) 
    stop(glue("n = {n} is outside valid range: [1, {NROW(X)}]"),
         call. = FALSE)
  
  x <- xts::try.xts(x, error = as.matrix)
  
  if(!quantmod::has.Cl(x)) 
    stop("x must contain a close column.",
         call. = FALSE)
  
  rsi <- TTR::RSI(quantmod::Cl(x), n)
  rsi_out <- (rsi - TTR::runMin(rsi, n)) / (TTR::runMax(rsi, n) - TTR::runMin(rsi, n))
  names(rsi_out) <- "stochRSI"
  
  return(rsi_out)
}

stRSI <- function(x, n = 14L){
  
  if (n < 1 || n > NROW(x)) {
    stop(glue("n = {n} is outside valid range: [1, {NROW(X)}]"), call. = FALSE)}
  
  x <- xts::try.xts(x, error = as.matrix)
  
  if(!quantmod::has.Cl(x)){ 
    stop("x must contain a close column.", call. = FALSE)}
  
  rsi <- quantmod::Cl(x)
  MIN <- (TTR::runMin(rsi, n-4) + TTR::runMin(rsi, n-2) + TTR::runMin(rsi, n) + TTR::runMin(rsi, n+2) + TTR::runMin(rsi, n+4))/5
  MAX <- (TTR::runMax(rsi, n-4) + TTR::runMax(rsi, n-2) + TTR::runMax(rsi, n) + TTR::runMax(rsi, n+2) + TTR::runMax(rsi, n+4))/5
  #matplot(data.frame(rsi, MIN, MAX), type="l")
  rsi_out <- round((rsi - MIN), 3) / round((MAX - MIN), 3)
  names(rsi_out) <- "stRSI"
  
  return(rsi_out)
}


#キャンドルチャート作図
ggChandles <- function(x, term, Tittle="BTC-USD", MonthlyAshi=FALSE, WeeklyAshi=FALSE, lwd=0.5){
#x=BTCw; term=term; Tittle="BTC-USD"; MonthlyAshi=FALSE; WeeklyAshi=FALSE; lwd=0.5

if(ncol(x) == 6){
    x <- setNames(x, nm = c("Open", "High", "Low", "Close", "Volume", "Adjusted"))
  }

  if(MonthlyAshi){x <- x[grepl("-01$", index(x)),]}
  if(WeeklyAshi){index(x)[nrow(x)] <- index(x)[nrow(x)-1] + lubridate::ddays(7)}
  
  x1 <- x[index(x) >= term[1],]
  x2 <- x1[index(x1) <= term[2],]
  x2$Date <- index(x2)
  
  g <- x2 %>%
    ggplot(data=., aes(x=Index, lower=pmin(Open, Close), middle=pmin(Open, Close), 
                       upper=pmax(Open, Close), ymin=Low, ymax=High)) +  
    geom_boxplot(stat='identity', aes(group=Index, fill=ifelse(Close > Open, "up", "dn")), 
                 alpha=0.9, fatten = 0, lwd=lwd) +
    theme(legend.position = "none") +
    xlab("Date-Time") +
    ylab("Price") +
    labs(title = Tittle) + 
    scale_fill_manual(values = c("#ff5400", "#00cc00"))
  return(g)
}

#折線グラフ
ggChart <- function(x, y, term, Tittle="BTC-USD", linetype="solid", colour, y1=TRUE){
  
  x1 <- x[index(x) >= term[1],]
  x2 <- x1[index(x1) <= term[2],]
  x2$Date <- index(x2)
  
  g <- x2 %>%
    ggplot(data=., aes(x=Index, y=get(y))) + 
    geom_line(aes(x=Index, y=get(y)), colour=colour, linetype=linetype) +
    theme(legend.position = "none") +
    xlab("Date-Time") +
    ylab("") +
    labs(title = Tittle) + 
    scale_fill_manual(values = c("#ff5400", "#00cc00"))
  
  if(y1){
    g <- g +
      scale_y_continuous(limits = c(0, 1))
  }
  
  return(g)
}

#チャート保存
pdf_png_save <- function(FileName){
grDevices::quartz.save(FileName, type="pdf", width=8, height=7);dev.off(); 
pdftools::pdf_convert(pdf = FileName, format = "png", dpi = 300)  
}