Skip to content

Commit ef6e969

Browse files
nakim12nakim12
committed
Added allocation lab and updated readme
1 parent 92d1d97 commit ef6e969

7 files changed

Lines changed: 418 additions & 11 deletions

File tree

‎DESCRIPTION‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ Encoding: UTF-8
1010
Imports:
1111
dplyr,
1212
forecast,
13+
quadprog,
1314
ggplot2,
1415
quantmod,
1516
reshape2,

‎R/allocation.R‎

Lines changed: 136 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,136 @@
1+
# Allocation Lab: long-only min-variance (quadprog) and heuristic portfolios.
2+
3+
regularize_cov <- function(Sigma) {
4+
S <- (Sigma + t(Sigma)) / 2
5+
n <- nrow(S)
6+
ev <- eigen(S, symmetric = TRUE)$values
7+
eps <- max(1e-10, 1e-4 * max(abs(ev), 1e-12))
8+
if (length(ev) && min(ev) < eps) {
9+
S <- S + diag(n) * (eps - min(ev))
10+
}
11+
S
12+
}
13+
14+
# Long-only min variance; max_w in (0,1] caps each weight (1 = no cap).
15+
alloc_min_variance <- function(Sigma, max_w = 1) {
16+
n <- nrow(Sigma)
17+
if (n <= 1L) {
18+
nm <- colnames(Sigma)
19+
if (is.null(nm) || !length(nm)) nm <- rownames(Sigma)
20+
if (is.null(nm) || !length(nm)) nm <- "x"
21+
return(stats::setNames(1, nm[[1]]))
22+
}
23+
24+
S <- regularize_cov(Sigma)
25+
Dmat <- 2 * S
26+
dvec <- rep(0, n)
27+
28+
Amat <- cbind(matrix(1, n, 1), diag(n))
29+
bvec <- c(1, rep(0, n))
30+
meq <- 1L
31+
32+
if (max_w < 1 - 1e-8) {
33+
Amat <- cbind(Amat, -diag(n))
34+
bvec <- c(bvec, rep(-max_w, n))
35+
}
36+
37+
fit <- tryCatch(
38+
quadprog::solve.QP(Dmat, dvec, Amat, bvec, meq = meq),
39+
error = function(e) NULL
40+
)
41+
if (is.null(fit)) {
42+
w <- rep(1 / n, n)
43+
} else {
44+
w <- pmax(fit$solution, 0)
45+
}
46+
if (sum(w) < 1e-12) w <- rep(1 / n, n)
47+
w <- w / sum(w)
48+
nm <- colnames(Sigma)
49+
if (is.null(nm)) nm <- rownames(Sigma)
50+
stats::setNames(w, nm)
51+
}
52+
53+
alloc_inverse_volatility <- function(Sigma) {
54+
n <- nrow(Sigma)
55+
v <- sqrt(pmax(diag(Sigma), 1e-16))
56+
w <- 1 / v
57+
w <- w / sum(w)
58+
nm <- colnames(Sigma)
59+
if (is.null(nm)) nm <- rownames(Sigma)
60+
stats::setNames(w, nm)
61+
}
62+
63+
alloc_equal_weight <- function(tickers) {
64+
n <- length(tickers)
65+
stats::setNames(rep(1 / n, n), tickers)
66+
}
67+
68+
# Unconstrained tangency then clip & renormalize (approximate long-only max Sharpe).
69+
alloc_max_sharpe_projected <- function(Sigma, mu) {
70+
n <- length(mu)
71+
if (n <= 1L) {
72+
nm <- names(mu)
73+
if (is.null(nm) || !length(nm)) nm <- "x"
74+
return(stats::setNames(1, nm[[1]]))
75+
}
76+
77+
S <- regularize_cov(Sigma)
78+
w <- tryCatch(
79+
as.numeric(solve(S) %*% mu),
80+
error = function(e) rep(1 / n, n)
81+
)
82+
w <- pmax(w, 0)
83+
if (sum(w) < 1e-12) w <- rep(1 / n, n)
84+
w <- w / sum(w)
85+
stats::setNames(w, names(mu))
86+
}
87+
88+
compute_mu_sigma_annual <- function(price_data, tickers) {
89+
tickers <- unique(tickers)
90+
pd <- price_data %>% filter(ticker %in% tickers)
91+
rw <- returns_wide_from_price_data(pd)
92+
nm <- intersect(tickers, setdiff(names(rw), "date"))
93+
if (length(nm) < 1L) return(NULL)
94+
95+
rw <- rw %>% select(date, dplyr::all_of(nm)) %>% drop_na()
96+
if (nrow(rw) < 5L) return(NULL)
97+
98+
X <- as.matrix(rw[, nm, drop = FALSE])
99+
mu_ann <- colMeans(X, na.rm = TRUE) * 252
100+
sigma_ann <- stats::cov(X, use = "pairwise.complete.obs") * 252
101+
dimnames(sigma_ann) <- list(nm, nm)
102+
names(mu_ann) <- nm
103+
list(mu = mu_ann, Sigma = sigma_ann, n_days = nrow(rw))
104+
}
105+
106+
align_weights <- function(w, tickers) {
107+
w <- w[tickers]
108+
w[is.na(w)] <- 0
109+
w / sum(w)
110+
}
111+
112+
portfolio_ann_metrics <- function(w, mu, Sigma) {
113+
nm <- names(w)
114+
w <- as.numeric(w)
115+
mu_v <- as.numeric(mu[nm])
116+
Sig <- Sigma[nm, nm, drop = FALSE]
117+
er <- sum(w * mu_v)
118+
vol <- sqrt(max(0, as.numeric(t(w) %*% Sig %*% w)))
119+
sharpe <- if (vol > 1e-12) er / vol else NA_real_
120+
list(ann_return = er, ann_vol = vol, sharpe = sharpe)
121+
}
122+
123+
propose_allocation <- function(method, Sigma, mu, max_w = 1) {
124+
tickers <- colnames(Sigma)
125+
if (is.null(tickers)) tickers <- rownames(Sigma)
126+
out <- switch(
127+
method,
128+
minvar = alloc_min_variance(Sigma, max_w = max_w),
129+
invvol = alloc_inverse_volatility(Sigma),
130+
maxsharpe_proj = alloc_max_sharpe_projected(Sigma, mu[tickers]),
131+
equal = alloc_equal_weight(tickers),
132+
NULL
133+
)
134+
if (is.null(out)) out <- alloc_equal_weight(tickers)
135+
out
136+
}

