# IPCA Implementation Plan

> **For agentic workers:** REQUIRED SUB-SKILL: Use superpowers:subagent-driven-development (recommended) or superpowers:executing-plans to implement this plan task-by-task. Steps use checkbox (`- [ ]`) syntax for tracking.

**Goal:** Add `ipca_est()` to the `sdim` R package as a native R + RcppArmadillo implementation of Instrumented PCA (Kelly, Pruitt & Su 2019).

**Architecture:** Input validation in R builds per-period observation lists; a single Rcpp function runs the full ALS loop using RcppArmadillo; the R wrapper wraps the result into an `sdim_fit` object with the standard `lambda`/`eigvals`/`factors` fields so all existing display/evaluation functions work unchanged.

**Tech Stack:** R (≥ 4.1.0), Rcpp, RcppArmadillo, testthat 3

---

## File Map

| File | Action | Responsibility |
|---|---|---|
| `DESCRIPTION` | Modify | Add `Rcpp` to `Imports`, `Rcpp` + `RcppArmadillo` to `LinkingTo` |
| `NAMESPACE` | Modify | Add `useDynLib` + `importFrom(Rcpp, sourceRcpp)` |
| `src/ipca_als.cpp` | Create | Full ALS loop: factor step, loading step, normalization |
| `R/ipca_est.R` | Create | Input validation, data prep, calls Rcpp, builds `sdim_fit` |
| `R/sdim_fit.R` | Modify | Add `"ipca"` branch in `print.sdim_fit`; label fix in `print.summary.sdim_fit` |
| `tests/testthat/test-ipca_est.R` | Create | All tests for `ipca_est` |

---

## Task 1: Package infrastructure (DESCRIPTION, NAMESPACE, src/)

**Files:**
- Modify: `DESCRIPTION`
- Modify: `NAMESPACE`
- Create: `src/` directory (empty placeholder)

- [ ] **Step 1.1: Add Rcpp dependencies to DESCRIPTION**

  Open `DESCRIPTION`. Change the `Imports` line from:
  ```
  Imports: stats, graphics
  ```
  to:
  ```
  Imports: stats, graphics, Rcpp
  ```
  Add a new line after `Imports`:
  ```
  LinkingTo: Rcpp, RcppArmadillo
  ```
  Note: `RcppArmadillo` goes in `LinkingTo` only, **not** `Imports`.

- [ ] **Step 1.2: Update NAMESPACE**

  Open `NAMESPACE`. Add these three lines (anywhere in the file):
  ```
  useDynLib(sdim, .registration = TRUE)
  importFrom(Rcpp, sourceRcpp)
  export(ipca_est)
  ```

  Note: `useDynLib` requires a compiled shared library to exist. Step 1.3 creates a minimal stub so `load_all()` can compile it before `ipca_als.cpp` is written.

- [ ] **Step 1.3: Create src/ directory with a compilation stub**

  ```bash
  mkdir -p src
  ```

  Create `src/stub.cpp` with the following content (required so `devtools::load_all()` has something to compile against `useDynLib`):

  ```cpp
  // placeholder — will be superseded by ipca_als.cpp in Task 2
  #include <Rcpp.h>
  ```

- [ ] **Step 1.4: Verify package compiles and loads**

  ```r
  devtools::load_all()
  ```
  Expected: package compiles `stub.cpp` and loads without errors.

- [ ] **Step 1.5: Commit**

  ```bash
  git add DESCRIPTION NAMESPACE src/stub.cpp
  git commit -m "feat: add Rcpp/RcppArmadillo package infrastructure"
  ```

---

## Task 2: Rcpp ALS core

**Files:**
- Create: `src/ipca_als.cpp`

This is the performance-critical inner loop. It receives two R lists (one vector per time period, one matrix per time period), runs ALS, and returns Gamma, F, and singular values.

