In jbkunst/rstats-scheduled-job-gh-actions: The Job

library(flexdashboard)
library(quantmod)
library(purrr)
library(highcharter)

xs   <- c("ARKK", "FANG", "TSLA", "^GSPC")
cols <- hc_theme_smpl()$colors
cols <- cols[seq_along(xs)]


hc_opts <- getOption("highcharter.chart")

hc_opts$plotOptions <- list(
  line = list(marker = list(symbol = "circle")),
  area = list(marker = list(symbol = "circle"))
  )

options(highcharter.chart = hc_opts)

# scales::show_col(cols, borders = FALSE)

symbols <- map(xs, function(x){

  message(x)

  suppressWarnings(
    getSymbols(x, auto.assign = FALSE, from = lubridate::ymd(20200101))
  )

})

symbols %>% 
  map(tail)

data_returns <- map(symbols, allReturns) %>% 
  map(as.data.frame) %>% 
  map(tibble::rownames_to_column, var = "date") %>% 
  map(tibble::as_tibble) %>% 
  map(dplyr::mutate, date = lubridate::ymd(date)) %>% 
  map2_df(xs, ~ dplyr::mutate(.x, symbol = .y))

data_returns

tail(data_returns)

data <- symbols %>% 
  map(as.data.frame) %>% 
  map(tibble::rownames_to_column, var = "date") %>% 
  map(tibble::as_tibble) %>% 
  map(dplyr::mutate, date = stringr::str_remove(date, "X")) %>% 
  map(dplyr::mutate, date = lubridate::ymd(date)) %>% 
  map(purrr::set_names, c("date", "open", "high", "low", "close", "volume", "adjusted")) %>% 
  map2_df(xs, ~ dplyr::mutate(.x, symbol = .y))


data <- dplyr::inner_join(data, data_returns, by = c("date", "symbol"))

data <- data %>% 
  dplyr::select(date, symbol, dplyr::everything()) %>% 
  dplyr::mutate(symbol = factor(symbol, levels = xs))

tail(data)

chart_symbol <- function(s = "ARKK", ...){

  d <- data %>% 
    dplyr::filter(symbol == s) %>% 
    dplyr::select(x = date, y = adjusted) %>% 
    dplyr::filter(complete.cases(.)) %>% 
    dplyr::mutate(y = round(y, 3))

  highcharter::hchart(
    d, 
    type = "line",
    highcharter::hcaes(x, y),
    name = s,
    color = cols[which(xs == s)],
    ...
    ) %>% 
    highcharter::hc_tooltip(sort = TRUE, table = TRUE, valuePrefix = "$ ") %>% 
    highcharter::hc_add_theme(highcharter::hc_theme_smpl()) %>% 
    highcharter::hc_xAxis(title = "") %>% 
    highcharter::hc_yAxis(title = "", labels = list(format = "$ {value}")) %>% 
    highcharter::hc_rangeSelector(enabled = TRUE, inputEnabled = FALSE, selected = 4) %>% 
    highcharter::hc_navigator(enabled = TRUE)

}

chart <- function(var = "quarterly", type = "line", ...){

  # ... <- NULL

  d <- data %>% 
    dplyr::select(x = date, y = {{ var }}, group = symbol) %>% 
    dplyr::filter(complete.cases(.)) %>% 
    dplyr::mutate(y = round(y, 3))

  d

  fun_x <- switch(
    var,
    # monthly   = purrr::compose( ~ format(.x, "%Y%m"), as.character, .dir =  "forward"),
    monthly   = purrr::partial(lubridate::floor_date, unit = "month"),
    # quarterly = purrr::compose(zoo::as.yearqtr, as.character, .dir =  "forward"),
    quarterly   = purrr::partial(lubridate::floor_date, unit = "quarter"),
    # yearly    = purrr::compose(lubridate::year, as.character, .dir =  "forward"),
    yearly    =  purrr::partial(lubridate::floor_date, unit = "year"),
    identity
  )

  fun_y <- switch(
    var,
    adjusted = identity,
    function(x) x * 100
  )

  d

  d <- d %>% 
    dplyr::mutate(x = fun_x(x), y = fun_y(y))

  d

  h <- highcharter::hchart(
    d,
    type = type, 
    highcharter::hcaes(x, y, group = group), 
    showInLegend = FALSE,
    ...
    ) %>% 
    highcharter::hc_tooltip(sort = TRUE, table = TRUE, valueDecimals = 2) %>% 
    highcharter::hc_add_theme(highcharter::hc_theme_smpl()) %>% 
    highcharter::hc_xAxis(title = "") %>% 
    highcharter::hc_yAxis(title = "")

  h

  if(lubridate::is.Date(d$x)){

    h <- h %>% 
      highcharter::hc_rangeSelector(enabled = TRUE, inputEnabled = FALSE)

  }

  if(var %in% c("daily", "weekly", "monthly", "quarterly", "yearly")){

    h <- h %>% 
      hc_tooltip(valueSuffix = "%") %>% 
      hc_yAxis(
        labels = list(format = "{value}%"),
        plotLines = list(
          list(
            # label = list(text = "This is a plotLine"),
            color = "#F47174",
            width = 2,
            value = 0
            )
          )
        )

  }

  h

}

General

Row {data-height=600}

for (x in xs){

  cat("\n")

  cat(stringr::str_c("### ", x))

  cat("\n")

  print(htmltools::tagList(chart_symbol(x)))

  cat("\n")

}

Row

vars <- c("daily", "weekly", "monthly", "quarterly", "yearly")

df <- tibble::tibble(var = vars) %>%
  dplyr::mutate(type = ifelse(var %in% c("daily", "weekly"), "line", "column"))

charts <- pmap(df, chart) %>%
  set_names(vars)

for (v in vars){

  cat("\n")

  cat(stringr::str_c("### ", stringr::str_to_title(v)))

  cat("\n")

  print(htmltools::tagList(charts[[v]]))

  cat("\n")

}