‎R/methodology_ui.R‎

Lines changed: 16 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -83,7 +83,22 @@ methodology_panel <- function() {
8383
"Summary stats are descriptive only."),
8484
tags$li(tags$b("Additive daily shock:"), " the same fixed ", tags$b("basis-point"), " amount is added to each selected holding’s ",
8585
"daily simple return on every day in your analysis sample; the portfolio is recomputed with fixed weights. ",
86-
"This is a mechanical sensitivity tool, not a model of how markets behave under stress.")
86+
"This is a mechanical sensitivity tool, not a model of how markets behave under stress."),
87+
tags$li(tags$b("Bootstrap fan:"), " independent resamples of the portfolio’s realized daily returns (same fixed weights) are compounded forward for a chosen horizon. ",
88+
"Bands show simulation percentiles; this is ", tags$b("not"), " a structural forecast and ignores drift, autocorrelation, and regime change.")
89+
)
90+
),
91+
92+
wellPanel(
93+
h4("Allocation Lab"),
94+
tags$ul(
95+
tags$li(tags$b("Inputs:"), " sample mean and covariance of daily simple returns on your analysis window, annualized (×252 and ×252 for cov). ",
96+
"Your current weights are compared to alternative rules on that same window only."),
97+
tags$li(tags$b("Min variance:"), " long-only, fully invested portfolio that minimizes variance subject to an optional per-name cap (solved with quadratic programming)."),
98+
tags$li(tags$b("Inverse volatility:"), " weights proportional to 1 / annualized volatility (diagonal of the estimated covariance)."),
99+
tags$li(tags$b("Equal weight:"), " 1/", tags$em("n"), " on each name in the covariance sample."),
100+
tags$li(tags$b("Max Sharpe (projected):"), " unconstrained mean–variance tangency weights, then negative weights are set to zero and the vector is renormalized. ",
101+
"That is a common heuristic, ", tags$b("not"), " the true constrained max-Sharpe solution; treat it as exploratory.")
87102
)
88103
),
89104