- [ ] **Step 2.1: Create `src/ipca_als.cpp`**

  ```cpp
  // [[Rcpp::depends(RcppArmadillo)]]
  #include <RcppArmadillo.h>
  using namespace Rcpp;

  // [[Rcpp::export]]
  List ipca_als_cpp(List ret_list, List Z_list,
                   int K, int max_iter, double tol) {

    int T = ret_list.size();

    // --- Determine L from first non-empty Z_t ---
    int L = 0;
    for (int t = 0; t < T; t++) {
      arma::mat Zt = as<arma::mat>(Z_list[t]);
      if (Zt.n_rows > 0) { L = Zt.n_cols; break; }
    }

    // --- Initialization: build M (L x T), column t = Z_t' r_t ---
    arma::mat M(L, T, arma::fill::zeros);
    for (int t = 0; t < T; t++) {
      arma::vec rt  = as<arma::vec>(ret_list[t]);
      arma::mat Zt  = as<arma::mat>(Z_list[t]);
      if (rt.n_elem > 0) M.col(t) = Zt.t() * rt;
    }
    arma::mat U; arma::vec s_init; arma::mat V_init;
    arma::svd_econ(U, s_init, V_init, M);
    arma::mat Gamma = U.cols(0, K - 1);   // L x K

    arma::mat F_mat(T, K, arma::fill::zeros);
    arma::mat Gamma_old = Gamma;
    arma::vec sv(K);
    bool converged = false;

    for (int iter = 0; iter < max_iter; iter++) {

      // --- Factor step: solve K x K system for each t ---
      for (int t = 0; t < T; t++) {
        arma::vec rt = as<arma::vec>(ret_list[t]);
        arma::mat Zt = as<arma::mat>(Z_list[t]);
        if (rt.n_elem == 0) continue;

        arma::mat A = Gamma.t() * Zt.t() * Zt * Gamma;   // K x K
        arma::vec b = Gamma.t() * Zt.t() * rt;            // K x 1
        arma::vec ft;
        // arma::solve returns false (does not throw) when no_approx is absent
        bool ok = arma::solve(ft, A, b, arma::solve_opts::likely_sympd);
        if (!ok) {
          // Ridge fallback for near-singular A
          A.diag() += 1e-8;
          ft = arma::solve(A, b);
        }
        F_mat.row(t) = ft.t();
      }

      // --- Loading step: Kronecker-vectorized pooled OLS (Kelly et al. eq. 12) ---
      // vec(Gamma) = LHS^{-1} RHS
      // LHS = sum_t kron(f_t f_t', Z_t' Z_t)   [KL x KL]
      // RHS = vec( sum_t Z_t' r_t f_t' )        [KL x 1]
      // Armadillo is column-major: vec stacks columns of L x K Gamma.
      // kron order: kron(K x K, L x L) = KL x KL — consistent with vec(Gamma).
      arma::mat LHS(K * L, K * L, arma::fill::zeros);
      arma::mat RHS_mat(L, K, arma::fill::zeros);
      for (int t = 0; t < T; t++) {
        arma::vec rt = as<arma::vec>(ret_list[t]);
        arma::mat Zt = as<arma::mat>(Z_list[t]);
        if (rt.n_elem == 0) continue;
        arma::vec ft = F_mat.row(t).t();
        LHS     += arma::kron(ft * ft.t(), Zt.t() * Zt);
        RHS_mat += Zt.t() * rt * ft.t();
      }
      arma::vec rhs_vec = arma::vectorise(RHS_mat);   // stacks columns
      arma::vec g_vec   = arma::solve(LHS, rhs_vec);
      Gamma = arma::reshape(g_vec, L, K);             // fills columns

      // --- Normalize: thin SVD of Gamma ---
      arma::mat Usvd, Vsvd;
      arma::svd_econ(Usvd, sv, Vsvd, Gamma);
      Gamma = Usvd.cols(0, K - 1);                    // L x K, Gamma'Gamma = I_K
      // Rotate F to preserve fitted values: F_new = F * V * diag(sv)
      F_mat = F_mat * Vsvd * arma::diagmat(sv);

      // Sign convention: flip so largest-abs element of each Gamma column is positive
      for (int k = 0; k < K; k++) {
        arma::uword idx;
        arma::abs(Gamma.col(k)).max(idx);
        if (Gamma(idx, k) < 0.0) {
          Gamma.col(k) *= -1.0;
          F_mat.col(k) *= -1.0;
        }
      }

      // --- Convergence ---
      double diff = arma::norm(Gamma - Gamma_old, "fro");
      Gamma_old = Gamma;
      if (diff < tol) { converged = true; break; }
    }

    if (!converged) {
      Rcpp::warning("ipca_est: ALS did not converge in %d iterations", max_iter);
    }

    return List::create(Named("Gamma") = Gamma,
                        Named("F")     = F_mat,
                        Named("sv")    = sv);
  }
  ```

