# Creating a matrix from the determinants of submatices of a given square matrix

I'm trying to create a Mathematica algorithm creates a matrix f when given a $n \times n$ square matrix L

1. If i = j, then f[[i, i]] = 0

2. If i != j, then f[[i, j]] = d[L, {i, j}] /d[L, {i, i}]

where d[L, {i, j}] is the determinant of s[L, {i, j}], and s[L, {i, j}] is the sub-matrix of L which omits all elements of L that have a row index or a column index that appears in the list {i, j}, where 1 <= i <= n and 1 <= j <= n.

Note that when i != j. s[L, {i, j}] has dimensions {n - 2, n - 2}, because it omits two distinct indices, while s[L, {i, i}] has dimensions {n - 1, n - 1} because it omits only one.

My problem is that I'm trying to use Drop to delete rows and columns, but I get this error when L is a 4 x 4 matrix.

Drop::drop: Cannot drop positions 4 through 4 in {{3,-1,-1},{-1,3,-1},{-1,-1,3}}.

My code is:

n = Dimensions[L][]
f =
Table[
If[i != j,
Det[Drop[Drop[L, {i}, {i}], {j}, {j}]]/Det[Drop[L, {i}, {i}]],
f[[i, j]] = 0],
{i, n}, {j, n}]


I tried to change j to j-1, but doing so changes the concept of my problem and generates an incorrect matrix f.

Maybe my logic is not good. Could anyone help me?

• This looks an edit to a question you asked previously: mathematica.stackexchange.com/q/148285 – m_goldberg Jun 14 '17 at 23:19
• Yeah, sure, but after many changes I think my problem in the logic, not the code. – Luís Eduardo Jun 14 '17 at 23:23
• Then it would a good idea for you to delete the previous question, – m_goldberg Jun 14 '17 at 23:25
• I think it's pretty clear from Luis's code, and from his question (before it was edited), that he wants to divide the determinant of a $(n-2) \times (n-2)$ matrix by the determinant of a $(n-1) \times (n-1)$ matrix. My answer is the only one that does this. Luis, could you clarify? – Carl Woll Jun 15 '17 at 1:55

A related Mathematica function is Minors, but that does more work than you need. So, here is a more custom version:

minor[L_, {i_, j_}] := With[{x = Delete[Range @ Length @ L, {{i}, {j}}]},
Det @ L[[x, x]]
]


By happenstance, this version works when $i=j$ as well. For example, suppose:

SeedRandom;
L = RandomInteger[20, {4, 4}]
L //TeXForm


{{5, 0, 7, 0}, {2, 3, 0, 0}, {16, 14, 3, 8}, {19, 5, 18, 16}}

$\left( \begin{array}{cccc} 5 & 0 & 7 & 0 \\ 2 & 3 & 0 & 0 \\ 16 & 14 & 3 & 8 \\ 19 & 5 & 18 & 16 \\ \end{array} \right)$

n = Length @ L;
Table[If[i==j, 0, minor[L, {i, j}]/minor[L, {i, i}]], {i, n}, {j, n}]
% //TeXForm


{{0, 1/3, -(1/6), -(1/32)}, {12/151, 0, -(10/151), 97/1208}, {1/5, 1/3, 0, 1/ 16}, {-(9/95), 97/95, -(3/19), 0}}

$\left( \begin{array}{cccc} 0 & \frac{1}{3} & -\frac{1}{6} & -\frac{1}{32} \\ \frac{12}{151} & 0 & -\frac{10}{151} & \frac{97}{1208} \\ \frac{1}{5} & \frac{1}{3} & 0 & \frac{1}{16} \\ -\frac{9}{95} & \frac{97}{95} & -\frac{3}{19} & 0 \\ \end{array} \right)$

• Thank you so much, Carl !!! It was exactly this what I was looking for ! I don't have enough reputation to vote, but I need to confirm that this is what I'm trying to do. – Luís Eduardo Jun 15 '17 at 4:28
• @LuísEduardo But you said you wanted to delete row i and column j, not row i and j and column i and j. – Alan Jun 15 '17 at 5:35
• @LuísEduardo. Even if can't up-vote, you can show your approval by accepting this answer. You do that by clicking on the check mark that appears on the left of the answer below the down arrow. – m_goldberg Jun 15 '17 at 8:41
• @Alan my post was edited by Mr Goldberg several times who maybe doesn't understand what I was looking for... But thanks for your help !! – Luís Eduardo Jun 15 '17 at 15:22

Is this the function you're after?

f = Function[{m, ij}, With[{i = First@ij, j = Last@ij},
If[i == j, 0,Det[Drop[m, {i}, {j}]]/Det[Drop[m, {i}, {i}]]]]
]


If so, you can just

MapIndexed[f[L, #2] &, L, {2}]


Edit:

Given the edits to the question, you need to make a small change to the function:

f = Function[{m, ij},
With[{i = First@ij, j = Last@ij, mn = Min@ij, mx = Max@ij},
If[i == j, 0,
Det[Drop[Drop[m, {mx}, {mx}], {mn}, {mn}]]/Det[Drop[m, {i}, {i}]]]
]]

• I don't understand this function. It didn't work! The output was just {1,1,1,1} to my 4x4 L matrix. – Luís Eduardo Jun 14 '17 at 23:21
• @LuísEduardo Sorry for the typo. Fixed. – Alan Jun 15 '17 at 1:49
• Thanks, but it was not exactly this what I was looking for. – Luís Eduardo Jun 15 '17 at 4:20
ClearAll[f, f1, f2]
f[L_] := Divide @@ (First[Extract[L, {{#, #}}, Det]] & /@
(Complement[Range@Length@L, #] & /@ {{##}, {#}})) &

f1[L_] := Table[If[i == j, 0, f[L][i, j]], {i, Length@L}, {j, Length@L}]

f2[L_] := Array[f[L], {#, #}] - IdentityMatrix[#] & @ Length[L]

Row[MatrixForm /@ {L, f1 @ L, f2 @ L}] • Thank you, your answer was very didactic, but it was similar to Alan, it's not exactly what I was looking for, because the solution will be different what I expected. – Luís Eduardo Jun 15 '17 at 4:26
• @Luis, it is fixed now. – kglr Jun 16 '17 at 4:05

This is based on the now corrected definition of f in the question, which in turn is based on Carl Woll's insights.

d[mat_, all_, {i_, j_}] :=
With[{indices = Delete[all, {{i}, {j}}]}, Det @ mat[[indices, indices]]]
f[m_?SquareMatrixQ] :=
Module[{indices, subdets},
indices = Range @ Length @ m;
subdets = Array[d[m, indices, {##}] &, Dimensions[m]];
ReplacePart[subdets/Diagonal[subdets], {i_, i_} -> 0]]


I think this code is a little more efficient than Carl's.

Here are some test cases.

f @ Array[a, {3, 3}] f @ {{5, 0, 7, 0}, {2, 3, 0, 0}, {16, 14, 3, 8}, {19, 5, 18, 16}} 