params <-
list(family = "lapis", preset = "homage")

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  message = FALSE,
  warning = FALSE,
  fig.width = 7,
  fig.height = 4.1,
  fig.align = "center",
  out.width = "92%",
  dpi = 100
)
library(eigencore)
library(Matrix)

# Shared plotting helper. Kept out of the reader's view: the reader sees
# the API call and the picture, never the plotting boilerplate.
ec_blue <- "#2166ac"; ec_grey <- "grey78"

# A computed slice (blue) drawn on top of the full dense spectrum (grey).
plot_spectrum <- function(all_vals, computed, computed_ranks = seq_along(computed),
                          ylab = "value", main = NULL) {
  s <- sort(all_vals, decreasing = TRUE)
  k <- length(computed)
  op <- par(mar = c(4, 4.6, if (is.null(main)) 1 else 2.4, 1)); on.exit(par(op))
  plot(seq_along(s), s, pch = 19, cex = 0.4, col = ec_grey, bty = "n",
       xlab = "rank (largest to smallest)", ylab = ylab, main = main)
  points(computed_ranks, sort(computed, decreasing = TRUE),
         pch = 19, cex = 1.2, col = ec_blue)
  legend("topright", c("full spectrum (dense reference)", "computed by eigencore"),
         pch = 19, pt.cex = c(0.7, 1.2), col = c(ec_grey, ec_blue),
         bty = "n", cex = 0.9)
}

## ----albers-classes, echo=FALSE, results='asis'-------------------------------
cat(sprintf(
  paste0(
    '<script>document.addEventListener("DOMContentLoaded",function(){',
    'document.body.classList.remove("palette-red","palette-lapis","palette-ochre","palette-teal","palette-green","palette-violet","preset-homage","preset-interaction","preset-study","preset-structural","preset-adobe","preset-midnight");',
    'document.body.classList.add("palette-%s","preset-%s");',
    '});</script>'
  ),
  params$family,
  params$preset
))

## ----dense-spd----------------------------------------------------------------
A <- diag(c(2, 8, 18))
B <- diag(c(1, 2, 3))

fit <- eig_full(A, B = B)
values(fit)
certificate(fit)$passed

## ----validate-dense-spd, include=FALSE----------------------------------------
stopifnot(
  isTRUE(certificate(fit)$passed),
  isTRUE(all.equal(sort(Re(values(fit))), c(2, 4, 6)))
)

## ----partial-spd--------------------------------------------------------------
n <- 150
A_wide <- diag(seq(1, 150, length.out = n))
B_wide <- diag(seq(1, 2, length.out = n))

part <- eig_partial(A_wide, B = B_wide, k = 5, target = smallest())
sort(Re(values(part)))
part$method
certificate(part)$passed

## ----validate-partial-spd, include=FALSE--------------------------------------
truth_wide <- sort(diag(A_wide) / diag(B_wide))
stopifnot(
  isTRUE(certificate(part)$passed),
  isTRUE(all.equal(sort(Re(values(part))), head(truth_wide, 5), tolerance = 1e-7))
)

## ----partial-spd-spectrum, echo = FALSE, fig.cap = "The five smallest generalized eigenvalues (blue) against the full 150-pair spectrum of the pencil (A, B) (grey).", fig.alt = "Scatter plot of 150 generalized eigenvalues sorted descending in grey, with the five smallest highlighted in blue at the bottom-right."----
plot_spectrum(
  truth_wide,
  values(part),
  computed_ranks = tail(seq_along(truth_wide), length(values(part))),
  ylab = "generalized eigenvalue"
)

## ----dense-general------------------------------------------------------------
A_general <- matrix(c(1, 4, 2, 3), 2, 2)
B_general <- matrix(c(2, 1, 0, -1), 2, 2)

pencil <- eig_full(A_general, B = B_general, structure = general())
values(pencil)
alpha_beta(pencil)$classification
certificate(pencil)$passed

## ----validate-dense-general, include=FALSE------------------------------------
stopifnot(
  isTRUE(certificate(pencil)$passed),
  all(alpha_beta(pencil)$classification == "finite")
)

## ----singular-pencil----------------------------------------------------------
singular <- eig_full(
  diag(c(2, 3, 0)),
  B = diag(c(1, 0, 0)),
  structure = general()
)

alpha_beta(singular)$classification
certificate(singular)$failed_indices

## ----validate-singular-pencil, include=FALSE----------------------------------
stopifnot(identical(
  sort(alpha_beta(singular)$classification),
  sort(c("finite", "infinite", "undefined"))
))

## ----qz-----------------------------------------------------------------------
qz <- generalized_schur(A_general, B_general)
values(qz)
alpha_beta(qz)$classification
qz$method

## ----validate-qz, include=FALSE-----------------------------------------------
stopifnot(
  length(values(qz)) == 2L,
  all(alpha_beta(qz)$classification == "finite")
)

## ----qz-sort------------------------------------------------------------------
qz_singular <- generalized_schur(
  diag(c(2, 3, 0)),
  diag(c(1, 0, 0)),
  sort = "infinite"
)
alpha_beta(qz_singular)$classification

## ----sparse-partial-----------------------------------------------------------
A_sparse <- Diagonal(x = c(1, 4, 9, 16, 25, 36))
B_sparse <- Diagonal(x = c(1, 2, 3, 4, 5, 6))

sparse_fit <- eig_partial(
  A_sparse,
  B = B_sparse,
  k = 3,
  target = smallest(),
  method = lanczos(max_subspace = 6),
  allow_dense_fallback = "never"
)

values(sparse_fit)
sparse_fit$method
certificate(sparse_fit)$passed

## ----validate-sparse-partial, include=FALSE-----------------------------------
stopifnot(
  isTRUE(certificate(sparse_fit)$passed),
  isTRUE(all.equal(
    sort(Re(values(sparse_fit))), c(1, 2, 3), tolerance = 1e-7
  ))
)