- [ ] **Step 2.2: Compile and verify no build errors**

  ```r
  devtools::load_all()
  ```
  Expected: package loads, `ipca_als_cpp` is available.

  Fix any compiler errors before proceeding.

- [ ] **Step 2.3: Smoke-test the Rcpp function directly**

  ```r
  set.seed(1)
  T <- 50; N <- 20; L <- 5; K <- 2
  ret  <- matrix(rnorm(T * N), T, N)
  Z    <- array(rnorm(T * N * L), dim = c(T, N, L))
  ret_list <- lapply(seq_len(T), function(t) ret[t, ])
  Z_list   <- lapply(seq_len(T), function(t) matrix(Z[t, , ], N, L))
  res <- ipca_als_cpp(ret_list, Z_list, K = K, max_iter = 100, tol = 1e-6)
  stopifnot(dim(res$Gamma) == c(L, K))
  stopifnot(dim(res$F)     == c(T, K))
  stopifnot(length(res$sv) == K)
  cat("Smoke test passed\n")
  ```
  Expected: `Smoke test passed`.

- [ ] **Step 2.4: Commit**

  ```bash
  git rm src/stub.cpp
  git add src/ipca_als.cpp
  git commit -m "feat: add Rcpp ALS core for IPCA"
  ```

---

## Task 3: R wrapper `ipca_est()`

**Files:**
- Create: `R/ipca_est.R`

The R wrapper validates inputs, builds `ret_list`/`Z_list`, calls `ipca_als_cpp`, and returns an `sdim_fit`.

- [ ] **Step 3.1: Write failing tests first**

  Create `tests/testthat/test-ipca_est.R` with only the structural tests for now (full test suite comes in Task 5):

  ```r
  test_that("ipca_est returns sdim_fit with correct dimensions", {
    set.seed(42)
    T <- 50; N <- 15; L <- 5; K <- 2
    ret <- matrix(rnorm(T * N) / 100, T, N)
    Z   <- array(rnorm(T * N * L), dim = c(T, N, L))
    fit <- ipca_est(ret, Z, nfac = K)
    expect_s3_class(fit, "sdim_fit")
    expect_equal(fit$method, "ipca")
    expect_equal(dim(fit$factors), c(T, K))
    expect_equal(dim(fit$lambda),  c(L, K))
    expect_length(fit$eigvals, K)
    expect_false(is.null(fit$call))
  })
  ```

- [ ] **Step 3.2: Run test to verify it fails**

  ```r
  devtools::load_all()
  devtools::test(filter = "ipca_est")
  ```
  Expected: FAIL — `could not find function "ipca_est"`.