‎R/scenarios.R‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -108,3 +108,32 @@ holdings_tickers_in_sector <- function(holding_tickers, sector_name) {
108108
st <- stock_sectors[[sector_name]]
109109
intersect(holding_tickers, st)
110110
}
111+
112+
# Bootstrap resample of portfolio daily returns (fixed weights); descriptive fan only.
113+
bootstrap_fan_from_returns <- function(r_daily, horizon, n_sims, seed = 1L) {
114+
r <- as.numeric(r_daily)
115+
r <- r[is.finite(r)]
116+
if (length(r) < 10L) return(NULL)
117+
h <- as.integer(horizon)
118+
ns <- as.integer(n_sims)
119+
if (is.na(h) || h < 1L) return(NULL)
120+
if (is.na(ns) || ns < 20L) return(NULL)
121+
set.seed(as.integer(seed))
122+
out <- matrix(0, nrow = ns, ncol = h + 1L)
123+
for (i in seq_len(ns)) {
124+
idx <- sample.int(length(r), h, replace = TRUE)
125+
rd <- r[idx]
126+
out[i, ] <- cumprod(c(1, 1 + rd)) - 1
127+
}
128+
days <- 0:h
129+
qs <- apply(out, 2, stats::quantile,
130+
probs = c(0.05, 0.5, 0.95), na.rm = TRUE, type = 7)
131+
n_show <- min(80L, ns)
132+
list(
133+
days = days,
134+
p05 = as.numeric(qs[1, ]),
135+
p50 = as.numeric(qs[2, ]),
136+
p95 = as.numeric(qs[3, ]),
137+
sample_matrix = out[seq_len(n_show), , drop = FALSE]
138+
)
139+
}

‎README.md‎

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -8,9 +8,9 @@
88

99
## What is it?
1010

11-
**Portfolio Intelligence Lab** is a Shiny app in the browser. You define a **weighted portfolio** (tickers and weights, or a **sample template**), choose a **benchmark** such as SPY or QQQ, and pull a shared history of adjusted prices from Yahoo Finance. On top of that data you get **Diagnosis** (KPIs, insights, sector and return attribution, CSV/text exports) and **Performance** (your portfolio vs the benchmark plus per-ticker exploration). **Scenarios** replays preset stress windows and applies an optional mechanical daily return shock. **Methodology** documents definitions and limits. **Price Trend**, **Forecast** (exploratory), and **Risk Analysis** support deeper single-name views.
11+
**Portfolio Intelligence Lab** is a Shiny app in the browser. You define a **weighted portfolio** (tickers and weights, or a **sample template**), choose a **benchmark** such as SPY or QQQ, and pull a shared history of adjusted prices from Yahoo Finance. On top of that data you get **Diagnosis** (KPIs, insights, sector and return attribution, CSV/text exports) and **Performance** (your portfolio vs the benchmark plus per-ticker exploration). **Scenarios** replays preset stress windows, applies an optional mechanical daily return shock, and can draw a **bootstrap fan** from historical portfolio returns. **Allocation Lab** suggests alternative long-only weights (min-variance with optional caps, inverse vol, equal weight, projected max Sharpe) on the same window. **Methodology** documents definitions and limits. **Price Trend**, **Forecast** (exploratory), and **Risk Analysis** support deeper single-name views.
1212

13-
It is built for questions like: *How does this mix behave versus a simple passive alternative, where are the pressure points, and what happens in rough historical patches?* Start from **Build Portfolio**, then use **Diagnosis**, **Performance**, and **Scenarios** as the main portfolio story.
13+
It is built for questions like: *How does this mix behave versus a simple passive alternative, where are the pressure points, and what happens in rough historical patches?* Start from **Build Portfolio**, then use **Diagnosis**, **Performance**, **Scenarios** (including optional bootstrap fan), and **Allocation Lab** for alternative weighting ideas on the same data window.
1414

