Here is my take on it. First of all, the top right text is hard coded so you need to alter the function in order to fix this. On your console type:
plotquant <- fix("chart_Series")
and in the editor change the following (~line 118) :
text.exp <- c(expression(text(1 - 1/3, 0.5, name, font = 2,
col = "#444444", offset = 0, cex = 1.1, pos = 4)), expression(text(NROW(xdata[xsubset]),
#the line you need to change is below
0.5, paste(start(xdata[xsubset]), end(xdata[xsubset]),
sep = " / "), col = 1, adj = c(0, 0), pos = 2)))
Into:
text.exp <- c(expression(text(1 - 1/3, 0.5, name, font = 2,
col = "#444444", offset = 0, cex = 1.1, pos = 4)), expression(text(NROW(xdata[xsubset]),
0.5, paste(format(start(xdata[xsubset]), format = '%Y.%m.%d'),
format(end(xdata[xsubset]), format = '%Y.%m.%d'),
sep = " / "), col = 1, adj = c(0, 0), pos = 2)))
Then set the function into the correct namespace (so it works normally within quantmod) and also remove the labels with the chart elements as mentioned on the github link:
environment(plotquant) <- asNamespace("quantmod")
ct <- chart_theme()
ct$format.labels <- ' '
Then you are ready to plot:
plotquant(BRS, theme = ct)
As for your points 1 and 2, I think it is because you use par(mfrow... which changes the margins of the plots (making all of them the same size). In my picture you can see that it looks great. You could use layout instead of par(mfrow... to set your own sizes. Check ?layout.
Some Credit:
Got a lot of help from this answer:
Changes in plotting an XTS object
Update
The whole process can be replicated anywhere. We only create the function plotquant once. (actually here we don't edit the file, we just create a new function based on one that exists already i.e. chart_Series). Then once we have plotquant we are ready to create a script with everything included.
Type plotquant on the console and the source code will be revealed. Copy paste that into your script and you have defined your function. Then the rest follows normally:
plotquant <- function (x, name = deparse(substitute(x)), type = "candlesticks",
subset = "", TA = "", pars = chart_pars(), theme = chart_theme(),
clev = 0, ...)
{
cs <- new.replot()
line.col <- theme$col$line.col
up.col <- theme$col$up.col
dn.col <- theme$col$dn.col
up.border <- theme$col$up.border
dn.border <- theme$col$dn.border
format.labels <- theme$format.labels
if (is.null(theme$grid.ticks.on)) {
xs <- x[subset]
major.grid <- c(years = nyears(xs), months = nmonths(xs),
days = ndays(xs))
grid.ticks.on <- names(major.grid)[rev(which(major.grid <
30))[1]]
}
else grid.ticks.on <- theme$grid.ticks.on
label.bg <- theme$col$label.bg
cs$subset <- function(x) {
if (FALSE) {
set_ylim <- get_ylim <- set_xlim <- Env <- function() {
}
}
if (missing(x)) {
x <- ""
}
Env$xsubset <<- x
set_xlim(c(1, NROW(Env$xdata[Env$xsubset])))
ylim <- get_ylim()
for (y in seq(2, length(ylim), by = 2)) {
if (!attr(ylim[[y]], "fixed"))
ylim[[y]] <- structure(c(Inf, -Inf), fixed = FALSE)
}
lapply(Env$actions, function(x) {
frame <- abs(attr(x, "frame"))
fixed <- attr(ylim[[frame]], "fixed")
if (frame%%2 == 0 && !fixed) {
lenv <- attr(x, "env")
if (is.list(lenv))
lenv <- lenv[[1]]
min.tmp <- min(ylim[[frame]][1], range(na.omit(lenv$xdata[Env$xsubset]))[1],
na.rm = TRUE)
max.tmp <- max(ylim[[frame]][2], range(na.omit(lenv$xdata[Env$xsubset]))[2],
na.rm = TRUE)
ylim[[frame]] <<- structure(c(min.tmp, max.tmp),
fixed = fixed)
}
})
set_ylim(ylim)
}
environment(cs$subset) <- environment(cs$get_asp)
if (is.character(x))
stop("'x' must be a time-series object")
if (is.OHLC(x)) {
cs$Env$xdata <- OHLC(x)
if (has.Vo(x))
cs$Env$vo <- Vo(x)
}
else cs$Env$xdata <- x
cs$Env$xsubset <- subset
cs$Env$cex <- pars$cex
cs$Env$mar <- pars$mar
cs$set_asp(3)
cs$set_xlim(c(1, NROW(cs$Env$xdata[subset])))
cs$set_ylim(list(structure(range(na.omit(cs$Env$xdata[subset])),
fixed = FALSE)))
cs$set_frame(1, FALSE)
cs$Env$clev = min(clev + 0.01, 1)
cs$Env$theme$bbands <- theme$bbands
cs$Env$theme$shading <- theme$shading
cs$Env$theme$line.col <- theme$col$line.col
cs$Env$theme$up.col <- up.col
cs$Env$theme$dn.col <- dn.col
cs$Env$theme$up.border <- up.border
cs$Env$theme$dn.border <- dn.border
cs$Env$theme$rylab <- theme$rylab
cs$Env$theme$lylab <- theme$lylab
cs$Env$theme$bg <- theme$col$bg
cs$Env$theme$grid <- theme$col$grid
cs$Env$theme$grid2 <- theme$col$grid2
cs$Env$theme$labels <- "#333333"
cs$Env$theme$label.bg <- label.bg
cs$Env$format.labels <- format.labels
cs$Env$ticks.on <- grid.ticks.on
cs$Env$grid.ticks.lwd <- theme$grid.ticks.lwd
cs$Env$type <- type
cs$Env$axis_ticks <- function(xdata, xsubset) {
ticks <- diff(axTicksByTime2(xdata[xsubset], labels = FALSE))/2 +
last(axTicksByTime2(xdata[xsubset], labels = TRUE),
-1)
if (!theme$coarse.time || length(ticks) == 1)
return(unname(ticks))
if (min(diff(ticks)) < max(strwidth(names(ticks)))) {
ticks <- unname(ticks)
}
ticks
}
cs$add(expression(atbt <- axTicksByTime2(xdata[xsubset]),
segments(atbt, get_ylim()[[2]][1], atbt, get_ylim()[[2]][2],
col = theme$grid, lwd = grid.ticks.lwd), axt <- axis_ticks(xdata,
xsubset), text(as.numeric(axt), par("usr")[3] -
0.2 * min(strheight(axt)), names(axt), xpd = TRUE,
cex = 0.9, pos = 3)), clip = FALSE, expr = TRUE)
cs$set_frame(-1)
cs$add_frame(0, ylim = c(0, 1), asp = 0.2)
cs$set_frame(1)
cs$add(expression(if (NROW(xdata[xsubset]) < 400) {
axis(1, at = 1:NROW(xdata[xsubset]), labels = FALSE,
col = theme$grid2, tcl = 0.3)
}), expr = TRUE)
cs$add(expression(axt <- axTicksByTime(xdata[xsubset], format.labels = format.labels),
axis(1, at = axt, labels = names(axt), las = 1, lwd.ticks = 1,
mgp = c(3, 1.5, 0), tcl = -0.4, cex.axis = 0.9)),
expr = TRUE)
cs$Env$name <- name
text.exp <- c(expression(text(1 - 1/3, 0.5, name, font = 2,
col = "#444444", offset = 0, cex = 1.1, pos = 4)), expression(text(NROW(xdata[xsubset]),
0.5, paste(format(start(xdata[xsubset]), format = '%Y.%m.%d'),
format(end(xdata[xsubset]), format = '%Y.%m.%d'),
sep = " / "), col = 1, adj = c(0, 0), pos = 2)))
cs$add(text.exp, env = cs$Env, expr = TRUE)
cs$set_frame(2)
cs$Env$axis_labels <- function(xdata, xsubset, scale = 5) {
axTicksByValue(na.omit(xdata[xsubset]))
}
cs$Env$make_pretty_labels <- function(ylim) {
p <- pretty(ylim, 10)
p[p > ylim[1] & p < ylim[2]]
}
cs$add(expression(assign("alabels", make_pretty_labels(get_ylim(get_frame())[[2]]))),
expr = TRUE)
cs$set_frame(-2)
cs$add(expression(if (diff(range(xdata[xsubset], na.rm = TRUE)) <
50) segments(1, seq(min(xdata[xsubset]%/%1, na.rm = TRUE),
max(xdata[xsubset]%/%1, na.rm = TRUE), 1), length(xsubset),
seq(min(xdata[xsubset]%/%1, na.rm = TRUE), max(xdata[xsubset]%/%1,
na.rm = TRUE), 1), col = theme$grid2, lty = "dotted")),
expr = TRUE)
cs$set_frame(2)
cs$add(expression(segments(1, alabels, NROW(xdata[xsubset]),
alabels, col = theme$grid)), expr = TRUE)
if (theme$lylab) {
cs$add(expression(text(1 - 1/3 - max(strwidth(alabels)),
alabels, noquote(format(alabels, justify = "right")),
col = theme$labels, offset = 0, cex = 0.9, pos = 4,
xpd = TRUE)), expr = TRUE)
}
if (theme$rylab) {
cs$add(expression(text(NROW(xdata[xsubset]) + 1/3, alabels,
noquote(format(alabels, justify = "right")), col = theme$labels,
offset = 0, cex = 0.9, pos = 4, xpd = TRUE)), expr = TRUE)
}
cs$set_frame(2)
cs$add(expression(range.bars(xdata[xsubset], type, 1, fade(theme$line.col,
clev), fade(theme$up.col, clev), fade(theme$dn.col,
clev), fade(theme$up.border, clev), fade(theme$dn.border,
clev))), expr = TRUE)
assign(".chob", cs, .plotEnv)
if (!is.null(TA) && nchar(TA) > 0) {
TA <- parse(text = TA, srcfile = NULL)
for (ta in seq_along(TA)) {
cs <- eval(TA[ta], envir = parent.frame())
}
}
assign(".chob", cs, .plotEnv)
cs
}
environment(plotquant) <- asNamespace("quantmod")
ct <- chart_theme()
ct$format.labels <- ' '
plotquant(BRS, theme = ct)