- [ ] **Step 3.3: Create `R/ipca_est.R`**

  ```r
  #' IPCA factor extraction
  #'
  #' @param ret Numeric matrix (T x N) of asset returns. Use \code{NA} for
  #'   missing observations (unbalanced panel).
  #' @param Z Numeric array (T x N x L) of asset characteristics. \code{NA}s
  #'   must mirror \code{ret} exactly.
  #' @param nfac Positive integer; number of latent factors K to extract.
  #' @param max_iter Maximum ALS iterations (default 100).
  #' @param tol Convergence tolerance on Frobenius norm of loading change
  #'   (default 1e-6).
  #'
  #' @return An object of class \code{"sdim_fit"} with fields:
  #'   \code{factors} (T x K), \code{lambda} (L x K characteristic loadings,
  #'   i.e. Gamma in Kelly et al.), \code{eigvals} (singular values of Gamma),
  #'   \code{call}, \code{method = "ipca"}, \code{nfac}.
  #' @references Kelly, Pruitt, Su (2019) \doi{10.1016/j.jfineco.2019.05.001}
  #' @examples
  #' set.seed(1)
  #' ret <- matrix(rnorm(50 * 10) / 100, 50, 10)
  #' Z   <- array(rnorm(50 * 10 * 4), dim = c(50, 10, 4))
  #' fit <- ipca_est(ret, Z, nfac = 2)
  #' print(fit)
  #' @export
  ipca_est <- function(ret, Z, nfac, max_iter = 100, tol = 1e-6) {

    cl <- match.call()

    # --- Input validation ---
    if (!is.matrix(ret) || !is.numeric(ret))
      stop("`ret` must be a numeric matrix.", call. = FALSE)

    if (!is.array(Z) || length(dim(Z)) != 3L || !is.numeric(Z))
      stop("`Z` must be a 3-dimensional numeric array.", call. = FALSE)

    T_obs <- nrow(ret)
    N     <- ncol(ret)
    L     <- dim(Z)[3L]

    if (dim(Z)[1L] != T_obs || dim(Z)[2L] != N)
      stop("`Z` dimensions [T, N, L] must match `ret` dimensions [T, N].", call. = FALSE)

    if (!is.numeric(nfac) || length(nfac) != 1L || is.na(nfac) || nfac < 1L)
      stop("`nfac` must be a positive integer.", call. = FALSE)
    nfac <- as.integer(nfac)

    if (nfac > L)
      stop("`nfac` cannot exceed the number of characteristics L.", call. = FALSE)

    # Check NAs mirror between ret and Z
    na_ret <- is.na(ret)
    for (l in seq_len(L)) {
      if (!identical(na_ret, is.na(Z[, , l])))
        stop("NAs in `Z` must mirror NAs in `ret` (same positions).", call. = FALSE)
    }

    # Build per-period lists; validate N_t >= K
    ret_list <- vector("list", T_obs)
    Z_list   <- vector("list", T_obs)
    for (t in seq_len(T_obs)) {
      obs <- which(!is.na(ret[t, ]))
      if (length(obs) < nfac)
        stop(sprintf(
          "Time period %d has %d observed assets, fewer than nfac = %d.",
          t, length(obs), nfac), call. = FALSE)
      ret_list[[t]] <- ret[t, obs]
      Z_list[[t]]   <- matrix(Z[t, obs, ], nrow = length(obs), ncol = L)
    }

    # --- Call Rcpp ALS ---
    res <- ipca_als_cpp(ret_list, Z_list, K = nfac,
                        max_iter = max_iter, tol = tol)

    structure(
      list(method  = "ipca",
           call    = cl,
           factors = res[["F"]],
           lambda  = res[["Gamma"]],
           eigvals = as.numeric(res[["sv"]]),
           nfac    = nfac),
      class = "sdim_fit"
    )
  }
  ```

- [ ] **Step 3.4: Run the test to verify it passes**

  ```r
  devtools::load_all()
  devtools::test(filter = "ipca_est")
  ```
  Expected: PASS.

- [ ] **Step 3.5: Commit**

  ```bash
  git add R/ipca_est.R tests/testthat/test-ipca_est.R
  git commit -m "feat: add ipca_est R wrapper"
  ```

---

## Task 4: Display methods in `sdim_fit.R`

**Files:**
- Modify: `R/sdim_fit.R`

Two targeted edits: add an `"ipca"` branch to `print.sdim_fit`, and fix the "Predictors" label in `print.summary.sdim_fit`.

- [ ] **Step 4.1: Write failing display tests**

  Add to `tests/testthat/test-ipca_est.R`:

  ```r
  test_that("print.sdim_fit shows Characteristics for ipca", {
    set.seed(1)
    ret <- matrix(rnorm(40 * 8) / 100, 40, 8)
    Z   <- array(rnorm(40 * 8 * 4), dim = c(40, 8, 4))
    fit <- ipca_est(ret, Z, nfac = 2)
    out <- capture.output(print(fit))
    expect_true(any(grepl("Characteristics", out)))
    expect_false(any(grepl("Predictors", out)))
  })

  test_that("summary.sdim_fit shows Characteristics for ipca", {
    set.seed(1)
    ret <- matrix(rnorm(40 * 8) / 100, 40, 8)
    Z   <- array(rnorm(40 * 8 * 4), dim = c(40, 8, 4))
    fit <- ipca_est(ret, Z, nfac = 2)
    out <- capture.output(summary(fit))
    expect_true(any(grepl("Characteristics", out)))
    expect_true(any(grepl("IPCA", out)))
  })
  ```

