[R-SIG-Finance] quantmod Charting

Thu Jul 23 17:38:14 CEST 2009

Hello,

I am using quantmod to create charts that have buy/sell date times
with a window 40 minutes before and after the buy/sell date time.  I
want to create ps charts and ultimately pdf charts of the trades.  I'm
not concerned with the exit right now.  The number of buy/sell date
times can range between 150 – 3000+, so I'd clearly like to automate
the process.  The code I’ve been using is attached below.  I've tried
putting the below into a function so I call the function with the
trade number, but this does not produce the full chart (and a similar
problem with 'if' and thus the multipe 'if's below for the same
condition).  If I run the below as Source R code it also doesn't
produce the full chart.  Also, because the code is so long for each
chart, I can't just run the code for all the trades at 1 time; I have
to cut and paste the script for about 75 trades/time.  The code has
run time of about 5-6 trade charts/min which clearly takes a while for
the 3000+ trades and then considering I have also to cut and paste the
code.

Is there any way to speed up or otherwise improve the script/charting?

Thanks,
Jim

R code for charts -

 require(quantmod)

	file = 'C:/Consulting/chart.txt'
	chart_data <- read.zoo(file, header = FALSE, col.names = c("Date",
"Open", "High", "Low", "Close", "MACD1min", "MACD5min", "MACD10min",
"Hist1min", "Hist5min", "Hist10min"), sep = ",", dec = ".", tz = "",
format = "%Y-%m-%d %H:%M:%S")
    ES <- cbind(chart_data$Open, chart_data$High, chart_data$Low,
chart_data$Close)
	ES <- as.quantmod.OHLC(ES, col.names = c("Open", "High", "Low", "Close"))

    time_before = 40
    time_after = 40
    time_before <- time_before * 60
    time_after <- time_after * 60

    enter_times_path = 'C:/Consulting/ES_trades_with_slope_rule.txt'
    enter_times <- read.zoo(enter_times_path, header = FALSE,
col.names = c("Date", "Position"), sep = ",", dec = ".", tz = "",
format = "%Y-%m-%d %H:%M:%S")

	ctheme <- chartTheme(theme = 'white', area = 'white', up.col =
'#0C481A', dn.col = '#B12525')

i = 1
# Trade number repeats for number of trades

display_range <- window(ES, start = time(enter_times[i]) - time_before
, end = time(enter_times[i]) + time_after)
m <- window(chart_data, start = time(enter_times[i]) - time_before ,
end = time(enter_times[i]) + time_after)
MACD <- cbind(m$MACD1min, m$MACD5min, m$MACD10min)

chartSeries(display_range, theme = ctheme)

Hist_range_5 = c(min(range(m$Hist5min)[1], - 0.2),
max(range(m$Hist5min)[2], 0.2))
Hist_range_10 = c(min(range(m$Hist10min)[1], - 0.2),
max(range(m$Hist10min)[2], 0.2))

h_steep_slope_1min <- m[abs(diff(m$Hist1min)) >= 0.1]
h_slope_1min <- m[abs(diff(m$Hist1min)) >= 0.05 & abs(diff(m$Hist1min)) < 0.1]
h_no_slope_1min <- m[abs(diff(m$Hist1min)) < 0.05]
h_slope_macd_above_1min <- h_slope_1min[abs(h_slope_1min$Hist1min) > 0.2,]
h_slope_macd_below_1min <- h_slope_1min[abs(h_slope_1min$Hist1min) <= 0.2,]
h_no_slope_above_1min <- h_no_slope_1min[abs(h_no_slope_1min$Hist1min) > 0.2,]
h_no_slope_below_1min <- h_no_slope_1min[abs(h_no_slope_1min$Hist1min) <= 0.2,]
h_steep_slope_above_1min <-
h_steep_slope_1min[abs(h_steep_slope_1min$Hist1min) > 0.2,]
h_steep_slope_below_1min <-
h_steep_slope_1min[abs(h_steep_slope_1min$Hist1min) <= 0.2,]

a = h_slope_macd_below_1min$Hist1min
b = h_no_slope_below_1min$Hist1min
f =	h_steep_slope_below_1min$Hist1min

c = h_steep_slope_above_1min$Hist1min
d = h_no_slope_above_1min$Hist1min
e = h_slope_macd_above_1min$Hist1min

zero_times = time(m)
zero = zoo(0, order.by = zero_times)

addTA(a, on = NA, col = '#C03E15' , type = 'h', lwd = 3, yrange =
range(m$Hist1min))
addTA(b, on = 2, col = '#C03E15', type = 'h', lwd = 1)
addTA(f, on = 2, col = '#C03E15', type = 'h', lwd = 6)
addTA(c, on = 2, col = '#060440', type = 'h', lwd = 3)
addTA(d, on = 2, col = '#060440', type = 'h', lwd = 1)
addTA(e, on = 2, col = '#060440', type = 'h', lwd = 6)
addTA(zero, on = 2, col = 'black', type = 'l', lwd = 1)

