🔨 Charting Updates

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("$",chart_theme)
+S3method(.DollarNames,chart_theme)
 S3method(abandoned_baby,data.frame)
 S3method(abandoned_baby,default)
 S3method(abandoned_baby,matrix)
@@ -202,6 +204,7 @@ S3method(in_neck,data.frame)
 S3method(in_neck,default)
 S3method(in_neck,matrix)
 S3method(in_neck,plotly)
+S3method(indicator,"function")
 S3method(intraday_movement_index,data.frame)
 S3method(intraday_movement_index,default)
 S3method(intraday_movement_index,matrix)
@@ -754,6 +757,7 @@ export(rolling_standard_deviation)
 export(rolling_sum)
 export(rolling_variance)
 export(separating_lines)
+export(set_theme)
 export(shooting_star)
 export(short_line)
 export(simple_moving_average)
@@ -791,4 +795,5 @@ export(weighted_close_price)
 export(weighted_moving_average)
 export(williams_oscillator)
 export(xside_gap_3_methods)
+importFrom(utils,.DollarNames)
 useDynLib(talib, .registration = TRUE)

R/chart.R

@@ -43,8 +43,8 @@ chart <- function(
 	## without passing 'x'
 	if (missing(x)) {
 		rm(
-			list = ls(envir = .plotting_environment, all.names = TRUE),
-			envir = .plotting_environment
+			list = ls(envir = .chart_environment, all.names = TRUE),
+			envir = .chart_environment
 		)
 
 		return(invisible(NULL))
@@ -88,10 +88,10 @@ chart.default <- function(
 		chart_title <- title
 	}
 	.color_values <- .chart_theme()
-	.plotting_environment$sub <- .plotting_environment$chart <- list()
+	.chart_environment$sub <- .chart_environment$chart <- list()
 
 	## convert input to data.frame object
-	## and store in the .plotting_environment
+	## and store in the .chart_environment
 	## to avoid having to pass OHLC on every call
 	##
 	## NOTE: it is also a hard requirement on
@@ -113,8 +113,8 @@ chart.default <- function(
 	} else {
 		idx
 	}
-	.plotting_environment$x <- data_frame <- x
-	.plotting_environment$idx <- list(
+	.chart_environment$x <- data_frame <- x
+	.chart_environment$idx <- list(
 		label = x$idx,
 		index = seq_along(x$idx)
 	)
@@ -128,75 +128,90 @@ chart.default <- function(
 	assert(is.character(type) && length(type) == 1)
 	assert(type %in% c("candlestick", "ohlc"))
 
-	price_chart <- plotly::plot_ly(
+	candle_style <- function(
+		bull_candle,
+		bear_candle,
+		line_width,
+		alpha = 1
+	) {
+		side <- function(col) {
+			list(
+				line = list(
+					color = col,
+					width = line_width
+				),
+				fillcolor = plotly::toRGB(
+					col,
+					alpha = alpha
+				)
+			)
+		}
+
+		list(
+			increasing = side(bull_candle),
+			decreasing = side(bear_candle)
+		)
+	}
+
+	base <- plotly::plot_ly(
 		data = data_frame,
-		type = type,
 		x = ~idx,
 		open = ~open,
 		close = ~close,
 		high = ~high,
 		low = ~low,
+		showlegend = FALSE,
+		...
+	)
 
-		## colors of bullish
-		## and bearish candles/bars
-		##
-		## NOTE: if fillcolor is NULL
-		##       the candles are hollow.
-		##       If there is eventual demand this can be changed
-		increasing = list(
-			line = list(
-				color = .color_values$bull_color,
-				width = 3 - 1.75
-			),
-			fillcolor = plotly::toRGB(
-				x = .color_values$bull_color,
-				alpha = 1 ## This should be controlled from .chart_theme()
+	border_chart <- do.call(
+		plotly::add_trace,
+		c(
+			list(p = base, type = type),
+			candle_style(
+				.chart_variables$bullish_border,
+				.chart_variables$bearish_border,
+				line_width = 2
 			)
-		),
-		decreasing = list(
-			line = list(
-				color = .color_values$bear_color,
-				width = 3 - 1.75
-			),
+		)
+	)
 
-			fillcolor = plotly::toRGB(
-				x = .color_values$bear_color,
-				alpha = 1 ## This should be controlled from .chart_theme()
+	price_chart <- do.call(
+		plotly::add_trace,
+		c(
+			list(
+				p = border_chart,
+				type = type
+			),
+			candle_style(
+				.chart_variables$bullish_body,
+				.chart_variables$bearish_body,
+				line_width = 1
 			)
-		),
-
-		## remove legend
-		## there is no reason to display
-		## it in the legend.
-		##
-		## If there is demand for it we can
-		## implement a heuristic to determine intervals
-		## for 1h, 2h, etc. Similar to {cryptoQuotes}
-		showlegend = FALSE,
-		...
+		)
 	)
 
 	## construct chart meta data
 	##
 	## There is no relevant information in the range 1:N
 	## so if the rownames only contrains integers the chart will
 	## skip it
-	if (is.integer(.plotting_environment$idx$label)) {
+	if (is.integer(.chart_environment$idx$label)) {
 		title_text <- sprintf(
-			fmt = "<b>Ticker:</b> %s <span style='font-size:50%%;'><b>N:</b> %d </span>",
+			fmt = "%s <span style='font-size:10;'><b>N:</b> %d </span>",
 			chart_title,
 			nrow(x)
 		)
 	} else {
 		title_text <- sprintf(
-			fmt = "<b>Ticker:</b> %s <span style='font-size:50%%;'><b>N:</b> %d <b>Period:</b> %s</span>",
+			fmt = "%s <span style='font-size:10;'><b>N:</b> %d <b>Period:</b> %s</span>",
 			chart_title,
 			nrow(x),
 			paste(
-				.plotting_environment$idx$label[1],
+				.chart_environment$idx$label[1],
 				"-",
-				.plotting_environment$idx$label[length(
-					.plotting_environment$idx$label
+				.chart_environment$idx$label[length(
+					.chart_environment$idx$label
 				)]
 			)
 		)
@@ -216,16 +231,22 @@ chart.default <- function(
 		},
 		function(p) layout_font(p),
 		function(p) layout_legend(p),
-		function(p) add_last_value(p, data = data_frame, remove_cols = "volume")
+		function(p) {
+			add_last_value(
+				p,
+				data = data_frame
+			)
+		},
+		function(p) layout_color(p)
 	)
 
-	.plotting_environment$main <- Reduce(
+	.chart_environment$main <- Reduce(
 		f = function(p, f) f(p),
 		x = fns,
 		init = price_chart
 	)
 
 	layout_settings(
-		.plotting_environment$main
+		.chart_environment$main
 	)
 }

R/chart_elements.R

@@ -13,7 +13,7 @@ add_title <- function(
 		yref = "paper",
 		showarrow = FALSE,
 		font = list(
-			size = 16 *
+			size = 14 *
 				getOption(
 					"talib.chart.scale",
 					default = 1
@@ -37,29 +37,34 @@ add_limit <- function(
 add_last_value <- function(
 	p,
 	data,
-	remove_cols = NULL
+	values_to_extract = c("open", "high", "low", "close")
 ) {
 	## construct last value
 	## text
 	last_values <- data[
 		nrow(data),
 		grep(
 			x = colnames(data),
-			pattern = paste(
-				c("idx", remove_cols),
-				collapse = "|"
-			),
+			pattern = paste0(values_to_extract, collapse = "|"),
 			value = TRUE,
-			invert = TRUE,
+			invert = FALSE,
 			ignore.case = TRUE
-		)
+		),
+		drop = FALSE
 	]
 
-	value_text <- paste0(
-		"<b>",
-		colnames(last_values),
-		"</b>: ",
+	## extract values
+	## and names
+	values <- vapply(
 		last_values,
+		function(col) col[[1]],
+		numeric(1)
+	)
+
+	ohlc <- names(values)
+
+	value_text <- paste(
+		sprintf("<b>%s:</b> %.2f", ohlc, values),
 		collapse = " "
 	)
 

R/chart_indicator.R

@@ -15,7 +15,13 @@
 #' @example man/examples/indicator.R
 #'
 #' @author Serkan Korkmaz
+#' @export
 indicator <- function(FUN, ...) {
+	UseMethod("indicator")
+}
+
+#' @export
+indicator.function <- function(FUN, ...) {
 	## resolve function name of no
 	## title have been passed
 	title <- input_name(
@@ -42,7 +48,7 @@ indicator <- function(FUN, ...) {
 	## locate the main chart
 	## NOTE: if its not there we might need
 	##       to initialize a new
-	plt <- .plotting_environment$main
+	plt <- .chart_environment$main
 
 	if (is.null(plt)) {
 		chart_called <- FALSE
@@ -70,7 +76,7 @@ indicator <- function(FUN, ...) {
 			)
 		}
 
-		.plotting_environment$idx$label <- idx
+		.chart_environment$idx$label <- idx
 	}
 
 	## construct {plotly}-object
@@ -102,7 +108,7 @@ indicator <- function(FUN, ...) {
 	}
 
 	if (chart_called) {
-		panels <- c(list(.plotting_environment$main), .plotting_environment$sub)
+		panels <- c(list(.chart_environment$main), .chart_environment$sub)
 		n <- length(panels)
 		main_h <- getOption("talib.chart.main", 0.7)
 		heights <- if (n > 1) {
@@ -125,10 +131,10 @@ indicator <- function(FUN, ...) {
 				tickmode = "auto"
 			)
 		)
-		.plotting_environment$chart <- fig
+		.chart_environment$chart <- fig
 
 		return(
-			layout_settings(fig)
+			layout_axis(layout_color(layout_settings(fig)))
 		)
 	}
 
@@ -140,5 +146,5 @@ indicator <- function(FUN, ...) {
 	# 	idx = if (is.null(idx)) 1:nrow(data) else idx
 	# )
 
-	layout_settings(outcome)
+	layout_axis(layout_color(layout_settings(outcome)))
 }