四元数

hbghlyj

以下是使用 2×2 复数矩阵$\begin{pmatrix}
z & w\\
-\bar{w} & \bar{z}\\
\end{pmatrix}
\in M_2(\mathbb{C})$表示四元数$z+wj$的 Mathematica 代码：

1. Clear["Global`*"]
2. Unprotect[Dot];
3. Dot[x_?NumberQ, y_] := x y;
4. Protect[Dot];
5. Matrix /: Matrix[x_?MatrixQ] :=
6.   First[First[x]] /; x == First[First[x]] IdentityMatrix[Length[x]];
7. Matrix /: NonCommutativeMultiply[Matrix[x_?MatrixQ], y_] :=
8.   Dot[Matrix[x], y];
9. Matrix /: NonCommutativeMultiply[y_, Matrix[x_?MatrixQ]] :=
10.   Dot[y, Matrix[x]];
11. Matrix /: Dot[Matrix[x_], Matrix[y_]] := Matrix[x . y];
12. Matrix /: Matrix[x_] + Matrix[y_] := Matrix[x + y];
13. Matrix /: x_?NumericQ + Matrix[y_] :=
14.   Matrix[x IdentityMatrix[Length[y]] + y];
15. Matrix /: x_?NumericQ Matrix[y_] := Matrix[x y];
16. Matrix /: Matrix[x_]*Matrix[y_] := Matrix[x . y] /; x . y == y . x;
17. Matrix /: Power[Matrix[x_?MatrixQ], y_?NumericQ] :=
18.   Matrix[MatrixPower[x, y]];
19. Matrix /: Power[Matrix[x_?MatrixQ], Matrix[y_?MatrixQ]] :=
20.   Exp[Matrix[y] . Log[Matrix[x]]];
21. Matrix /: Im[Matrix[x_?MatrixQ]] := Matrix[Im[x]]
22. Matrix /: Re[Matrix[x_?MatrixQ]] := Matrix[Re[x]]
23. Matrix /: Arg[Matrix[x_?MatrixQ]] := Matrix[Arg[x]]
25. $Post2 = FullSimplify[FullSimplify[# /. i -> Matrix[( {
26.                {I, 0},
27.                {0, -I}
28.               } )] /. j -> Matrix[( {
29.               {0, 1},
30.               {-1, 0}
31.              } )] /. k -> Matrix[( {
32.              {0, I},
33.              {I, 0}
34.             } ) ] /.
35.         f_[args1___?NumericQ, Matrix[mat_], args2___?NumericQ] :>
36.          Matrix[MatrixFunction[f[args1, #, args2] &, mat]]] /.
37.       Matrix[{{a_, c_}, {d_, b_}}] :>
38.        Re[a] + Im[a] i + Re[c] j + Im[c] k ] /.
39.     Matrix[{{a_, c_}, {d_, b_}}] :>
40.      Re[a] + Im[a] i + Re[c] j + Im[c] k &;
41. $Post = Nest[$Post2, #, 3] &;

复制代码

执行此操作后，您可以在普通表达式中使用四元数（i、j 和 k 的表达式）与其他数字。只有当四元数可交换时，才会计算四元数的乘法，在其他情况下，使用非交换乘法运算符 (**)，始终会计算四元数的乘法。

测试：四元数的 Exp 和 Log 与矩阵的 Exp 和 Log 相同。
In:=Log[(i + 5) ** (j - 1)]

Out:=1/18 (-2 Sqrt[3] (i - 5 j - k) (Pi - ArcTan[(3 Sqrt[3])/5]) + 9 Log[52])