problem with Quaternion polynomial root solver
- To: mathgroup at smc.vnet.net
- Subject: [mg68228] problem with Quaternion polynomial root solver
- From: Roger Bagula <rlbagula at sbcglobal.net>
- Date: Sun, 30 Jul 2006 04:47:49 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Using my 2by2 matrix representaion of quaternions I solved the
triabonacci polynomial as a Quaternion polynomial.
My problem is that the 6 roots of a cubic come out as :
root=q1+I*q2
Example:
{0.709822\[InvisibleSpace] + 0.303145 \[ImaginaryI],
0.46714\[InvisibleSpace] + 1.31925 \[ImaginaryI], 0.350727\
\[InvisibleSpace] - 0.847789 \[ImaginaryI],
0.966809\[InvisibleSpace] + 0.0242682 \[ImaginaryI]}
Another problem is that the result is no longer a Pisot in Quarernion terms.
My question ( to be clear for Paul Abbott) is:
1) how do I get only real quaternion roots if possible or convert these
roots to real quaternions?
2) how do I find polynomials that give real Pisot quaternions
( roots all modulus less than one except for one real root in the "t"
part of the quaternion)
Mathematica:
i = {{0, 1}, {-1, 0}};
j = {{0, I}, {I, 0}};
k = {{I, 0}, {0, -I}};
e = IdentityMatrix[2];
q[t_, x_, y_, z_] := e*t + x*i + j*y + k*z;
q2 = ExpandAll[q1.q1]
q3 = ExpandAll[q1.q2]
Table[q3[[i, j]] - q2[[i, j]] - q1[[i, j]] - e[[i, j]], {i, 1, 2}, {j,
1, 2}]
Solve[Flatten[Table[q3[[i, j]] - q2[[i, j]] - q1[[i, j]] - e[[i, j]] == 0,
{i, 1, 2}, {j, 1, 2}]], {t, x, y, z}]
a = Table[{t, x, y, z} /. NSolve[Flatten[Table[q3[[i, j]] - q2[[i, j]] -
q1[[
i, j]] - e[[i, j]] ==
0, {i, 1, 2}, {j, 1, 2}]], {t, x, y, z}][[n]], {n, 1, 6}]
Abs[a]