3
$\begingroup$

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][[1]]
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?

$\endgroup$
  • $\begingroup$ This looks an edit to a question you asked previously: mathematica.stackexchange.com/q/148285 $\endgroup$ – m_goldberg Jun 14 '17 at 23:19
  • $\begingroup$ Yeah, sure, but after many changes I think my problem in the logic, not the code. $\endgroup$ – Luís Eduardo Jun 14 '17 at 23:23
  • $\begingroup$ Then it would a good idea for you to delete the previous question, $\endgroup$ – m_goldberg Jun 14 '17 at 23:25
  • $\begingroup$ Deleted, could you please help me ? $\endgroup$ – Luís Eduardo Jun 14 '17 at 23:27
  • 2
    $\begingroup$ 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? $\endgroup$ – Carl Woll Jun 15 '17 at 1:55
7
$\begingroup$

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[1];
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)$

Then, we can answer your question with:

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)$

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Luís Eduardo Jun 15 '17 at 4:28
  • 2
    $\begingroup$ @LuísEduardo But you said you wanted to delete row i and column j, not row i and j and column i and j. $\endgroup$ – Alan Jun 15 '17 at 5:35
  • $\begingroup$ @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. $\endgroup$ – m_goldberg Jun 15 '17 at 8:41
  • $\begingroup$ @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 !! $\endgroup$ – Luís Eduardo Jun 15 '17 at 15:22
3
$\begingroup$

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}]]]
   ]]
$\endgroup$
  • $\begingroup$ I don't understand this function. It didn't work! The output was just {1,1,1,1} to my 4x4 L matrix. $\endgroup$ – Luís Eduardo Jun 14 '17 at 23:21
  • $\begingroup$ @LuísEduardo Sorry for the typo. Fixed. $\endgroup$ – Alan Jun 15 '17 at 1:49
  • $\begingroup$ Thanks, but it was not exactly this what I was looking for. $\endgroup$ – Luís Eduardo Jun 15 '17 at 4:20
3
$\begingroup$
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}]

Mathematica graphics

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Luís Eduardo Jun 15 '17 at 4:26
  • $\begingroup$ @Luis, it is fixed now. $\endgroup$ – kglr Jun 16 '17 at 4:05
2
$\begingroup$

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}]

mat_1

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

mat_2

$\endgroup$

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.