---
title: "Getting started: invariants on the run_case() object"
output:
  rmarkdown::html_vignette:
    toc: true
    number_sections: true
vignette: >
  %\VignetteIndexEntry{Getting started: invariants on the run_case() object}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)
```

## Purpose

The objective of this vignette is to provide a transparent and reproducible walkthrough of the internal mechanics of a *Discounted Cash Flow* (DCF) simulation as implemented in the `cre.dcf` package.  
Rather than focusing on the investment output itself, this document serves as a **didactic exploration of model identities** - the internal accounting relationships and mathematical consistencies that ensure the financial logic of a DCF model is sound.

The vignette therefore acts as a *conceptual testbench* for doctoral or professional audiences interested in the structure of CRE valuation models, combining both computational validation and economic interpretation.  

More specifically, it demonstrates how the function `run_case()` produces a complete and self-contained case object, and how several key invariants can be verified on that object:

1. **Temporal consistency** - a single exit event occurs exactly at the end of the investment horizon, ensuring that terminal value is not double-counted.  
2. **Net Present Value (NPV) identity** - the NPV computed manually from discounted cash flows matches the value reported by the model, within numerical tolerance.  
3. **Internal Rate of Return (IRR) identity** - the IRR derived by solving the NPV equation equals the IRR reported by the package, verifying the link between NPV and IRR definitions.  
4. **Discounting logic** - the discount factors used in the model evolve monotonically and are consistent with the accumulation factors applied internally.  
5. **Accounting and pricing sanity checks** - key quantities such as *Net Operating Income (NOI)* and acquisition price are positive and coherent across data tables.  
6. **Synthesis of results** - comparison between *unlevered* (project-level) and *levered* (equity-level) indicators illustrates the effect of financial leverage on performance metrics.

Each section mirrors a fundamental identity or control equation that professional valuation models must satisfy.  
By executing the vignette, the user not only confirms the internal coherence of `cre.dcf`, but also **learns how each financial identity can be derived and verified** directly from the output data, without relying on opaque helper functions.

In an academic context, this vignette can be used to:

- teach the conceptual underpinnings of DCF modelling (NPV–IRR equivalence, discount factor dynamics, exit timing),
- illustrate how computational reproducibility supports transparency in financial geography or real-estate finance research,  
- serve as a template for developing *validation notebooks* that accompany empirical models.

In sum, this vignette transforms a basic test of numerical consistency into a **learning exercise on the epistemology of valuation**: it makes explicit the quantitative structure that underlies every DCF calculation - how time, cash flow, and capital are formally related through the principle of present value.

## 1. Build a case

```{r}
library(cre.dcf)
library(yaml)
library(dplyr)

path <- system.file("extdata", "preset_default.yml", package = "cre.dcf")
stopifnot(nzchar(path))

cfg  <- yaml::read_yaml(path)
case <- run_case(cfg)

ae     <- case$all_equity
al     <- case$leveraged
cf_all <- case$cashflows

stopifnot(
is.list(ae),
is.list(al),
is.data.frame(ae$cashflows),
is.data.frame(al$cashflows),
is.data.frame(cf_all)
)

cfe <- ae$cashflows
stopifnot(all(c("year", "free_cash_flow", "sale_proceeds") %in% names(cfe)))


```

## 2. Exit occurs once at the final year (all-equity)

A critical temporal invariant in single-asset DCF models is the uniqueness and timing of the exit event.
For the all-equity case, sale proceeds should appear once and only once, in the final year of the projection.

```{r}
## 2. Exit occurs once at the final year (all-equity)

t         <- cfe$year
exit_rows <- which(cfe$sale_proceeds > 0)

# Checks: a single exit, and it occurs at the last period

stopifnot(length(exit_rows) == 1L)
stopifnot(exit_rows == which.max(t))

# ---- Display results for pedagogical clarity ----

exit_year    <- t[exit_rows]
sale_value   <- cfe$sale_proceeds[exit_rows]
free_cf_exit <- cfe$free_cash_flow[exit_rows]

cat(
"\nExit event diagnostics:\n",
sprintf("• Number of exit events detected: %d (should be 1)\n", length(exit_rows)),
sprintf("• Exit year (expected last period): %d\n", exit_year),
sprintf("• Sale proceeds at exit: %s\n",
formatC(sale_value, format = 'f', big.mark = " ")),
sprintf("• Free cash flow in the exit year (before sale): %s\n",
formatC(free_cf_exit, format = 'f', big.mark = " ")),
sprintf("• Maximum year in series: %d\n", max(t)),
if (exit_year == max(t))
"✓ Exit correctly occurs in the final year.\n"
else
"✗ Exit NOT in final year - investigate configuration.\n"
)