- [ ] **Step 4.2: Run to verify they fail**

  ```r
  devtools::load_all()
  devtools::test(filter = "ipca_est")
  ```
  Expected: the two new display tests FAIL (output says "Predictors", not "Characteristics").

- [ ] **Step 4.3: Add `"ipca"` branch to `print.sdim_fit`**

  In `R/sdim_fit.R`, replace the body of `print.sdim_fit` (lines 2–10):

  ```r
  #' @export
  print.sdim_fit <- function(x, ...) {

    if (x$method == "ipca") {
      cat(sprintf("<sdim_fit [%s]>\n", x$method))
      cat(" Observations    :", nrow(x$factors), "\n")
      cat(" Characteristics :", nrow(x$lambda),  "\n")
      cat(" Factors         :", ncol(x$factors), "\n")
      return(invisible(x))
    }

    cat(sprintf("<sdim_fit [%s]>\n", x$method))
    cat(" Observations :", nrow(x$factors), "\n")
    cat(" Predictors   :", nrow(x$lambda),  "\n")
    cat(" Factors      :", ncol(x$factors), "\n")
    invisible(x)

  }
  ```

- [ ] **Step 4.4: Add `"ipca"` to `method_label` switch and fix Dimensions label**

  In `print.summary.sdim_fit` (around line 43–48), add `ipca` to the switch:

  ```r
  method_label <- switch(x$method,
    pca  = "Principal Component Analysis (PCA)",
    pls  = "Partial Least Squares (PLS)",
    rra  = "Reduced-Rank Approach (RRA)",
    ipca = "Instrumented Principal Components Analysis (IPCA)",
    toupper(x$method)
  )
  ```

  Then find the Dimensions block line that prints `"Predictors"` (around line 57–58):

  ```r
  cat(sprintf(" %-16s %d\n", "Predictors",   x$n_pred))
  ```

  Replace it with:

  ```r
  pred_label <- if (x$method == "ipca") "Characteristics" else "Predictors"
  cat(sprintf(" %-16s %d\n", pred_label, x$n_pred))
  ```

- [ ] **Step 4.5: Run tests to verify they pass**

  ```r
  devtools::load_all()
  devtools::test(filter = "ipca_est")
  ```
  Expected: all tests PASS.

- [ ] **Step 4.6: Run full test suite to confirm no regressions**

  ```r
  devtools::test()
  ```
  Expected: all tests PASS (no existing test broken).

- [ ] **Step 4.7: Commit**

  ```bash
  git add R/sdim_fit.R tests/testthat/test-ipca_est.R
  git commit -m "feat: add ipca display methods to sdim_fit"
  ```

---

## Task 5: Full test suite

**Files:**
- Modify: `tests/testthat/test-ipca_est.R`

Add the remaining tests: input validation, algorithm correctness, edge cases.

