System of unknown matrices

Question

I am very new to Mathematica. I am attempting to solve a system of equations with 4 unknown matrices (B, C, D and S). B, D and S are symmetric. This is what I have:

A = {{ε, 0, 0}, {0, ε, 0}, {0, 
   0, -2 ε}}

B1 = Array[b, {3, 3}];
C1 = Array[c, {3, 3}];
D1 = Array[d, {3, 3}];
S1 = Array[s, {3, 3}];

Z = {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}};

f1[D2_] := n γ + σ^2/2 Tr[D2];
f2[C2_, D2_] := -C2 - Transpose[C2] + 2 γ D2 - Transpose[A].D2 - D2.A + σ^2 D2.D2;
f3[B2_, C2_, D2_, S2_] := -Transpose[B2] - γ Transpose[A].D2 + γ C2 - C2.A + S2.D2 + σ^2 C2.D2;
f4[C2_, S2_] := -γ C2.A + γ Transpose[A].Transpose[C2] + C2.S2 + S2.Transpose[C2] + σ^2 Transpose[C2].C2;

Solve[{f1[D1][Equal]0,f2[C1,D1][Equal]Z,f3[B1,C1,D1,S1][Equal]Z,
f4[C1,S1][Equal]Z},{Flatten[B1],Flatten[C1],Flatten[D1],Flatten[S1]}]

But it gives me the error:

Solve::ivar: {b[1,1],b[1,2],b[1,3],b[2,1],b[2,2],b[2,3],b[3,1],b[3,2],b[3,3]} is not a valid variable.

Is my code just plain wrong, or is it that I am being unrealistic by trying to solve this symbolically? Any feedback/suggestions are much appreciated.

Thanks a lot in advance!

Cesareo · Answer

You can obtain a numerical result with a script as follows:
A = {{[CurlyEpsilon], 0, 0}, {0, [CurlyEpsilon], 0}, {0, 0, -2 [CurlyEpsilon]}}

B1 = {{b11, b12, b13}, {b12, b22, b23}, {b13, b23, b33}};
C1 = {{c11, c12, c13}, {c21, c22, c23}, {c31, c32, c33}};
D1 = {{d11, d12, d13}, {d12, d22, d23}, {d13, d23, d33}};
S1 = {{s11, s12, s13}, {s12, s22, s23}, {s13, s23, s33}};

f1[D2_] := n [Gamma] + [Sigma]^2/2 Tr[D2];
f2[C2_, D2_] := -C2 - Transpose[C2] + 2 [Gamma] D2 - Transpose[A].D2 - D2.A + [Sigma]^2 D2.D2;
f3[B2_, C2_, D2_, S2_] := -Transpose[B2] - [Gamma] Transpose[A].D2 + [Gamma] C2 - C2.A + S2.D2 + [Sigma]^2 C2.D2;
f4[C2_, S2_] := -[Gamma] C2.A + [Gamma] Transpose[A].Transpose[C2] + C2.S2 + S2.Transpose[C2] + [Sigma]^2 Transpose[C2].C2;

parms = {[CurlyEpsilon] -> 1, [Gamma] -> 2, [Sigma] -> 3, n -> 4};

ff2 = Flatten[f2[C1, D1]]
ff3 = Flatten[f3[B1, C1, D1, S1]]
ff4 = Flatten[f4[C1, S1]]

obj = f1[D1]^2 + ff2.ff2 + ff3.ff3 + ff4.ff4 /. parms
vars = Join[Join[Join[Variables[B1], Variables[C1]], Variables[D1]], Variables[S1]]

sol = NMinimize[obj, vars]

f1[D1] /. parms /. sol[[2]]
f2[C1, D1] /. parms /. sol[[2]]
f3[B1, C1, D1, S1] /. parms /. sol[[2]]
f4[C1, S1] /. parms /. sol[[2]]

Adriana LE · Answer

I think the problem is the system you are trying to solve. Reading J.M.'s technical difficulties's suggestion; I rewrote your code as follows:
(* Define a handy function *)

genmat[b_, m_, n_] := Array[Subscript[b, ##1] & , {m, n}];

(* Define parameters *)

A = {{[CurlyEpsilon], 0, 0}, {0, [CurlyEpsilon], 0}, {0, 
    0, -2 [CurlyEpsilon]}};
Z = {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}};

(* Define unknowns *)
B1 = genmat[b, 3, 3]; 
C1 = genmat[c, 3, 3];
D1 = genmat[d, 3, 3];
S1 = genmat[s, 3, 3];

(* Define system of equations *)

f1[D2_] := n [Gamma] + [Sigma]^2/2 Tr[D2]
f2[C2_, D2_] := -C2 - Transpose[C2] + 2 [Gamma] D2 - 
  Transpose[A].D2 - D2.A + [Sigma]^2 D2.D2
f3[B2_, C2_, D2_, 
  S2_] := -Transpose[B2] - [Gamma] Transpose[A].D2 + [Gamma] C2 - 
  C2.A + S2.D2 + [Sigma]^2 C2.D2
f4[C2_, S2_] := -[Gamma] C2.A + [Gamma] Transpose[A].Transpose[C2] +
   C2.S2 + S2.Transpose[C2] + [Sigma]^2 Transpose[C2].C2
system = {f1[D1] == 0, f2[C1, D1] == Z, f3[B1, C1, D1, S1] == Z, 
  f4[C1, S1] == Z}

(* Solve system *)
Solve[system,Join[Flatten[B1],Flatten[C1],Flatten[D1],Flatten[S1]]]

And as you said, the code keeps running forever. However, you can see that the system is well defined in terms of Mathematica syntax. Well defined mathematically is a different issue. As you mention, it seems it may be too complex for a symbolic solution. Maybe you can simplify it by imposing some extra assumptions/restrictions and using something like Asuming[assumptions, Solve(system)]?

System of unknown matrices

2 Answers

Add your own answers!

Ask a Question