This is a classical algorithm proposed by the nineteenth century mathematician C. G. J. Jacobi in connection with some astronomical computations. See wikipedia for a detailed description and some historical references.

The method was computationally tedious, and remained dormant until the advent of modern computers in the mid 20th century. Since its re-discovery it has been refined and improved many times, though much faster algorithms have since been devised and implemented.

I first met the Jacobi algorithm as an early `Fortran`

programming exercise I had as a student in 1966. It's simplicity and ingenuity fascinated me then and kindled an interest in numerical computations of this kind that has remained ever since. It was a very good way to learn programming.

There has been some renewed interest in Jacobi-like methods in recent times, however, since unlike the faster methods for eigensolution computations, it offers the possibility of parallelisation. See, for example, Zhou and Brent for one possibility, and others in the references therein.

This is a **demonstration package** used for teaching purposes. It's main purposes are to provide an example of an intermediate-level programming task where an efficient coding in pure `R`

and one using in `C++`

using `Rcpp`

are strikingly similar. The task also involves matrix manipulation in *pure* `Rcpp`

, rather than using `RcppArmadillo`

for example, which is of some teaching interest as well.

There are some situations where the `C++`

function provided, `JacopiCpp`

, can be slightly faster than the in-built `eigen`

function in the `base`

package, mainly for large numbers of small symmetric matrices. Persons with a fascination for old algorithms might find the comparison with modern versions and alternatives interesting, but generally the functions are **not intended for production use**.

If someone is motivated to take up the challenge of producing a fast parallel Jacobi algorithm coding in R and provide it as a package, there may well be much practical interest (and this package will have served a useful practical purpose, if somewhat vicariously).

Let $S$ be a $2\times2$ symmetric matrix, with entries $s_{ij}$. It it well known that any symmetric matrix may be diagonalized by an orthogonal similarity transformation. In symbols, for this special case, this implies we need to choose a value for $\theta$ for which:
$$ H^{\mathsf{T}} S H =
\left[\begin{array}{lr}
\cos \theta & -\sin \theta \
\sin \theta & \cos \theta
\end{array} \right]
\left[\begin{array}{lr}
s_{11} & s_{12} \
s_{21} & s_{22}
\end{array} \right]
\left[\begin{array}{rr}
\cos \theta & \sin \theta \
-\sin \theta & \cos \theta
\end{array} \right]
=
\left[\begin{array}{lr}
\lambda_1 & 0 \
0 & \lambda_2
\end{array} \right] \; \overset{\mathrm{def.}}{=} \; \Lambda
$$
A solution is easily shown to be
$$
\theta = \begin{cases}
{ \frac12}\arctan\left(\frac{2s_{12}}{s_{22} - s_{11}}\right) & \mbox{if } s_{11} \neq s_{22} \
{\frac{\pi}4}& \mbox{if }s_{11} = s_{22}
\end{cases}
$$
Note that both cases can be accommodated via the `R`

function `atan2`

.

In the general case a series of rotation matrices is chosen and applied successively. These have the same form as the $2\times2$ case, but embedded in an $n\times n$ identity matrix, so the application of any one of them affects two rows and columns *only*. Such *planar rotation matrices* are chosen so that at any stage the off-diagonal element with *maximum* absolute value is annihilated.

Hence if at some stage $|s_{ij}|, \; (i<j)$, is maximum, the planar rotation matrix $H_{ij}$ will affect rows and columns $i$ and $j$ only, and will transform $s_{ij}$ to zero, and the process continues.

