Stock Diagnostic

Amazon

Price Candles

5-Day Return Candles

Kroger

Price Candles

5-Day Return Candles

Target

Price Candles

5-Day Return Candles

Walmart

Price Candles

5-Day Return Candles

Comparison

Ranking Table

Symbol Score (0-1) 1W 1M 3M Vol 20d (ann.) RSI(14) Max Drawdown Pct off 52w High
WMT 1.000 3.8% 3.7% 12.9% 20.1% 70.8 0.0% -0.7%
KR 0.777 3.4% 3.6% -3.4% 23.6% 59.0 -6.5% -7.7%
TGT 0.312 -0.3% -0.8% -11.3% 23.6% 46.7 -42.5% -44.9%
AMZN 0.203 -2.4% -7.5% -3.0% 26.2% 41.5 -10.6% -10.8%

Adjusted Close (lookback)

Drawdown from Recent Peak

Momentum vs Volatility

---
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)

```