---
title: "Lab 1 — Finance Dashboard"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: scroll
theme: cosmo
social: ["menu"]
source_code: embed
params:
tickers: ["AMZN","KR","TGT","WMT"] # ← put your 4 here
lookback_days: 126 # ~6 months of trading days
---
# Conclusion {.sidebar}
* This dashboard analyzes 4 grocery type companies (Amazon, Kroger, Target and Walmart) for short-term gains.
Metrics considered:
* 5-day return (very short momentum)
* 20-day return (momentum)
* 60-day return (quarter trend)
* 20-day annualized volatility (risk)
* drawdown (risk)
* proximity to 52-week high (trend strength)
* RSI(14) (overbought/oversold)
Winner (highest composite score): Walmart, because
* Momentum favored
* Penalizing risk (volatility & drawdown)
* Rewarding price strength near 52-week highs.
```{r setup, include=FALSE}
# Apply to all chunks by default ------------------------------------------
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
suppressPackageStartupMessages({
library(tidyverse)
library(tidyquant) # tq_get (Yahoo), ggplot finance geoms
library(timetk)
library(TTR) # RSI, runSD
library(ggrepel)
library(glue)
library(flexdashboard)
library(slider) # rolling 52w high
library(dygraphs) # interactive time series + candles
library(xts) # dygraphs input
library(DT) # table widget
library(quantmod) # getQuote for fundamentals (yahooQF)
})
tickers <- params$tickers
lookback_days <- params$lookback_days
# Data helpers ----------------------------------------------------------
get_prices <- function(symbols, start = Sys.Date() - 365){
tq_get(symbols, get = "stock.prices", from = start, to = Sys.Date()) %>%
dplyr::group_by(symbol) %>% dplyr::arrange(date) %>%
dplyr::mutate(
ret_d = adjusted / dplyr::lag(adjusted) - 1,
ret_5d = adjusted / dplyr::lag(adjusted, 5) - 1,
ret_20d = adjusted / dplyr::lag(adjusted, 20) - 1,
ret_63d = adjusted / dplyr::lag(adjusted, 63) - 1,
rsi_14 = TTR::RSI(adjusted, n = 14),
vol_20d = TTR::runSD(ret_d, 20) * sqrt(252),
hi_252 = slider::slide_dbl(high, max, .before = 251, .complete = FALSE),
pct_off_52w_high = adjusted / hi_252 - 1,
cummax_p = cummax(adjusted),
drawdown = adjusted / cummax_p - 1
) %>%
dplyr::ungroup()
}
# Composite ranking that rewards momentum/strength and penalizes risk ----
rank_latest <- function(df){
latest <- df %>% dplyr::group_by(symbol) %>% dplyr::filter(date == max(date)) %>% dplyr::ungroup()
rescale01 <- function(x){
rng <- range(x, na.rm = TRUE)
if (!all(is.finite(rng)) || diff(rng) == 0) return(rep(0, length(x)))
(x - rng[1]) / diff(rng)
}
latest %>%
dplyr::mutate(
z_ret20 = rescale01(ret_20d), # ~1M momentum
z_ret5 = rescale01(ret_5d), # ~1W momentum
z_ret63 = rescale01(ret_63d), # ~3M momentum
z_rsi = rescale01(pmax(pmin(rsi_14, 70), 30)), # clamp RSI to 30–70
z_vol = rescale01(-vol_20d), # lower vol better
z_dd = rescale01(-abs(drawdown)), # smaller drawdown better
z_offhi = rescale01(-abs(pct_off_52w_high)), # closer to 52w high better
score = 0.35 * z_ret20 +
0.15 * z_ret5 +
0.15 * z_ret63 +
0.10 * z_vol +
0.10 * z_dd +
0.10 * z_offhi +
0.05 * z_rsi
) %>%
dplyr::arrange(dplyr::desc(score))
}
fmt_pct <- function(x, d = 1) scales::percent(x, accuracy = 10^-d)
# Pull & prepare --------------------------------------------------------
all_prices <- get_prices(tickers)
as_of <- max(all_prices$date, na.rm = TRUE)
recent <- dplyr::filter(all_prices, date >= as_of - lookback_days)
latest <- rank_latest(recent)
stopifnot(length(unique(recent$symbol)) == length(tickers))
best <- latest$symbol[1]
# tibble -> xts(OHLC) for dygraphs --------------------------------------
to_xts_ohlc <- function(df_sym) {
xts::xts(df_sym[, c("open","high","low","close","volume")], order.by = df_sym$date)
}
# Make return "candles" over a rolling window (default 5 days)
make_return_candles <- function(df, window = 5) {
stopifnot(all(c("symbol", "date", "ret_d") %in% names(df)))
df %>%
dplyr::group_by(symbol) %>%
dplyr::arrange(date, .by_group = TRUE) %>%
dplyr::mutate(
# Close = total return over the last <window> days
r_close = slider::slide_vec(
ret_d,
~ prod(1 + .x) - 1,
.before = window - 1,
.complete = TRUE,
.ptype = double()
),
# High/Low = best/worst cumulative return *within* the window
r_high = slider::slide_vec(
ret_d,
~ { rr <- cumprod(1 + .x) - 1; max(rr, na.rm = TRUE) },
.before = window - 1,
.complete = TRUE,
.ptype = double()
),
r_low = slider::slide_vec(
ret_d,
~ { rr <- cumprod(1 + .x) - 1; min(rr, na.rm = TRUE) },
.before = window - 1,
.complete = TRUE,
.ptype = double()
),
# Open = 0 baseline (since these are return-candles)
r_open = 0
) %>%
dplyr::ungroup() %>%
dplyr::filter(!is.na(r_close))
}
r5 <- make_return_candles(recent, window = 5)
r20 <- make_return_candles(recent, window = 20)
r60 <- make_return_candles(recent, window = 60)
plot_dy_candles <- function(sym) {
df <- recent %>%
dplyr::filter(symbol == sym) %>%
dplyr::arrange(date) %>%
dplyr::ungroup()
if (nrow(df) == 0) stop("No rows for symbol: ", sym)
ohlc_mat <- as.matrix(dplyr::select(df, open, high, low, close))
storage.mode(ohlc_mat) <- "double"
x <- xts::xts(ohlc_mat, order.by = as.Date(df$date))
colnames(x) <- c("Open","High","Low","Close")
dygraphs::dygraph(
x,
main = sym,
elementId = paste0("dy_", sym), # <- unique per tab to avoid widget clashes
width = "50%",
height = 300 # <- explicit height so hidden tabs size correctly
) %>%
dygraphs::dyCandlestick() %>%
dygraphs::dyAxis("y", label = "Price") %>%
dygraphs::dyRangeSelector(height = 40)
}
```
# Stock Diagnostic
### Amazon
#### Price Candles {data-height=60}
```{r amzn-price}
plot_dy_candles(tickers[[1]])
```
#### 5-Day Return Candles {data-height=60}
```{r}
sym <- tickers[[1]]
r5_sym <- dplyr::filter(r5, symbol == sym)
ggplot2::ggplot(
r5_sym,
ggplot2::aes(x = date, open = r_open, high = r_high, low = r_low, close = r_close)
) +
tidyquant::geom_candlestick(
size = 0.3,
fill_up = "seagreen3", fill_down = "firebrick2",
colour_up = "seagreen4", colour_down = "firebrick4"
) +
ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
ggplot2::labs(x = NULL, y = "Return (weekly window)") +
ggplot2::theme_minimal(base_size = 11)
```
### Kroger
#### Price Candles {data-height=60}
```{r kr-price}
plot_dy_candles(tickers[[2]])
```
#### 5-Day Return Candles {data-height=40}
```{r}
sym <- tickers[[2]]
r5_sym <- dplyr::filter(r5, symbol == sym)
ggplot2::ggplot(
r5_sym,
ggplot2::aes(x = date, open = r_open, high = r_high, low = r_low, close = r_close)
) +
tidyquant::geom_candlestick(
size = 0.3,
fill_up = "seagreen3", fill_down = "firebrick2",
colour_up = "seagreen4", colour_down = "firebrick4"
) +
ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
ggplot2::labs(
x = NULL, y = "Return (weekly window)"
) +
ggplot2::theme_minimal(base_size = 11)
```
### Target
#### Price Candles {data-height=60}
```{r tgt-price}
plot_dy_candles(tickers[[3]])
```
#### 5-Day Return Candles {data-height=80}
```{r}
sym <- tickers[[3]]
r5_sym <- dplyr::filter(r5, symbol == sym)
ggplot2::ggplot(
r5_sym,
ggplot2::aes(x = date, open = r_open, high = r_high, low = r_low, close = r_close)
) +
tidyquant::geom_candlestick(
size = 0.3,
fill_up = "seagreen3", fill_down = "firebrick2",
colour_up = "seagreen4", colour_down = "firebrick4"
) +
ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
ggplot2::labs(
x = NULL, y = "Return (weekly window)"
) +
ggplot2::theme_minimal(base_size = 11)
```
### Walmart
#### Price Candles {data-height=60}
```{r wmt-price}
plot_dy_candles(tickers[[4]])
```
#### 5-Day Return Candles {data-height=40}
```{r}
sym <- tickers[[4]]
r5_sym <- dplyr::filter(r5, symbol == sym)
ggplot2::ggplot(
r5_sym,
ggplot2::aes(x = date, open = r_open, high = r_high, low = r_low, close = r_close)
) +
tidyquant::geom_candlestick(
size = 0.3,
fill_up = "seagreen3", fill_down = "firebrick2",
colour_up = "seagreen4", colour_down = "firebrick4"
) +
ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
ggplot2::labs(
x = NULL, y = "Return (weekly window)"
) +
ggplot2::theme_minimal(base_size = 11)
```
# Comparison
### Ranking Table
```{r}
rank_tbl <- latest %>%
transmute(
Symbol = symbol,
`Score (0-1)` = round(score, 3),
`1W` = fmt_pct(ret_5d),
`1M` = fmt_pct(ret_20d),
`3M` = fmt_pct(ret_63d),
`Vol 20d (ann.)` = scales::percent(vol_20d, accuracy = 0.1),
`RSI(14)` = round(rsi_14, 1),
`Max Drawdown` = fmt_pct(drawdown),
`Pct off 52w High` = fmt_pct(pct_off_52w_high)
)
knitr::kable(rank_tbl, align = "lrrrrrrrr")
```
### Adjusted Close (lookback)
```{r}
recent %>%
ggplot(aes(date, adjusted, color = symbol)) +
geom_line(linewidth = 0.7) +
scale_y_continuous(labels = scales::label_dollar()) +
labs(x = NULL, y = "Price") +
theme_minimal(base_size = 12) +
theme(legend.position = "bottom")
```
### Drawdown from Recent Peak
```{r}
recent %>%
ggplot(aes(date, drawdown, color = symbol)) +
geom_line(linewidth = 0.7) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(x = NULL, y = "Drawdown") +
theme_minimal(base_size = 12) +
theme(legend.position = "bottom")
```
### Momentum vs Volatility
```{r}
recent %>%
group_by(symbol) %>%
summarize(ret20 = dplyr::last(ret_20d), vol20 = dplyr::last(vol_20d), .groups="drop") %>%
ggplot(aes(vol20, ret20, label = symbol)) +
geom_point(size = 3) +
ggrepel::geom_text_repel() +
scale_x_continuous(labels = scales::percent_format(accuracy = 0.1)) +
scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
labs(title="20d return vs 20d annualized volatility",
x="Volatility (ann.)", y="Return (20d)") +
theme_minimal(base_size=12)
```