1515
---
1616

@@ -25,7 +25,7 @@ Brokerage apps show **positions** and **P&L**. They rarely help you **compare yo
2525
1. **Define** — Tickers, weights (normalized to 100%), optional sample templates, benchmark (SPY, QQQ, VTI, DIA).
2626
2. **Load** — Daily adjusted prices via Yahoo Finance (`quantmod`); you pick the analysis window on the app.
2727
3. **Diagnose** — Portfolio-level risk/return, drawdowns, rolling metrics, concentration, correlations, holding and sector attribution, plain-language insights, and optional “what to consider next” prompts; export **.txt** or **.csv** from the diagnosis header.
28-
4. **Performance & scenarios** — Cumulative paths vs benchmark; **Scenarios** for historical episode slices and additive daily bps stress on all holdings or one sector.
28+
4. **Performance, scenarios & allocation** — Cumulative paths vs benchmark; **Scenarios** for historical episodes, bps stress, and bootstrap fan; **Allocation Lab** for model weights vs yours.
2929
5. **Explore** — **Methodology** for formulas; **Price Trend**, **Forecast** (exploratory, not advice), and **Risk Analysis** for per-ticker views.
3030

3131
Everything stays in one Shiny session so you are not jumping between spreadsheets and disconnected chart tools.
@@ -38,14 +38,14 @@ Everything stays in one Shiny session so you are not jumping between spreadsheet
3838
┌─────────────────────────────────────────────────────────────┐
3939
│ Shiny client (browser) │
4040
│ Navbar: Home · Build · Diagnosis · Price Trend · Performance · │
41-
│ Scenarios · Forecast · Risk · Methodology │
41+
│ Scenarios · Allocation Lab · Forecast · Risk · Methodology │
4242
└─────────────────────────────┬───────────────────────────────┘
4343
│ reactive inputs + outputs
4444
▼
4545
┌─────────────────────────────────────────────────────────────┐
4646
│ app.R + R/ modules │
4747
│ global.R loads: config · helpers · theme · portfolio · scenarios · │
48-
│ landing · methodology │
48+
│ allocation · landing · methodology │
4949
└─────────────────────────────┬───────────────────────────────┘
5050
│ getSymbols / merges / stats
5151
▼
@@ -62,7 +62,7 @@ Everything stays in one Shiny session so you are not jumping between spreadsheet
6262
|-------|------------|
6363
| App runtime | [R](https://www.r-project.org/) + [Shiny](https://shiny.posit.co/) |
6464
| Data | `quantmod`, `zoo` |
65-
| Analytics & viz | `dplyr`, `tidyr`, `ggplot2`, `scales`, `reshape2`, `forecast` |
65+
| Analytics & viz | `dplyr`, `tidyr`, `ggplot2`, `scales`, `reshape2`, `forecast`, `quadprog` |
6666
| UX | `shinycssloaders` |
6767
| CI deploy | GitHub Actions → [shinyapps.io](https://www.shinyapps.io/) (`rsconnect`) |
6868
| Static sibling | `Investment Performance Tracker.Rmd` (original report-style analysis; not required to run the app) |
@@ -83,6 +83,7 @@ Investment-Performance-Tracker/
8383
│ ├── helpers.R
8484
│ ├── portfolio.R # Portfolio metrics, attribution, insights
8585
│ ├── scenarios.R # Stress presets & shock helpers
86+
│ ├── allocation.R # Allocation Lab optimizers (quadprog, heuristics)
8687
│ ├── landing_ui.R # Home / landing experience
8788
│ ├── methodology_ui.R # Methodology tab copy
8889
│ └── app_theme.R # Shared CSS
@@ -104,7 +105,7 @@ Investment-Performance-Tracker/
104105
```r
105106
install.packages(c(
106107
"shiny", "shinycssloaders", "quantmod", "zoo", "forecast",
107-
"tidyr", "scales", "reshape2", "dplyr", "ggplot2"
108+
"tidyr", "scales", "reshape2", "dplyr", "ggplot2", "quadprog"
108109
))
109110
```
110111

0 commit comments

Comments
 (0)