```

This test guarantees that the terminal value is not double-counted and that all intermediate cash flows are properly separated from the exit event.

## 3. IRR identity (all-equity): IRR is the root of NPV = 0

By definition, the IRR is the discount rate that sets the NPV of the cash-flow stream to zero.
This section reconstructs that relationship explicitly and verifies that the IRR computed via root finding coincides with the IRR reported by run_case().

```{r}
## 4. IRR identity (all-equity): verifying that IRR is the root of NPV = 0

# 4.1 Build cash-flow vector (t = year)

stopifnot(is.integer(cfe$year) || is.numeric(cfe$year))
stopifnot(min(cfe$year) == 0)  # ensure the time origin is correct

flows <- cfe$free_cash_flow
last  <- which.max(cfe$year)

# Add sale proceeds to the last period's free cash flow
flows[last] <- flows[last] + cfe$sale_proceeds[last]

npv_at <- function(r) {
  sum(flows / (1 + r)^(cfe$year))
}

# 4.2 Detect automatically a valid interval where NPV changes sign

grid <- seq(-0.9, 2.0, by = 0.01)
vals <- sapply(grid, npv_at)
sgn  <- sign(vals)

idx <- which(diff(sgn) != 0)
stopifnot(length(idx) >= 1L)

lower <- grid[idx[1]]
upper <- grid[idx[1] + 1]

# 4.3 Root finding with numerical control (reference IRR based on this vignette's convention)

irr_root <- uniroot(
  npv_at,
  c(lower, upper),
  tol = .Machine$double.eps^0.5
)$root

# 4.4 Checks:
# (A) NPV(irr_root) ≈ 0  [hard invariance: must hold]
# (B) NPV(ae$irr_project) reported for information only

tol_cash <- 1e-2  # acceptable deviation in currency units

npv_at_root   <- npv_at(irr_root)
npv_at_report <- npv_at(ae$irr_project)

# Hard check on the IRR computed in this vignette
stopifnot(abs(npv_at_root) <= tol_cash)

# Informative diagnostics on the package's reported IRR
gap_rate <- abs(irr_root - ae$irr_project)

status_report <- if (is.finite(npv_at_report) && abs(npv_at_report) <= tol_cash) {
  "✓ Reported IRR behaves as a root of the NPV equation under this cash-flow convention."
} else {
  paste0(
    "⚠ Reported IRR does not exactly solve NPV = 0 under this vignette's convention.\n",
    "  This may reflect different timing or cash-flow conventions in the internal implementation."
  )
}


# ---- Pedagogical printout ----

cat(
  "\nIRR identity diagnostic (all-equity case):\n",
  sprintf("• Interval used for root search: [%.2f, %.2f]\n", lower, upper),
  sprintf("• Computed IRR from cash-flow root: %.8f\n", irr_root),
  sprintf("• Reported IRR from run_case(): %.8f\n", ae$irr_project),
  sprintf("• Absolute rate gap (for information): %.10f\n", gap_rate),
  sprintf("• NPV evaluated at computed IRR: %.4f (tolerance %.2f)\n",
          npv_at_root, tol_cash),
  sprintf("• NPV evaluated at reported IRR: %.4f\n", npv_at_report),
  "\n", status_report, "\n"
)

# Optional: tabular summary for visual output

data.frame(
  irr_computed        = irr_root,
  irr_reported        = ae$irr_project,
  npv_at_irr_computed = npv_at_root,
  npv_at_irr_reported = npv_at_report
)
```

This block operationalises the textbook definition of IRR and checks that the implementation respects it.

## 5. Discount factor monotonicity

DCF models rely on an implicit or explicit discount factor sequence.
Here, the column df is interpreted as an accumulation factor (roughly
$$
(1+r)t
(1+r)
t
$$
), and its inverse as the actual discount factor.
The monotonicity of this inverse sequence is a simple but powerful diagnostic of time-value-of-money consistency.

```{r}
## 5. Discount factor consistency and interpretation

stopifnot("df" %in% names(cf_all))

df <- cf_all$df
df <- df[is.finite(df)]

# In this package, `df` increases over time (≈ (1 + r)^t),

# so its inverse is the true discount factor.

disc_factor <- 1 / df

# Theoretical properties of the discount sequence

stopifnot(abs(disc_factor[1] - 1) < 1e-12)         # t = 0 --> discount factor = 1
stopifnot(all(diff(disc_factor) <= 1e-10))         # should be non-increasing

# Summary metrics for transparency

rate_estimate <- (df[length(df)]^(1 / (length(df) - 1))) - 1
decay_ratio   <- disc_factor[length(disc_factor)] / disc_factor[1]