h_steep_slope_5min <- m[abs(diff(m$Hist5min)) >= 0.1]
h_slope_5min <- m[abs(diff(m$Hist5min)) >= 0.05 & abs(diff(m$Hist5min)) < 0.1]
h_no_slope_5min <- m[abs(diff(m$Hist5min)) < 0.05]

h_slope_macd_above_5min <- h_slope_5min[abs(h_slope_5min$Hist5min) > 0.7,]
h_slope_macd_below_5min <- h_slope_5min[abs(h_slope_5min$Hist5min) <= 0.7,]

h_no_slope_above_5min <- h_no_slope_5min[abs(h_no_slope_5min$Hist5min) > 0.7,]
h_no_slope_below_5min <- h_no_slope_5min[abs(h_no_slope_5min$Hist5min) <= 0.7,]

h_steep_slope_above_5min <-
h_steep_slope_5min[abs(h_steep_slope_5min$Hist5min) > 0.7,]
h_steep_slope_below_5min <-
h_steep_slope_5min[abs(h_steep_slope_5min$Hist5min) <= 0.7,]

a5 = h_slope_macd_below_5min$Hist5min
b5 = h_no_slope_below_5min$Hist5min
f5 = h_steep_slope_below_5min$Hist5min

c5 = h_steep_slope_above_5min$Hist5min
d5 = h_no_slope_above_5min$Hist5min
e5 = h_slope_macd_above_5min$Hist5min

addTA(a5, on = NA, col = '#C03E15' , type = 'h', lwd = 3, yrange =
range(Hist_range_5))
addTA(b5, on = 3, col = '#C03E15', type = 'h', lwd = 1)
addTA(f5, on = 3, col = '#C03E15', type = 'h', lwd = 6)
addTA(c5, on = 3, col = '#060440', type = 'h', lwd = 3)
addTA(d5, on = 3, col = '#060440', type = 'h', lwd = 1)
addTA(e5, on = 3, col = '#060440', type = 'h', lwd = 6)
addTA(zero, on = 3, col = 'black', type = 'l', lwd = 1)

h_steep_slope_10min <- m[abs(diff(m$Hist10min)) >= 0.1]
h_slope_10min <- m[abs(diff(m$Hist10min)) >= 0.05 &
abs(diff(m$Hist10min)) < 0.1]
h_no_slope_10min <- m[abs(diff(m$Hist10min)) < 0.05]

h_slope_macd_above_10min <- h_slope_10min[abs(h_slope_10min$Hist10min) > 0.7,]
h_slope_macd_below_10min <- h_slope_10min[abs(h_slope_10min$Hist10min) <= 0.7,]

h_no_slope_above_10min <-
h_no_slope_10min[abs(h_no_slope_10min$Hist10min) > 0.7,]
h_no_slope_below_10min <-
h_no_slope_10min[abs(h_no_slope_10min$Hist10min) <= 0.7,]

h_steep_slope_above_10min <-
h_steep_slope_10min[abs(h_steep_slope_10min$Hist10min) > 0.7,]
h_steep_slope_below_10min <-
h_steep_slope_10min[abs(h_steep_slope_10min$Hist10min) <= 0.7,]

a10 = h_slope_macd_below_10min$Hist10min
b10 = h_no_slope_below_10min$Hist10min
f10 = h_steep_slope_below_10min$Hist10min

c10 = h_steep_slope_above_10min$Hist10min
d10 = h_no_slope_above_10min$Hist10min
e10 = h_slope_macd_above_10min$Hist10min

addTA(d10, on = NA, col = '#060440', type = 'h', lwd = 1)
addTA(a10, on = 4, col = '#C03E15' , type = 'h', lwd = 3, yrange =
range(Hist_range_10))
addTA(b10, on = 4, col = '#C03E15', type = 'h', lwd = 1)
addTA(f10, on = 4, col = '#C03E15', type = 'h', lwd = 6)
addTA(c10, on = 4, col = '#060440', type = 'h', lwd = 3)

addTA(e10, on = 4, col = '#060440', type = 'h', lwd = 6)
addTA(zero, on = 4, col = 'black', type = 'l', lwd = 1)

addTA(MACD, on = NA, col = c('blue', 'red', 'green'), type = c('l',
'l', 'l'), lwd = c(4, 2, 1))
addTA(zero, on = 5, col = 'black', type = 'l', lwd = 1)

if (as.character(enter_times[i]) == "Long")	Buy <- ES[time(ES) ==
time(enter_times[i]) + 60]$ES.Open
if (as.character(enter_times[i]) == "Long")	addTA(Buy, on = 1, col =
'red', type = 'p', pch = 6, lwd = 2)
if (as.character(enter_times[i]) == "Long")	addTA(Buy > 0, on =
-(1:5), col = '#FFCAFD', border = NA)

if (as.character(enter_times[i]) == "Short")	Short <- ES[time(ES) ==
time(enter_times[i]) + 60]$ES.Open
if (as.character(enter_times[i]) == "Short")    addTA(Short, on = 1,
col = 'blue', type = 'p', pch = 2, lwd = 2)
if (as.character(enter_times[i]) == "Short")	addTA(Short > 0, on =
-(1:5), col = '#FF7878', border = NA)

# Repeats with i = 2...