The process ceases when the $\underset{i

[^1]: If only eigenvalues are required, the tolerance can be set somewhat higher than if accurate eigenvectors are required as well.

Elements that are annihilated at some stage may become non-zero at later stages, of course, but several properties of the algorithm are guaranteed, namely

- At any stage the sum of squares of the off-diagonal elements is reduced, eventually to zero, and
- The rate of convergence is quadratic, so the algorithm is
*relatively*quick.

At the end of the algorithm, the original symmetric matrix $S$ is transformed into the diagonal matrix of eigenvalues, $\Lambda$. If eigenvectors are also required then the accumulated product of the planar rotation matrices, starting with the identity, provide a normalized version of them: $$ H = H_{i_p,j_p} \cdots H_{i_3,j_3}H_{i_2,j_2}H_{i_1,j_1}I_n $$

The so-called 'stagewise' rotation protocol differs from the standard protocol by traversing the off-diagonal
elements of the matrix systematically and rather than simply eliminating the element with maximum absolute value
only, it eliminates all elements it encounters in turn if their absolute value exceeds a progressively reducing
threshold. This avoids some repeated searching of the off-diagonal section of the matrix and confers a small,
if useful, speed advantage. This implementation is provided in `JacobiS`

.

For a simple example, consider finding the eigenvalues and eigenvectors of a well-known correlation matrix.

suppressPackageStartupMessages(library(dplyr)) library(JacobiEigen) library(stats) imod <- aov(cbind(Sepal.Length, Sepal.Width, Petal.Length, Petal.Width) ~ Species, iris) (R <- cor(resid(imod))) rEig <- JacobiR(R) cEig <- Jacobi(R) identical(rEig, cEig) ## the R and Rcpp implementations are identical cEig (eEig <- eigen(R)) ## eigenvectors differ in signs all.equal(eEig$values, cEig$values) ## eigenvalues are (practically) identical

We can now look at some timings.

library(rbenchmark) benchmark(JacobiR(R), Jacobi(R), JacobiS(R), eigen(R), columns = c("test", "elapsed")) %>% arrange(elapsed)

The relative disadvantage of `Jacobi`

rapidly increases as the size of the matrix increases. Not surprisingly, algorithmic improvements since 1846 have been very effective:

set.seed(12345) N <- 100 iseq <- seq(10, 100, by = 10) res <- lapply(iseq, function(n) { S <- crossprod(matrix(rnorm(N*n), N, n))/N runTime <- benchmark(JacobiR(S), Jacobi(S), JacobiS(S), eigen(S), replications = N, columns = c("test", "elapsed")) cbind(n = n, runTime) }) %>% do.call(rbind, .) %>% within({ elapsed <- log10(1000*elapsed/N) }) suppressPackageStartupMessages(library(ggplot2)) ggplot(res) + aes(x = n, y = elapsed, colour = test) + geom_line() + geom_point() + scale_colour_manual(values = c("eigen(S)" = "pale violet red", "Jacobi(S)" = "steel blue", "JacobiS(S)" = "sky blue", "JacobiR(S)" = "tan")) + xlab("matrix size") + ylab(expression(log[10](italic("mean run time [ms]")))) + theme_minimal() + theme(legend.position = "bottom", legend.title = element_blank())

knitr::include_graphics(file.path(getwd(), "benchmarks.pdf"))

The only case where `Jacobi`

may have a slight speed advantage over the standard routine `eigen`

is
in dealing with large numbers of small, *guaranteed symmetric* matrices. Using a stagewise
rotation protocol, (`JacobiS`

), where elements are zeroed out as the matrix is traversed if
the exceed a progressively reduced threshold, rather than locating and eliminating only the
largest off-diagonal element (in absolute value) each time, conveys a small, but appreciable
advantage.

For reference, the `R`

and `Rcpp`

code are listed below.

This includes the interface to the `Rcpp`

function.

JacobiR <- function(x, symmetric = TRUE, only.values = FALSE, eps = if(!only.values) .Machine$double.eps else sqrt(.Machine$double.eps)) { if(!symmetric) stop("only real symmetric matrices are allowed") n <- nrow(x) H <- if(only.values) NULL else diag(n) eps <- max(eps, .Machine$double.eps) if(n > 1) { lt <- which(lower.tri(x)) repeat { k <- lt[which.max(abs(x[lt]))] ## the matrix element j <- floor(1 + (k - 2)/(n + 1)) ## the column i <- k - n * (j - 1) ## the row if(abs(x[i, j]) < eps) break Si <- x[, i] Sj <- x[, j] theta <- 0.5*atan2(2*Si[j], Sj[j] - Si[i]) c <- cos(theta) s <- sin(theta) x[i, ] <- x[, i] <- c*Si - s*Sj x[j, ] <- x[, j] <- s*Si + c*Sj x[i,j] <- x[j,i] <- 0 x[i,i] <- c^2*Si[i] - 2*s*c*Si[j] + s^2*Sj[j] x[j,j] <- s^2*Si[i] + 2*s*c*Si[j] + c^2*Sj[j] if(!only.values) { Hi <- H[, i] H[, i] <- c*Hi - s*H[, j] H[, j] <- s*Hi + c*H[, j] } } } structure(list(values = as.vector(diag(x)), vectors = H), class = c("Jacobi", "eigen")) } ## ## The interface function to the Rcpp code ## Jacobi <- function(x, symmetric = TRUE, only.values = FALSE, eps = 0.0) { if(!symmetric) stop("only real symmetric matrices are allowed") structure(JacobiCpp(x, only.values, eps), class = c("Jacobi", "eigen")) }

We begin with one helper function:

#include <Rcpp.h> using namespace Rcpp; NumericMatrix Ident(int n) // not exported. { NumericMatrix I(n, n); for(int i = 0; i < n; i++) I(i, i) = 1.0; return I; } // [[Rcpp::export]] List JacobiCpp(NumericMatrix x, bool only_values = false, double eps = 0.0) { NumericMatrix S(clone(x)); int nr = S.nrow(); bool vectors = !only_values; NumericMatrix H; if(vectors) { H = Ident(nr); } double eps0 = as<double>((as<List>(Environment::base_env()[".Machine"]))["double.eps"]); double tol = eps > eps0 ? eps : eps0; // i.e. no lower than .Machine$double.eps if(only_values & (eps == 0.0)) tol = sqrt(tol); // a lower accuracy is adequate here. while(true) { double maxS = 0.0; int i=0, j=0; for(int row = 1; row < nr; row++) { // find value & position of maximum |off-diagonal| for(int col = 0; col < row; col++) { double val = fabs(S(row, col)); if(maxS < val) { maxS = val; i = row; j = col; } } } if(maxS <= tol) break; NumericVector Si = S(_, i), Sj = S(_, j); double theta = 0.5*atan2(2.0*Si(j), Sj(j) - Si(i)); double s = sin(theta), c = cos(theta); S(i, _) = S(_, i) = c*Si - s*Sj; S(j, _) = S(_, j) = s*Si + c*Sj; S(i, j) = S(j, i) = 0.0; S(i, i) = c*c*Si(i) - 2.0*s*c*Si(j) + s*s*Sj(j); S(j, j) = s*s*Si(i) + 2.0*s*c*Si(j) + c*c*Sj(j); if(vectors) { NumericVector Hi = H(_, i); H(_, i) = c*Hi - s*H(_, j); H(_, j) = s*Hi + c*H(_, j); } } if(vectors) { return List::create(_["values"] = diag(S), _["vectors"] = H); } else { return List::create(_["values"] = diag(S), _["vectors"] = R_NilValue); } } // Stagewise protocol version // // [[Rcpp::export]] List JacobiSCpp(NumericMatrix x, bool only_values = false, double eps = 0.0) { NumericMatrix S(clone(x)); int nr = S.nrow(); bool vectors = !only_values; NumericMatrix H; if(vectors) { H = Ident(nr); } double eps0 = as<double>((as<List>(Environment::base_env()[".Machine"]))["double.eps"]); double tol = eps > eps0 ? eps : eps0; // i.e. no lower than .Machine$double.eps if(only_values & (eps == 0.0)) tol = sqrt(tol); // a lower accuracy is adequate here. double maxS = 0.0; for(int row = 1; row < nr; row++) { // find value of maximum |off-diagonal| for(int col = 0; col < row; col++) { double val = fabs(S(row, col)); maxS = maxS < val ? val : maxS; } } while(true) { if(maxS <= tol) break; double maxS0 = 0.0; for(int i = 1; i < nr; i++) { for(int j = 0; j < i; j++) { double val = fabs(S(i, j)); maxS0 = maxS0 < val ? val : maxS0; if (val > maxS/2.0) { NumericVector Si = S(_, i), Sj = S(_, j); double theta = 0.5*atan2(2.0*Si(j), Sj(j) - Si(i)); double s = sin(theta), c = cos(theta); S(i, _) = S(_, i) = c*Si - s*Sj; S(j, _) = S(_, j) = s*Si + c*Sj; S(i, j) = S(j, i) = 0.0; S(i, i) = c*c*Si(i) - 2.0*s*c*Si(j) + s*s*Sj(j); S(j, j) = s*s*Si(i) + 2.0*s*c*Si(j) + c*c*Sj(j); if(vectors) { NumericVector Hi = H(_, i); H(_, i) = c*Hi - s*H(_, j); H(_, j) = s*Hi + c*H(_, j); } } } } maxS = maxS0; } if(vectors) { return List::create(_["values"] = diag(S), _["vectors"] = H); } else { return List::create(_["values"] = diag(S), _["vectors"] = R_NilValue); } }

**Any scripts or data that you put into this service are public.**

Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.