Creating Charts

It is a while that I wanted to extend the candlestick chart from the tidyquant package to get a chart that was closer to what I am used to. In the process I discovered a new package that remove the blank spaces left by weekend and other holidays. The scale_x_datetime was not handling that. Thank you to David Mills, the author of the bdscale package.

Yesterday I finally stop the procrastination and went to it.

I am quite satisfy with the result. I will now re-use the function with my other shiny projects.

First I am loading the necessary libraries.

library(tidyverse)        # the usual
library(lubridate)        # to deal with dates
library(gridExtra)        # to stack the charts
library(scales)           # again to deal with dates but on the x-axis
library(bdscale)          # to remove the weekends using the scale_x_bd
thePath <- here::here()   # so I reuse the code with other projects

tickers <- readr::read_csv(paste0(thePath, "/10_energy/", "tickers.csv"))

Below is the part I have re-used from the tidyquant package. Don’t ask me here;-( I will refer you to the great people of business science

geom_candlestick <- function(mapping = NULL, data = NULL, stat = "identity",
                                position = "identity", na.rm = TRUE, show.legend = NA,
                                inherit.aes = TRUE,
                                color_up = "gray30", color_down = "gray30",
                                fill_up = "green3", fill_down = "red",
                                ...) {

    linerange <- ggplot2::layer(
        stat = StatLinerangeBC, geom = GeomLinerangeBC, data = data, mapping = mapping,
        position = position, show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(na.rm = na.rm, fill_up = fill_up, fill_down = fill_down,
                      color_up = color_up, color_down = color_down, ...)
    )

    rect <- ggplot2::layer(
        stat = StatRectCS, geom = GeomRectCS, data = data, mapping = mapping,
        position = position, show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(na.rm = na.rm, fill_up = fill_up, fill_down = fill_down,
                      color_up = color_up, color_down = color_down, ...)
    )

    list(linerange, rect)
}

StatLinerangeBC <- ggplot2::ggproto("StatLinerangeBC", Stat,
                                    required_aes = c("x", "open", "high", "low", "close"),

                                    compute_group = function(data, scales, params,
                                                             fill_up, fill_down,
                                                             color_up, color_down) {

                                        data <-  data %>%
                                            dplyr::mutate(color = ifelse(open < close, color_up, color_down))

                                        tibble::tibble(x = data$x,
                                                       ymin = data$low,
                                                       ymax = data$high,
                                                       colour = data$color)
                                    })


StatRectCS <- ggplot2::ggproto("StatRectCS", Stat,
                                required_aes = c("x", "open", "high", "low", "close"),

                                compute_group = function(data, scales, params,
                                                         fill_up, fill_down,
                                                         color_up, color_down) {

                                    data <-  data %>%
                                        dplyr::mutate(fill = ifelse(open < close, fill_up, fill_down),
                                                      ymin = ifelse(open < close, open, close),
                                                      ymax = ifelse(open < close, close, open))

                                    tibble::tibble(xmin = data$x - 0.45,
                                                   xmax = data$x + 0.45,
                                                   ymin = data$ymin,
                                                   ymax = data$ymax,
                                                   fill = data$fill)
                                })


GeomRectCS <- ggproto("GeomRectCS", GeomRect,
                      default_aes = aes(colour = NA,
                                        size = 0.5,
                                        linetype = 1,
                                        alpha = NA))


GeomLinerangeBC <- ggproto("GeomLinerangeBC", GeomLinerange,
                           default_aes = aes(size = 0.5,
                                             linetype = 1,
                                             alpha = NA))

To organize my data, I have a .csv file with all the Companies name in the energy sector I am interested in looking into.

glimpse(tickers)
## Observations: 122
## Variables: 9
## $ yahoo_ticker          <chr> "DO", "DRQ", "RIG", "UNT", "WFT", NA, "O...
## $ av_ticker             <chr> "DO", "DRQ", "RIG", "UNT", "WFT", "HP", ...
## $ ticker_name           <chr> "Diamond Offshore Drilling, Inc.", "Dril...
## $ ticker_stock_exchange <chr> "NYSE", "NYSE", "NYSE", "NYSE", "NYSE", ...
## $ ticker_industry       <chr> "oil_gas", "oil_gas", "oil_gas", "oil_ga...
## $ ticker_sector         <chr> "energy_equipment_services", "energy_equ...
## $ ticker_subsector      <chr> "drilling", "drilling", "drilling", "dri...
## $ GISC_Code             <int> 101010, 101010, 101010, 101010, 101010, ...
## $ ETF                   <chr> "VDE", "VDE", "VDE", "VDE", "VDE", "XLE"...

Using the Alphavantage API, I download all past data for each stocks and save it as .csv into a folder using a loop.

The next step is the one related to the graphing of charts. I wrap the whole df creation and ploting process within a function. Easier to use for later. I have commented the code for understanding.

create_candlestick <- function(tickerss){
df <- read_csv(paste0(thePath, "/10_energy/StockData_av/", tickerss, ".csv"))
df$Index <- ymd(df$Index)
 
#for the ADX
yo <- TTR::ADX(df[,3:5], n = 13) %>% as_tibble() %>% select(-DX)

# Adding the other variables such a moving averages and relative strength index
df3 <- df %>% 
  mutate(sma200 = TTR:: SMA(Close, 200), 
         sma50 = TTR::SMA(Close, 50), 
         ema9 = TTR::EMA(Close, 9), 
         rsi14 = TTR::RSI(Close, 14), 
         rsi5 = TTR::RSI(Close, 5), 
         ppo_line = (TTR::EMA(Close, n = 12) - TTR::EMA(Close, n = 26)) / TTR::EMA(Close, n = 26) * 100, 
         ppo_signal = TTR::EMA(ppo_line, n = 9)) 

df2 <- bind_cols(df3, yo) %>% 
  filter(Index >= today() - 400)


# The main chart with the moving averages
p1 <- ggplot(df2, aes(x=Index, y = Close)) + 
  geom_candlestick(aes(open = Open, high = High, low = Low, close = Close)) + 
  geom_line(aes(y = ema9), color = "red", size = 0.2) + 
  geom_line(aes(y = sma200), color = "darkorchid1", size = 0.3) + 
  # because I need to remember which chart is it (to which stock it belongs)
  annotate("text", x = df2$Index[10], y = 1.1 * df2$Close[10], label = tickerss, color = "white") + 
  geom_line(aes(y = sma50), color = "Turquoise 1", size = 0.3) + 
  scale_x_bd(business.dates=df2$Index, max.major.breaks = 20, labels=date_format("%b '%y"), expand = c(0,0.3)) + 
  scale_y_continuous(sec.axis = sec_axis(~.*1)) + 
  theme(axis.title.x = element_blank(), 
        axis.text.x = element_blank(), 
        axis.text.y = element_text(angle = 90), 
        plot.margin = margin(0.2, 0.2, 0.1, 0.4, "cm"),       # This is to shrink the padding at the 4 side of the graph
        panel.background = element_rect(fill = "black"), 
        plot.background = element_rect(fill = "Gray 65"), 
        panel.grid.major.x = element_line(color = "white", linetype = "dotted", size = 0.2), 
        panel.grid.major.y = element_line(color = "white", linetype = "dotted", size = 0.2),
        panel.grid.minor = element_blank())

# graphing of the ppo part.  
p2 <- ggplot(df2, aes(x = Index)) + 
  geom_line(aes(y = ppo_signal, color = "darkorchid1"), size = 0.4) + 
  geom_line(aes(y = ppo_line, color = "Royal Blue 1"), size = 0.5) + 
  geom_hline(yintercept = 0, color = "red", linetype = "dashed", size = 0.3) + 
  scale_y_continuous(sec.axis = sec_axis(~.*1)) + 
  scale_x_bd(business.dates=df2$Index, max.major.breaks = 20, labels=date_format("%b '%y"), expand = c(0,0.1)) + 
  ylab("PPO") + 
  theme(legend.position = "none",  
        axis.title.x = element_blank(), 
        axis.text.x = element_blank(), 
        axis.text.y = element_text(angle = 90), 
        plot.margin = margin(0, 0.2, 0.1, 0.4, "cm"), 
        panel.background = element_rect(fill = "black"), 
        plot.background = element_rect(fill = "Gray 65"), 
        panel.grid.major.x = element_line(color = "white", linetype = "dotted", size = 0.2), 
        panel.grid.major.y = element_line(color = "white", linetype = "dotted", size = 0.1),
        panel.grid.minor = element_blank())

p4 <- ggplot(df2, aes(x = Index)) + 
  geom_line(aes(y = DIp), color = "Turquoise 1", size = 0.2) + 
  geom_line(aes(y = DIn), color = "red", size = 0.2) + 
  geom_line(aes(y = ADX), color = "Gray 70", size = 0.3) + 
  scale_y_continuous(sec.axis = sec_axis(~.*1)) + 
  scale_x_bd(business.dates=df2$Index, max.major.breaks = 20, labels=date_format("%b '%y"), expand = c(0,0.1)) + 
  ylab("ADX") + 
  theme(legend.position = "none",  
        axis.title.x = element_blank(), 
        axis.text.x = element_blank(), 
        axis.text.y = element_text(angle = 90), 
        plot.margin = margin(0, 0.2, 0.1, 0.4, "cm"), 
        panel.background = element_rect(fill = "black"), 
        plot.background = element_rect(fill = "Gray 65"), 
        panel.grid.major.x = element_line(color = "white", linetype = "dotted", size = 0.2), 
        panel.grid.major.y = element_line(color = "white", linetype = "dotted", size = 0.1),
        panel.grid.minor = element_blank())
  

p3 <- ggplot(df2, aes(x = Index)) + 
  geom_line(aes(y = rsi14, color = "Dark Orange")) + 
  geom_line(aes(y = rsi5, color = "Gray 80"), linetype = "dotted", size = 0.4) + 
  scale_x_bd(business.dates=df2$Index, max.major.breaks = 20, labels=date_format("%b '%y"), expand = c(0,0.5)) + 
  scale_y_continuous(sec.axis = sec_axis(~.)) + 
  ylab("RSI") + 
  theme(legend.position = "none", 
        axis.title.x = element_blank(),
        axis.text.y = element_text(angle = 90), 
        axis.text.x = element_text(angle = 60, vjust = 0.5), 
        plot.margin = margin(0.0, 0.2, 0.2, 0.4, "cm"), 
        panel.background = element_rect(fill = "black"), 
        plot.background = element_rect(fill = "Gray 65"), 
        panel.grid.major.x = element_line(color = "white", linetype = "dotted", size = 0.2), 
        panel.grid.major.y = element_line(color = "white", linetype = "dotted", size = 0.2),
        panel.grid.minor = element_blank())

yo <- grid.arrange(p1, p2, p4, p3, ncol = 1, heights = c(2.5, 1, 1, 1))
yo
}

create_candlestick("CANE")

## TableGrob (4 x 1) "arrange": 4 grobs
##   z     cells    name           grob
## 1 1 (1-1,1-1) arrange gtable[layout]
## 2 2 (2-2,1-1) arrange gtable[layout]
## 3 3 (3-3,1-1) arrange gtable[layout]
## 4 4 (4-4,1-1) arrange gtable[layout]

The whole purpose of that function was for me to go over many charts at one go and see the one that stood up to me. So now I will run that functions over a loop to save all these charts into one pdf file.

pdf("oil_gazzz.pdf", width=13, height=8)

for (i in 1:100){
  create_candlestick(tickers$av_ticker[i])
}
dev.off()

I hope you found it useful.