- [ ] **Step 5.1: Add input validation tests**

  Append to `tests/testthat/test-ipca_est.R`:

  ```r
  test_that("ipca_est errors on non-matrix ret", {
    Z <- array(rnorm(50 * 10 * 4), dim = c(50, 10, 4))
    expect_error(ipca_est(as.data.frame(matrix(1, 50, 10)), Z, nfac = 2),
                 "`ret` must be a numeric matrix")
  })

  test_that("ipca_est errors on non-array Z", {
    ret <- matrix(rnorm(50 * 10), 50, 10)
    expect_error(ipca_est(ret, matrix(1, 50, 10), nfac = 2),
                 "`Z` must be a 3-dimensional numeric array")
  })

  test_that("ipca_est errors on dimension mismatch", {
    ret <- matrix(rnorm(50 * 10), 50, 10)
    Z_bad <- array(rnorm(50 * 9 * 4), dim = c(50, 9, 4))   # N mismatch
    expect_error(ipca_est(ret, Z_bad, nfac = 2),
                 "dimensions")
  })

  test_that("ipca_est errors when nfac > L", {
    ret <- matrix(rnorm(50 * 10), 50, 10)
    Z   <- array(rnorm(50 * 10 * 3), dim = c(50, 10, 3))
    expect_error(ipca_est(ret, Z, nfac = 5),
                 "`nfac` cannot exceed")
  })

  test_that("ipca_est errors when N_t < nfac", {
    set.seed(1)
    T <- 50; N <- 10; L <- 4; K <- 3
    ret <- matrix(rnorm(T * N) / 100, T, N)
    Z   <- array(rnorm(T * N * L), dim = c(T, N, L))
    # Force period 1 to have only 2 observed assets (< K=3)
    ret[1, 3:N] <- NA
    Z[1, 3:N, ] <- NA
    expect_error(ipca_est(ret, Z, nfac = K),
                 "fewer than nfac")
  })

  test_that("ipca_est errors when Z NAs don't mirror ret", {
    set.seed(1)
    ret <- matrix(rnorm(50 * 10) / 100, 50, 10)
    Z   <- array(rnorm(50 * 10 * 4), dim = c(50, 10, 4))
    ret[1, 1] <- NA       # NA in ret
    # Z[1,1,] left as non-NA — mismatch
    expect_error(ipca_est(ret, Z, nfac = 2),
                 "NAs in `Z` must mirror")
  })
  ```

- [ ] **Step 5.2: Run validation tests**

  ```r
  devtools::load_all()
  devtools::test(filter = "ipca_est")
  ```
  Expected: all validation tests PASS.

- [ ] **Step 5.3: Add algorithm correctness tests**

  ```r
  test_that("ipca_est recovers true factor structure up to rotation", {
    set.seed(123)
    T <- 200; N <- 50; L <- 6; K <- 2

    # True Gamma (L x K) and F (T x K)
    Gamma_true <- matrix(rnorm(L * K), L, K)
    F_true     <- matrix(rnorm(T * K), T, K)

    # Characteristics: random
    Z <- array(rnorm(T * N * L), dim = c(T, N, L))

    # Returns: r_{i,t} = z_{i,t}' Gamma_true f_t + noise
    ret <- matrix(0, T, N)
    for (t in seq_len(T)) {
      Zt <- matrix(Z[t, , ], N, L)
      ret[t, ] <- Zt %*% Gamma_true %*% F_true[t, ] + rnorm(N, sd = 0.1)
    }

    fit <- ipca_est(ret, Z, nfac = K, max_iter = 200)

    # Rotation-invariant check: Gamma Gamma' should be close to Gamma_true Gamma_true'
    # (up to scale since normalization sets Gamma'Gamma = I)
    GG_fit  <- fit$lambda %*% t(fit$lambda)
    GG_true <- Gamma_true %*% solve(t(Gamma_true) %*% Gamma_true) %*% t(Gamma_true)
    expect_lt(norm(GG_fit - GG_true, "F") / norm(GG_true, "F"), 0.3)
  })

  test_that("eval_factors works unchanged on ipca output", {
    set.seed(42)
    ret <- matrix(rnorm(60 * 12) / 100, 60, 12)
    Z   <- array(rnorm(60 * 12 * 4), dim = c(60, 12, 4))
    fit <- ipca_est(ret, Z, nfac = 2)
    expect_no_error(eval_factors(ret = ret, factors = fit$factors))
  })

  test_that("non-convergence triggers a warning", {
    set.seed(1)
    ret <- matrix(rnorm(40 * 10) / 100, 40, 10)
    Z   <- array(rnorm(40 * 10 * 4), dim = c(40, 10, 4))
    expect_warning(ipca_est(ret, Z, nfac = 2, max_iter = 1),
                   "did not converge")
  })
  ```

