Analytic determinant of a sparse 25x25 matrix?

Question

I would like to compute the analytic determinant of the following sparse matrix

mat={
  {f[1, 6], 0, 0, 0, 0, 0, 0, 0, 0, 0, f[1, 2] + f[1, 6] + f[2, 6], 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
  {0, f[1, 6], 0, 0, 0, 0, 0, 0, 0, 0, f[1, 3] + f[1, 6] + f[3, 6], f[1, 2] + f[1, 6] + f[2, 6], 0, 0, 0, 0, f[4, 5], 0, 0, 0, 0, 0, 0, 0, 0},
  {0, 0, f[1, 6], 0, 0, 0, 0, 0, 0, 0, f[1, 4] + f[1, 6] + f[4, 6], 0, f[1, 2] + f[1, 6] + f[2, 6], 0, 0, 0, f[3, 5], 0, 0, 0, 0, 0, 0, 0, 0},
  {0, 0, 0, f[1, 6], 0, 0, 0, 0, 0, 0, 0, f[1, 3] + f[1, 6] + f[3, 6], 0, f[1, 2] + f[1, 6] + f[2, 6], 0, 0, 0, q[1], 0, 0, f[4, 5], 0, 0, 0, 0},
  {0, 0, 0, 0, f[1, 6], 0, 0, 0, 0, 0, 0, f[1, 4] + f[1, 6] + f[4, 6], f[1, 3] + f[1, 6] + f[3, 6], 0, f[1, 2] + f[1, 6] + f[2, 6], 0, f[2, 5], 0, q[1], 0, f[3, 5], f[4, 5], 0, 0, 0},
  {0, 0, 0, 0, 0, f[1, 6], 0, 0, 0, 0, 0, 0, f[1, 4] + f[1, 6] + f[4, 6], 0, 0, f[1, 2] + f[1, 6] + f[2, 6], 0, 0, 0, q[1], 0, f[3, 5], 0, 0, 0},
  {0, 0, 0, 0, 0, 0, f[1, 6], 0, 0, 0, 0, 0, 0, f[1, 3] + f[1, 6] + f[3, 6], 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
  {0, 0, 0, 0, 0, 0, 0, f[1, 6], 0, 0, 0, 0, 0, f[1, 4] + f[1, 6] + f[4, 6], f[1, 3] + f[1, 6] + f[3, 6], 0, 0, 0, 0, 0, f[2, 5], 0, q[1], 0, 0},
  {0, 0, 0, 0, 0, 0, 0, 0, f[1, 6], 0, 0, 0, 0, 0, f[1, 4] + f[1, 6] + f[4, 6], f[1, 3] + f[1, 6] + f[3, 6], 0, 0, 0, 0, 0, f[2, 5], 0, q[1], 0},
  {0, 0, 0, 0, 0, 0, 0, 0, 0, f[1, 6], 0, 0, 0, 0, 0, f[1, 4] + f[1, 6] + f[4, 6], 0, 0, 0, 0, 0, 0, 0, 0, q[1]},
  {f[2, 6], 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
  {f[3, 6], f[2, 6], 0, 0, 0, 0, 0, 0, 0, 0, f[2, 3] + f[2, 6] + f[3, 6], 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
  {f[4, 6], 0, f[2, 6], 0, 0, 0, 0, 0, 0, 0, f[2, 4] + f[2, 6] + f[4, 6], 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
  {0, f[3, 6], 0, f[2, 6], 0, 0, 0, 0, 0, 0, 0, f[2, 3] + f[2, 6] + f[3, 6], 0, 0, 0, 0, 0, q[2], 0, 0, 0, 0, 0, 0, 0},
  {0, f[4, 6], f[3, 6], 0, f[2, 6], 0, 0, 0, 0, 0, f[3, 4] + f[3, 6] + f[4, 6], f[2, 4] + f[2, 6] + f[4, 6], f[2, 3] + f[2, 6] + f[3, 6], 0, 0, 0, f[1, 5], 0, q[2], 0, 0, 0, 0, 0, 0},
  {0, 0, f[4, 6], 0, 0, f[2, 6], 0, 0, 0, 0, 0, 0, f[2, 4] + f[2, 6] + f[4, 6], 0, 0, 0, 0, 0, 0, q[2], 0, 0, 0, 0, 0},
  {0, 0, 0, f[3, 6], 0, 0, f[2, 6], 0, 0, 0, 0, 0, 0, f[2, 3] + f[2, 6] + f[3, 6], 0, 0, 0, q[3], 0, 0, 0, 0, 0, 0, 0},
  {0, 0, 0, f[4, 6], f[3, 6], 0, 0, f[2, 6], 0, 0, 0, f[3, 4] + f[3, 6] + f[4, 6], 0, f[2, 4] + f[2, 6] + f[4, 6], f[2, 3] + f[2, 6] + f[3, 6], 0, 0, q[4], q[3], 0, f[1, 5], 0, q[2], 0, 0},
  {0, 0, 0, 0, f[4, 6], f[3, 6], 0, 0, f[2, 6], 0, 0, 0, f[3, 4] + f[3, 6] + f[4, 6], 0, f[2, 4] + f[2, 6] + f[4, 6], f[2, 3] + f[2, 6] + f[3, 6], 0, 0, q[4], q[3], 0, f[1, 5], 0, q[2], 0},
  {0, 0, 0, 0, 0, f[4, 6], 0, 0, 0, f[2, 6], 0, 0, 0, 0, 0, f[2, 4] + f[2, 6] + f[4, 6], 0, 0, 0, q[4], 0, 0, 0, 0, q[2]},
  {0, 0, 0, 0, 0, 0, f[3, 6], 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
  {0, 0, 0, 0, 0, 0, f[4, 6], f[3, 6], 0, 0, 0, 0, 0, f[3, 4] + f[3, 6] + f[4, 6], 0, 0, 0, 0, 0, 0, 0, 0, q[3], 0, 0},
  {0, 0, 0, 0, 0, 0, 0, f[4, 6], f[3, 6], 0, 0, 0, 0, 0, f[3, 4] + f[3, 6] + f[4, 6], 0, 0, 0, 0, 0, 0, 0, q[4], q[3], 0},
  {0, 0, 0, 0, 0, 0, 0, 0, f[4, 6], f[3, 6], 0, 0, 0, 0, 0, f[3, 4] + f[3, 6] + f[4, 6], 0, 0, 0, 0, 0, 0, 0, q[4], q[3]},
  {0, 0, 0, 0, 0, 0, 0, 0, 0, f[4, 6], 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, q[4]}
};

The built in Mathematica routine takes too long. The trivial Laplace expansion as given for instance in the answer to this question also takes too long. What should I do?

Out of curiosity, why do you need the analytical form of this determinant? — MarcoB, Aug 18 '15 at 23:06
This determinant comes up in the U-resultant calculation of a system of multivariate equations. The solutions for these equations are then obtained from a factorization of the determinant and looking at coefficients of the q[x_] terms. — Kagaratsch, Aug 18 '15 at 23:12
Because the upper left 10x10 block is diagonal, it appears straightforward to reduce the determinant to 15x15. It also may be possible to further reduce it to 9x9 without too much difficulty, although that matrix will not be sparse. — bbgodfrey, Aug 19 '15 at 01:05
I think this might give the determinant. lu = LUDecomposition[mat]; detfax = Apply[Times,Diagonal[lu[[1]]]]; Might be very slow to factor however. — Daniel Lichtblau, Aug 19 '15 at 15:41

score 20 · Accepted Answer · edited Aug 22 '15 at 15:33

Using the properties of Block matrices:

$$\det\begin{pmatrix}\mathbf A&\mathbf B\\\mathbf C&\mathbf D\end{pmatrix}=\det(\mathbf A)\det\left(\mathbf D-\mathbf C\mathbf A^{-1}\mathbf B\right)$$

To visualize your matrix:

mat1 = mat;
{mat1[[;; 10, ;; 10]], mat1[[;; 10, 11 ;;]],
 mat1[[11 ;;, ;; 10]], mat1[[11 ;;, 11 ;;]]} = Range@4; (* cool :) *)
Show[MatrixPlot[mat1], MatrixPlot[mat, ColorRules -> {0 -> Transparent}]]

Then:

a = mat[[;; 10, ;; 10]];
b = mat[[;; 10, 11 ;;]];
c = mat[[11 ;;, ;; 10]];
d = mat[[11 ;;, 11 ;;]];

rr = d - c.Inverse[a].b;
(* The next trick def is done for using less memory *)
r = SparseArray[{{i_, j_} /; rr[[i, j]] =!= 0 -> x[i, j]}, Dimensions@rr];
detr = Det@r;
(* now we roll back the trick *)
realDetR = detr /. x[i_, j_] :> rr[[i, j]];
(* and the grand total is ... *)
totalDet = Det[a] realDetR;

It works here, but in general it is better to use LinearSolve[] instead of Inverse[] for this application: d - c.LinearSolve[a, b] — J. M.'s missing motivation, Aug 22 '15 at 15:34

score 6 · Answer 2 · answered Aug 22 '15 at 15:56

Here is a slightly compacted reformulation of belisarius's answer:

a = Take[mat, 10, 10]; b = Take[mat, 10, -15];
c = Take[mat, -15, 10]; d = Take[mat, -15, -15];

rr = ArrayRules[d - c.SparseArray[LinearSolve[a, b]]];
detr = Det[SparseArray[rr /. (pos_ /; VectorQ[pos, IntegerQ] -> expr_) :>
                       (pos -> C @@ pos), Dimensions[d]]];
realDetR = detr /. (Most[rr] /. pos_ /; VectorQ[pos, IntegerQ] :> C @@ pos);
totalDet = Det[a] realDetR

ArrayRules[] is a very useful thing!

Analytic determinant of a sparse 25x25 matrix?

2 Answers2

Linked