Simplificando la parte imaginaria

Question

Estoy resolviendo el siguiente eigensystem y obtengo un resultado que parece de valor complejo. Espero que el resultado tenga 0 partes imaginarias, ¿alguien puede ver una manera de simplificarlo?

B = {{17/3, 1/3, 1/3, 1/3}, {1/3, 1/3, 1/3, 1/3}, {1/3, 1/3, 1/3, 1/
    3}, {1/3, 1/3, 1/3, 82/3}};
A = {{5/3, 0, 1/3, 0}, {0, 5/3, 0, 1/3}, {1/3, 0, 10/3, 0}, {0, 1/3, 
    0, 10/3}};
First /@ Eigensystem[{B, A}, 1]

Answer 1

B = {{17/3, 1/3, 1/3, 1/3}, {1/3, 1/3, 1/3, 1/3}, {1/3, 1/3, 1/3, 1/3}, {1/3, 
    1/3, 1/3, 82/3}};
A = {{5/3, 0, 1/3, 0}, {0, 5/3, 0, 1/3}, {1/3, 0, 10/3, 0}, {0, 1/3, 0, 
    10/3}};

val = First /@ Eigensystem[{B, A}, 1];

Todos los valores son reales

valR = val // RootReduce

Element[valR, Reals]

(* True *)

valR // N

(* {8.33542, {0.0311157, -0.179391, 0.00719285, 1.}} *)

Sin embargo, si se representan con radicales, deben usar números complejos (ver Casus irreducibilis)

valR // ToRadicals

Answer 2

Chop[N[First /@ Eigensystem[{B, A}, 1]]]

devoluciones

{8.33542,{0.0311157,-0.179391,0.00719285,1.}}

Answer 3

Esto lleva mucho tiempo, pero funciona si solo quieres demostrar que la parte imaginaria es $0$.

B = {{17/3, 1/3, 1/3, 1/3}, {1/3, 1/3, 1/3, 1/3}, {1/3, 1/3, 1/3, 1/
    3}, {1/3, 1/3, 1/3, 82/3}};
A = {{5/3, 0, 1/3, 0}, {0, 5/3, 0, 1/3}, {1/3, 0, 10/3, 0}, {0, 1/3, 
    0, 10/3}};
result = First /@ Eigensystem[{B, A}, 1]

Im[result] // FullSimplify
(*{0,{0,0,0,0}}*)

Dejé que la computadora funcionara durante la noche para obtener la respuesta. Simplifyno llegué allí.

Answer 4

Pruebe la evaluación numérica con N [] de Mathematica

B = {{17/3, 1/3, 1/3, 1/3}, {1/3, 1/3, 1/3, 1/3}, {1/3, 1/3, 1/3, 
1/3}, {1/3, 1/3, 1/3, 82/3}};
A = {{5/3, 0, 1/3, 0}, {0, 5/3, 0, 1/3}, {1/3, 0, 10/3, 0}, {0, 1/3, 
0, 10/3}};
First /@ Eigensystem[{N@B, N@A}, 1]

El resultado debe ser

{8.33542, {0.0306117, -0.176485, 0.00707634, 0.983802}}

Answer 5

Para aprovechar la respuesta de Bill, se puede usar CountRoots[]el polinomio característico del lápiz de matriz dado, si solo se desea mostrar que los valores propios son todos reales:

CountRoots[CharacteristicPolynomial[{B, A}, x], x]
   4

Luego se puede usar RootIntervals[]para encontrar corchetes para las raíces:

RootIntervals[CharacteristicPolynomial[{B, A}, x], Reals]
   {{{0, 0}, {0, 1}, {3, 4}, {4, 10}}, {{1}, {1}, {1}, {1}}}

Tenga en cuenta que la raíz en $x=0$estaba exactamente aislado. El valor propio más grande del lápiz correspondería a la última entrada con el intervalo de aislamiento$(4,10)$, que luego puedes donar a Solve[]:

Solve[CharacteristicPolynomial[{B, A}, x] == 0 && 4 < x < 10, x, 
      Cubics -> False, Quartics -> False]
   {{x -> Root[-19440 + 76898 #1 - 28959 #1^2 + 2401 #1^3 &, 3]}}

Bob ya ha mencionado casus irreducibilis ; Para resumir, si insiste en una representación radical, entonces el uso de una representación compleja es (a menudo) inevitable, incluso si todas las raíces son reales.