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

4 Answers 4

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$
4
  • $\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$ Commented Jun 15, 2017 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
    Commented Jun 15, 2017 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
    Commented Jun 15, 2017 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$ Commented Jun 15, 2017 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$
3
  • $\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$ Commented Jun 14, 2017 at 23:21
  • $\begingroup$ @LuísEduardo Sorry for the typo. Fixed. $\endgroup$
    – Alan
    Commented Jun 15, 2017 at 1:49
  • $\begingroup$ Thanks, but it was not exactly this what I was looking for. $\endgroup$ Commented Jun 15, 2017 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$
2
  • $\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$ Commented Jun 15, 2017 at 4:26
  • $\begingroup$ @Luis, it is fixed now. $\endgroup$
    – kglr
    Commented Jun 16, 2017 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$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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