Some quaternion manipulation funcs

quat.red

Red [
	Description: {Some quaternion manipulation funcs}
	Date: 21-Sep-2019
	Author: "Toomas Vooglaid"
]
quaternion: context [
	quaternion!: make typeset! [block! hash! vector!]
	e-pow: function [q][
		sc: x: y: z: none
		set [sc x y z] q
		e': (exp 1) ** sc
		sc: cos v: sqrt (x ** 2) + (y ** 2) + (z ** 2)
		im: (sin v) / v
		reduce [e' * sc e' * x * im e' * y * im e' * z * im]
	]
	multiply: function [q [integer! float! quaternion!] p [integer! float! quaternion!]][
		case [
			number? q [collect [forall p [keep p/1 * q]]]
			number? p [collect [forall q [keep q/1 * p]]]
			'else [
				reduce [
					(q/1 * p/1) - (q/2 * p/2) - (q/3 * p/3) - (q/4 * p/4)
					(q/1 * p/2) + (q/2 * p/1) + (q/3 * p/4) - (q/4 * p/3)
					(q/1 * p/3) + (q/3 * p/1) + (q/4 * p/2) - (q/2 * p/4)
					(q/1 * p/4) + (q/4 * p/1) + (q/2 * p/3) - (q/3 * p/2)
				]
			]
		]
	]
	add: func [q [integer! float! quaternion!] p [integer! float! quaternion!]][
		case [
			number? q [head change copy p p/1 + q]
			number? p [head change copy q q/1 + p]
			'else [collect [forall q [keep q/1 + p/(index? q)]]]
		]
	]
	negate: 	func [q [quaternion!]][collect [forall q [keep 0 - q/1]]]
	conjugate: 	func [q [quaternion!]][collect [keep q/1  q: next q  forall q [keep 0 - q/1]]]
	norm: 		func [q [quaternion!]][sqrt first multiply q conjugate copy q]
	normalize: 	function [q [quaternion!]][n: norm q   collect [forall q [keep q/1 / n]]]
	inverse: 	func [q [quaternion!]][(conjugate q) / ((norm q) ** 2)]
	rotate: function [axis [quaternion!] q [quaternion!]][ ; axis: [ang-degrees normalized-vec]
		co: cosine .5 * axis/1
		si: sine .5 * axis/1
		q1: reduce [co si * axis/2 si * axis/3 si * axis/4]
		q2: multiply q1 q
		q3: conjugate q1
		multiply q2 q3
	]
]