R/functions-plot.R

Defines functions plot_candlestick_chart

Documented in plot_candlestick_chart

#'plot candlestick chart
#'@param dt date(vector)
#'@param open open prices(vector)
#'@param high high prices(vector)
#'@param low low prices(vector)
#'@param close close prices(vector)
#'@param stat_row row number of plot start
#'@param end_row row number of plot end
#'@param line1 sub line1 on the candle(vector)
#'@param line2 sub line2 on the candle(vector)
#'@param col_cdl color of candle body
#'@examples plot_candlestick_chart(dt = usdjpy_d[1:20, "dt"], open = usdjpy_d[1:20, "o"], high = usdjpy_d[1:20, "h"], low = usdjpy_d[1:20, "l"], close = usdjpy_d[1:20, "c"], stat_row = 1, end_row = 200, line1 = 0, line2 = 0, col_cdl = "#FF6600")
#'@encoding UTF-8
#'@export
plot_candlestick_chart <- function(dt = usdjpy_d[1:20, "dt"],
                                   open = usdjpy_d[1:20, "o"],
                                   high = usdjpy_d[1:20, "h"],
                                   low = usdjpy_d[1:20, "l"],
                                   close = usdjpy_d[1:20, "c"],
                                   stat_row = 1,
                                   end_row = 200,
                                   line1 = 0,
                                   line2 = 0,
                                   col_cdl = "#FF6600"){
  #data for candle
  x <- data.frame(dt = dt,
                  o = open,
                  h = high,
                  l = low,
                  c = close,
                  line1 = line1,
                  line2 = line2)
  end_row <- ifelse(nrow(x) < end_row, nrow(x), end_row)
  x <- x[stat_row:end_row, ]
  #maximum nad minumum value of price
  xmax <- nrow(x)
  ymax <- max(x$h)
  ymin <- min(x$l)
  xwidth <- 1 / 2
  #basic plot
  par(bg = "white", mar = c(2, 2, 1, 0))
  plot(x[x$o > 0, "o"],
       axes = F,
       xlim = c(1, xmax),
       ylim = c(ymin, ymax),
       type = "n",
       bty = "n",
       xlab = "",
       ylab = "",
       main = "Candlestick Chart")
  #setting of axis
  axis(2,
       at = names(
         table(floor(seq(ymin, ymax + 1000, by = 1000) / 1000) * 1000)
         ),
       names(table(floor(seq(ymin, ymax + 1000, by = 1000) / 1000) * 1000)),
       cex.axis = 0.8, las = 3)
  abline(h = names(
                  table(floor(seq(ymin, ymax + 1000, by = 1000) / 1000) * 1000)
                  ),
         lty = "dotted", col = "gray10")
  #plot candle
  for (i in 1:nrow(x)){
    #shadow
    segments(i, x[i, "h"], i, x[i, "l"], col = 1)
    #bullish candle
    if (x[i, "c"] >=  x[i, "o"]){
      rect(i + xwidth, x[i, "o"], i - xwidth, x[i, "c"], col = "#ffffff")
      #bearish candle
    } else if (x[i, "c"] < x[i, "o"]){
      rect(i + xwidth, x[i, "o"], i - xwidth, x[i, "c"], col = col_cdl)
    } else {
      #do not plot
    }
  }
  #add subline1
  if (sum(x$line1) !=  0){
    line1_ratio <- (x$line1 - min(x$line1)) / (max(x$line1) - min(x$line1))
    x$line1_adj <- (line1_ratio * (ymax - ymin)) + ymin
    lines(y = x$line1_adj, x = 1:length(x$line1), col = 2, lwd = 2)
  }
  #add subline2
  if (sum(x$line2) !=  0){
    line2_ratio <- (x$line2 - min(x$line2)) / (max(x$line2) - min(x$line2))
    x$line2_adj <- (line2_ratio * (ymax - ymin)) + ymin
    lines(y = x$line2_adj, x = 1:length(x$line2), col = 4, lwd = 2)
  }
}
naokiookura/rquants documentation built on May 23, 2017, 10:31 a.m.