# Getting started: checking a run_case() object

## 1 Purpose

This vignette shows a few simple checks on a `run_case()` result:

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 uses the tables returned by `run_case()`.

## 2 1. Build a case

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

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

A basic check in a single-asset DCF is that the exit happens once, at the end of the hold. For the all-equity case, sale proceeds should appear once and only once, in the final year of the projection.

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

    # ---- Show the result ----

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

    cat(
    "\nExit check:\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"
    )

    ##
    ## Exit check:
    ##  • Number of exit events detected: 1 (should be 1)
    ##  • Exit year (expected last period): 5
    ##  • Sale proceeds at exit: 3 953 899.8085
    ##  • Free cash flow in the exit year (before sale): 4 121 957.3561
    ##  • Maximum year in series: 5
    ##  ✓ Exit correctly occurs in the final year.

This confirms that the terminal value is booked once and only once.

## 4 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 rebuilds that relationship directly from the all-equity cash-flow table.

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

    # `free_cash_flow` already includes the terminal sale in the last period

    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

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

    # 4.4 Checks:
    # (A) Reported IRR must solve the NPV equation
    # (B) The root found here should be close in rate terms

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

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

    gap_rate <- abs(irr_root - ae$irr_project)
    stopifnot(abs(npv_at_report) <= tol_cash)

    # ---- Print a short summary ----

    cat(
      "\nIRR check (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\n",
              npv_at_root, tol_cash),
      sprintf("• NPV evaluated at reported IRR: %.4f\n", npv_at_report),
      "✓ The reported IRR solves the NPV equation within tolerance.\n"
    )

    ##
    ## IRR check (all-equity case):
    ##  • Interval used for root search: [0.06, 0.07]
    ##  • Computed IRR from cash-flow root: 0.06467435
    ##  • Reported IRR from run_case(): 0.06467435
    ##  • Absolute rate gap (for information): 0.0000000003
    ##  • NPV evaluated at computed IRR: 0.0000
    ##  • NPV evaluated at reported IRR: -0.0047
    ##  ✓ The reported IRR solves the NPV equation within tolerance.

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

    ##   irr_computed irr_reported npv_at_irr_computed npv_at_irr_reported
    ## 1   0.06467435   0.06467435        3.713521e-05        -0.004653886

This confirms that the reported project IRR is consistent with the all-equity cash-flow stream.

## 5 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. A decreasing discount-factor sequence is another quick consistency check.

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

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

    # ---- Print a short summary ----

    cat(
    "\nDiscount factor check:\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.\n"
    else
    "✗ Discount factors not monotonic - check time indexing or rate definition.\n"
    )

    ##
    ## Discount factor check:
    ##  • First value of df (t = 0): 1.000000
    ##  • Last value of df (t = 5): 1.230756
    ##  • Implied constant annual rate ≈ 4.2400%
    ##  • Discount factor at t = 5: 0.812509
    ##  • Ratio (disc_t_end / disc_t0): 0.812509
    ##  ✓ Discount factors decrease monotonically.

    # Display a concise table

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

Evolution of accumulation and discount factors across time
year | df | discount_factor
--- | --- | ---
0 | 1.000000 | 1.000000
1 | 1.042400 | 0.959325
2 | 1.086598 | 0.920304
3 | 1.132670 | 0.882870
4 | 1.180695 | 0.846959
5 | 1.230756 | 0.812509

## 6 6. Sanity checks

Beyond formal identities, a few basic checks help catch obvious setup issues.

    ## 6. Sanity checks

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

    # ---- Print a short summary ----

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

    ##
    ## Sanity checks summary:
    ##  • NOI range: [0.0000, 204 020.0000]
    ##  • Reported acquisition price (pricing$price_di): 3 307 692.3077
    ##  • Acquisition price at t0 in cashflows: 3 307 692.3077
    ##  • Absolute gap between the two: 0.00000000 (tolerance 1e-6)
    ##  • Note: NOI remains non-negative over the horizon.

## 7 7. Display a compact summary

Finally, a compact summary brings together the main unlevered and levered indicators for the base case. This is a convenient way to read the case before drilling into the detailed tables.

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

    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 = " ")),
    "\n"
    )

    ##
    ## --- Summary of DCF core results ---
    ##  • Unlevered IRR (project): 6.4674%
    ##  • Unlevered NPV (project): 337 536.2713
    ##  • Levered IRR (equity): 8.2945%
    ##  • Levered NPV (equity): 435 826.3839
    ##  • Acquisition price (price_di): 3 307 692.3077
    ##

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

Key DCF performance metrics for the base case (unlevered and levered)
Metric | Value
--- | ---
Unlevered IRR (project) | 6.467430e-02
Unlevered NPV (project, currency units) | 3.375363e+05
Equity IRR (levered case) | 8.294530e-02
Equity NPV (levered case, currency units) | 4.358264e+05
Acquisition price (price_di) | 3.307692e+06