12
$\begingroup$

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?

$\endgroup$
4
  • $\begingroup$ Out of curiosity, why do you need the analytical form of this determinant? $\endgroup$ – MarcoB Aug 18 '15 at 23:06
  • $\begingroup$ 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. $\endgroup$ – Kagaratsch Aug 18 '15 at 23:12
  • 1
    $\begingroup$ 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. $\endgroup$ – bbgodfrey Aug 19 '15 at 1:05
  • 3
    $\begingroup$ I think this might give the determinant. lu = LUDecomposition[mat]; detfax = Apply[Times,Diagonal[lu[[1]]]]; Might be very slow to factor however. $\endgroup$ – Daniel Lichtblau Aug 19 '15 at 15:41
20
$\begingroup$

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;
$\endgroup$
1
  • 1
    $\begingroup$ It works here, but in general it is better to use LinearSolve[] instead of Inverse[] for this application: d - c.LinearSolve[a, b] $\endgroup$ – J. M.'s ennui Aug 22 '15 at 15:34
6
$\begingroup$

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!

$\endgroup$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.