- [ ] **Step 5.4: Add edge case tests**

  ```r
  test_that("ipca_est works with nfac = 1", {
    set.seed(7)
    ret <- matrix(rnorm(50 * 10) / 100, 50, 10)
    Z   <- array(rnorm(50 * 10 * 4), dim = c(50, 10, 4))
    fit <- ipca_est(ret, Z, nfac = 1)
    expect_equal(dim(fit$factors), c(50L, 1L))
    expect_equal(dim(fit$lambda),  c(4L,  1L))
  })

  test_that("ipca_est works with nfac = L (square Gamma)", {
    set.seed(8)
    L   <- 4
    ret <- matrix(rnorm(50 * 10) / 100, 50, 10)
    Z   <- array(rnorm(50 * 10 * L), dim = c(50, 10, L))
    fit <- ipca_est(ret, Z, nfac = L)
    expect_equal(dim(fit$lambda), c(L, L))
  })

  test_that("ipca_est handles unbalanced panel (10% NAs)", {
    set.seed(99)
    T <- 60; N <- 20; L <- 4; K <- 2
    ret <- matrix(rnorm(T * N) / 100, T, N)
    Z   <- array(rnorm(T * N * L), dim = c(T, N, L))

    # Introduce 10% missing — ensure each period keeps at least K observed assets
    n_missing <- floor(0.10 * T * N)
    # Pick (t, n) pairs where period t will still have >= K+1 obs after removal
    candidates <- which(rowSums(!is.na(ret)) > K + 1, arr.ind = FALSE)
    # Randomly pick cells from rows with enough obs
    set.seed(99)
    for (i in seq_len(n_missing)) {
      t_idx <- sample(which(rowSums(!is.na(ret)) > K + 1), 1)
      n_idx <- sample(which(!is.na(ret[t_idx, ])), 1)
      ret[t_idx, n_idx] <- NA
      Z[t_idx, n_idx, ] <- NA
    }

    fit <- ipca_est(ret, Z, nfac = K)
    expect_equal(dim(fit$factors), c(T, K))
  })

  test_that("print.sdim_list works with mixed rra and ipca fits", {
    set.seed(5)
    X   <- matrix(rnorm(60 * 6), 60, 6)
    ret <- matrix(rnorm(60 * 10) / 100, 60, 10)
    Z   <- array(rnorm(60 * 10 * 6), dim = c(60, 10, 6))

    fit_rra  <- rra_est(target = ret, X = X, nfac = 2)
    fit_ipca <- ipca_est(ret, Z, nfac = 2)

    sdl <- structure(list(rra = fit_rra, ipca = fit_ipca), class = "sdim_list")
    expect_no_error(print(sdl))
  })
  ```

- [ ] **Step 5.5: Run full test suite**

  ```r
  devtools::load_all()
  devtools::test()
  ```
  Expected: all tests PASS, including all pre-existing tests.

- [ ] **Step 5.6: Commit**

  ```bash
  git add tests/testthat/test-ipca_est.R
  git commit -m "test: add full test suite for ipca_est"
  ```

---

## Task 6: Package polish

- [ ] **Step 6.1: Update DESCRIPTION description field**

  In `DESCRIPTION`, update the `Description:` field to mention IPCA:

  ```
  Description: Implements five factor extraction methods for asset pricing and
      macroeconomic forecasting: principal component analysis (PCA), partial
      least squares (PLS), scaled PCA (sPCA) of Huang, Jiang, Li, Tong, and
      Zhou (2022) <doi:10.1287/mnsc.2021.4020>, the reduced-rank approach
      (RRA) of He, Huang, Li, and Zhou (2023) <doi:10.1287/mnsc.2022.4563>,
      and Instrumented PCA (IPCA) of Kelly, Pruitt, and Su (2019)
      <doi:10.1016/j.jfineco.2019.05.001>.
  ```

- [ ] **Step 6.2: Run `R CMD check`**

  ```bash
  Rscript -e "devtools::check()"
  ```
  Expected: 0 errors, 0 warnings. Notes about `useDynLib` registration are acceptable.

- [ ] **Step 6.3: Final commit**

  ```bash
  git add DESCRIPTION
  git commit -m "docs: update DESCRIPTION to include IPCA"
  ```