# ---- Pedagogical printout ----

cat(
"\nDiscount factor diagnostics:\n",
sprintf("• First value of df (t = 0): %.6f\n", df[1]),
sprintf("• Last value of df (t = %d): %.6f\n", length(df) - 1, tail(df, 1)),
sprintf("• Implied constant annual rate ≈ %.4f%%\n", 100 * rate_estimate),
sprintf("• Discount factor at t = %d: %.6f\n",
length(disc_factor) - 1, tail(disc_factor, 1)),
sprintf("• Ratio (disc_t_end / disc_t0): %.6f\n", decay_ratio),
if (all(diff(disc_factor) <= 1e-10))
"✓ Discount factors decrease monotonically - internal consistency confirmed.\n"
else
"✗ Discount factors not monotonic - check time indexing or rate definition.\n"
)

# Display a concise comparative table for reader visibility

knitr::kable(
data.frame(
year            = cf_all$year,
df              = round(df, 6),
discount_factor = round(disc_factor, 6)
),
caption = "Evolution of accumulation and discount factors across time"
)

```

## 6. Sanity checks

Beyond identities, simple sanity checks help detect gross specification errors (negative NOI, inconsistent acquisition prices, etc.).
This section implements such basic controls.

```{r}
## 6. Sanity checks and diagnostic printout

# (a) NOI finiteness and range

stopifnot("noi" %in% names(cf_all))

min_noi <- min(cf_all$noi, na.rm = TRUE)
max_noi <- max(cf_all$noi, na.rm = TRUE)

stopifnot(is.finite(min_noi), is.finite(max_noi))

# (b) Positive acquisition price (price_di)

price_di <- case$pricing$price_di
stopifnot(is.numeric(price_di), length(price_di) == 1L, price_di > 0)

# (c) Acquisition price consistency between pricing and cashflow tables

stopifnot("acquisition_price" %in% names(cfe))

price_cf  <- cfe$acquisition_price[1]
gap_price <- abs(price_di - price_cf)
stopifnot(gap_price < 1e-6)

# ---- Display results for transparency ----

cat(
"\nSanity checks summary:\n",
sprintf("• NOI range: [%s, %s]\n",
formatC(min_noi, format = 'f', big.mark = " "),
formatC(max_noi, format = 'f', big.mark = " ")),
sprintf("• Reported acquisition price (pricing$price_di): %s\n",
formatC(price_di, format = 'f', big.mark = " ")),
sprintf("• Acquisition price at t0 in cashflows: %s\n",
formatC(price_cf, format = 'f', big.mark = " ")),
sprintf("• Absolute gap between the two: %.8f (tolerance 1e-6)\n", gap_price),
if (min_noi < 0)
"• Note: NOI dips below zero in some periods - consistent with transitional or opportunistic strategies, but deserves economic interpretation.\n"
else
"• Note: NOI remains non-negative over the horizon.\n"
)

```

## 7. Display a compact summary

Finally, a compact summary brings together the main unlevered and levered indicators for the base case.
This provides a quick diagnostic of the leverage effect and of overall value creation at the chosen discount rate.

```{r}
## 7. Compact financial summary

summary_tbl <- data.frame(
Metric = c(
"Unlevered IRR (project)",
"Unlevered NPV (project, currency units)",
"Equity IRR (levered case)",
"Equity NPV (levered case, currency units)",
"Acquisition price (price_di)"
),
Value = c(
ae$irr_project,
ae$npv_project,
al$irr_equity,
al$npv_equity,
case$pricing$price_di
)
)

# Pedagogical printout with interpretation

cat(
"\n--- Summary of DCF core results ---\n",
sprintf("• Unlevered IRR (project): %.4f%%\n", 100 * ae$irr_project),
sprintf("• Unlevered NPV (project): %s\n",
formatC(ae$npv_project, format = 'f', big.mark = " ")),
sprintf("• Levered IRR (equity): %.4f%%\n", 100 * al$irr_equity),
sprintf("• Levered NPV (equity): %s\n",
formatC(al$npv_equity, format = 'f', big.mark = " ")),
sprintf("• Acquisition price (price_di): %s\n",
formatC(case$pricing$price_di, format = 'f', big.mark = " ")),
"\nInterpretation:\n",
"  - The unlevered IRR reflects the intrinsic profitability of the asset before financing.\n",
"  - The levered IRR measures the equity return after accounting for debt leverage.\n",
"  - The gap between both IRRs quantifies the effect of financial leverage on expected return.\n",
"  - NPV values in currency units provide absolute measures of value creation at the chosen discount rate.\n"
)

knitr::kable(
summary_tbl,
caption = "Key DCF performance metrics for the base case (unlevered and levered)"
)

```