# Symbolic Quaternion Multiplication

It is possible to do the symbolic multiplication $$qq^*$$ of a quaternion $$q=a+bi+cj+dk$$ by its conjugate $$q^*=a-bi-cj-dk$$ using Mathematica? It seems that Quaternion package only works with numeric entries.

Needs["Quaternions"]
q = Quaternion[a, b, c, d];
q ** Conjugate[q]


Quaternion[a^2 + b^2 + c^2 + d^2, 0, 0, 0]

Alternatively to the other answer, you can use this code to define quaternion algebra:

Clear["Global*"]
Unprotect[Dot];
Dot[x_?NumberQ, y_] := x y;
Protect[Dot];
Matrix /: Matrix[x_?MatrixQ] :=
First[First[x]] /; x == First[First[x]] IdentityMatrix[Length[x]];
Matrix /: NonCommutativeMultiply[Matrix[x_?MatrixQ], y_] :=
Dot[Matrix[x], y];
Matrix /: NonCommutativeMultiply[y_, Matrix[x_?MatrixQ]] :=
Dot[y, Matrix[x]];
Matrix /: Dot[Matrix[x_], Matrix[y_]] := Matrix[x . y];
Matrix /: Matrix[x_] + Matrix[y_] := Matrix[x + y];
Matrix /: x_?NumericQ + Matrix[y_] :=
Matrix[x IdentityMatrix[Length[y]] + y];
Matrix /: x_?NumericQ Matrix[y_] := Matrix[x y];
Matrix /: Matrix[x_]*Matrix[y_] := Matrix[x . y] /; x . y == y . x;
Matrix /: Power[Matrix[x_?MatrixQ], y_?NumericQ] :=
Matrix[MatrixPower[x, y]];
Matrix /: Power[Matrix[x_?MatrixQ], Matrix[y_?MatrixQ]] :=
Exp[Matrix[y] . Log[Matrix[x]]];
Matrix /: Im[Matrix[x_?MatrixQ]] := Matrix[Im[x]]
Matrix /: Re[Matrix[x_?MatrixQ]] := Matrix[Re[x]]
Matrix /: Arg[Matrix[x_?MatrixQ]] := Matrix[Arg[x]]

$$Post2 = FullSimplify[FullSimplify[# /. i -> Matrix[( { {I, 0}, {0, -I} } )] /. j -> Matrix[( { {0, 1}, {-1, 0} } )] /. k -> Matrix[( { {0, I}, {I, 0} } ) ] /. f_[args1___?NumericQ, Matrix[mat_], args2___?NumericQ] :> Matrix[MatrixFunction[f[args1, #, args2] &, mat]]] /. Matrix[{{a_, c_}, {d_, b_}}] :> Re[a] + Im[a] i + Re[c] j + Im[c] k ] /. Matrix[{{a_, c_}, {d_, b_}}] :> Re[a] + Im[a] i + Re[c] j + Im[c] k &;$$Post = Nest[\$Post2, #, 3] &;


Then input the following:

NumericQ[a] = NumericQ[b] = NumericQ[c] = NumericQ[d] = True;
(a + b i + c j + d k) ** (a - b i - c j - d k)


You will get

Out:=a^2 + b^2 + c^2 + d^2