Simplificando a parte imaginária

Question

Estou resolvendo o seguinte autossistema e obtenho um resultado que parece de valor complexo. Espero que o resultado tenha 0 parte imaginária, alguém pode ver uma maneira de simplificá-lo?

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 os valores são reais

valR = val // RootReduce

Element[valR, Reals]

(* True *)

valR // N

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

No entanto, se representados por radicais, eles devem usar números complexos (consulte Casus irreducibilis)

valR // ToRadicals

Answer 2

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

retorna

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

Answer 3

Isso leva um bom tempo, mas funciona se você apenas quiser provar que a parte imaginária é $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}}*)

Deixei o computador funcionar durante a noite para obter a resposta. Simplifynão chegou lá.

Answer 4

Experimente a avaliação numérica com o N do 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]

O resultado deve ser

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

Answer 5

Para pegar carona na resposta de Bill, pode-se apenas usar CountRoots[]no polinômio característico do lápis de matriz dado, se quisermos apenas mostrar que os autovalores são todos reais:

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

Pode-se então usar RootIntervals[]para encontrar colchetes para as raízes:

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

Observe que a raiz em $x=0$estava exatamente isolado. O maior autovalor do lápis corresponderia à última entrada com o intervalo de isolamento$(4,10)$, que você pode dar 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 já mencionou casus irreducibilis ; para resumir, se você insiste em uma representação radical, então o uso de uma representação complexa é (freqüentemente) inevitável, mesmo se todas as raízes forem reais.