Quaternion type: Difference between revisions
Added Easylang
(Complete task for Racket) |
(Added Easylang) |
||
| (188 intermediate revisions by 71 users not shown) | |||
Line 1:
{{task}}
[[wp:Quaternion|Quaternions]] are an extension of the idea of [[Arithmetic/Complex|complex numbers]].
A complex number has a real and complex part, sometimes written as <big> <code> a + bi, </code> </big>
<br>where <big> <code> a </code> </big> and <big> <code> b </code> </big> stand for real numbers, and <big> <code> i </code> </big> stands for the square root of minus 1.
An example of a complex number might be <big> <code> -3 + 2i, </code> </big>
<br>where the real part, <big> <code> a </code> </big> is <big> <code> '''-3.0''' </code> </big> and the complex part, <big> <code> b </code> </big> is <big> <code> '''+2.0'''. </code> </big>
A quaternion has one real part and ''three'' imaginary parts, <big> <code> i, </code> </big> <big> <code> j, </code> </big> and <big> <code> k. </code> </big>
A quaternion might be written as <big> <code> a + bi + cj + dk. </code> </big>
In the quaternion numbering system:
:::* <big> <code> i∙i = j∙j = k∙k = i∙j∙k = -1, </code> </big> or more simply,
:::* <big> <code> ii = jj = kk = ijk = -1. </code> </big>
The order of multiplication is important, as, in general, for two quaternions:
:::: <big> <code> q<sub>1</sub> </code> </big> and <big> <code> q<sub>2</sub>: </code> </big> <big> <code> q<sub>1</sub>q<sub>2</sub> ≠ q<sub>2</sub>q<sub>1</sub>. </code> </big>
An example of a quaternion might be <big> <code> 1 +2i +3j +4k </code> </big>
There is a list form of notation where just the numbers are shown and the imaginary multipliers <big> <code>i, </code> </big> <big> <code> j, </code> </big> and <big> <code> k </code> </big> are assumed by position.
So the example above would be written as <big> <code> (1, 2, 3, 4) </code> </big>
;Task:
Given the three quaternions and their components: <big>
q = (1, 2, 3, 4) = (a,<sub> </sub> b,<sub> </sub> c,<sub> </sub> d)
q<sub>1</sub> = (2, 3, 4, 5) = (a<sub>1</sub>, b<sub>1</sub>, c<sub>1</sub>, d<sub>1</sub>)
q<sub>2</sub> = (3, 4, 5, 6) = (a<sub>2</sub>, b<sub>2</sub>, c<sub>2</sub>, d<sub>2</sub>) </big>
And a wholly real number <big> <code> r = 7. </code>
Create functions (or classes) to perform simple maths with quaternions including computing:
# The norm of a quaternion: <br><big><code><math>= \sqrt{a^2 + b^2 + c^2 + d^2}</math></code></big>
# The negative of a quaternion: <br> <big> <code> = (-a, -b, -c, -d)</code> </big>
# The conjugate of a quaternion: <br> <big> <code> = ( a, -b, -c, -d)</code> </big>
# Addition of a real number <big> <code> r </code> </big> and a quaternion <big> <code> q: </code> </big> <br> <big> <code> r + q = q + r = (a+r, b, c, d) </code> </big>
# Addition of two quaternions: <br> <big> <code> q<sub>1</sub> + q<sub>2</sub> = (a<sub>1</sub>+a<sub>2</sub>, b<sub>1</sub>+b<sub>2</sub>, c<sub>1</sub>+c<sub>2</sub>, d<sub>1</sub>+d<sub>2</sub>) </code> </big>
# Multiplication of a real number and a quaternion: <br> <big> <code> qr = rq = (ar, br, cr, dr) </code> </big>
# Multiplication of two quaternions <big> <code> q<sub>1</sub> </code> </big> and <big><code>q<sub>2</sub> </code> </big> is given by: <br> <big> <code> ( a<sub>1</sub>a<sub>2</sub> − b<sub>1</sub>b<sub>2</sub> − c<sub>1</sub>c<sub>2</sub> − d<sub>1</sub>d<sub>2</sub>, </code> <br> <code> a<sub>1</sub>b<sub>2</sub> + b<sub>1</sub>a<sub>2</sub> + c<sub>1</sub>d<sub>2</sub> − d<sub>1</sub>c<sub>2</sub>, </code> <br> <code> a<sub>1</sub>c<sub>2</sub> − b<sub>1</sub>d<sub>2</sub> + c<sub>1</sub>a<sub>2</sub> + d<sub>1</sub>b<sub>2</sub>, </code> <br> <code> a<sub>1</sub>d<sub>2</sub> + b<sub>1</sub>c<sub>2</sub> − c<sub>1</sub>b<sub>2</sub> + d<sub>1</sub>a<sub>2</sub> ) </code> </big>
# Show that, for the two quaternions <big> <code> q<sub>1</sub> </code> </big> and <big> <code> q<sub>2</sub>: <br> q<sub>1</sub>q<sub>2</sub> ≠ q<sub>2</sub>q<sub>1</sub> </code> </big>
<br>
If a language has built-in support for quaternions, then use it.
;C.f.:
* [[Vector products]]
* [http://www.maths.tcd.ie/pub/HistMath/People/Hamilton/QLetter/QLetter.pdf On Quaternions]; or on a new System of Imaginaries in Algebra. By Sir William Rowan Hamilton LL.D, P.R.I.A., F.R.A.S., Hon. M. R. Soc. Ed. and Dub., Hon. or Corr. M. of the Royal or Imperial Academies of St. Petersburgh, Berlin, Turin and Paris, Member of the American Academy of Arts and Sciences, and of other Scientific Societies at Home and Abroad, Andrews' Prof. of Astronomy in the University of Dublin, and Royal Astronomer of Ireland.
<br><br>
=={{header|Action!}}==
{{libheader|Action! Tool Kit}}
{{libheader|Action! Real Math}}
<syntaxhighlight lang="action!">INCLUDE "H6:REALMATH.ACT"
DEFINE A_="+0"
DEFINE B_="+6"
DEFINE C_="+12"
DEFINE D_="+18"
TYPE Quaternion=[CARD a1,a2,a3,b1,b2,b3,c1,c2,c3,d1,d2,d3]
REAL neg
PROC Init()
ValR("-1",neg)
RETURN
BYTE FUNC Positive(REAL POINTER x)
BYTE ARRAY tmp
tmp=x
IF (tmp(0)&$80)=$00 THEN
RETURN (1)
FI
RETURN (0)
PROC PrintQuat(Quaternion POINTER q)
PrintR(q A_)
IF Positive(q B_) THEN Put('+) FI
PrintR(q B_) Put('i)
IF Positive(q C_) THEN Put('+) FI
PrintR(q C_) Put('j)
IF Positive(q D_) THEN Put('+) FI
PrintR(q D_) Put('k)
RETURN
PROC PrintQuatE(Quaternion POINTER q)
PrintQuat(q) PutE()
RETURN
PROC QuatIntInit(Quaternion POINTER q INT ia,ib,ic,id)
IntToReal(ia,q A_)
IntToReal(ib,q B_)
IntToReal(ic,q C_)
IntToReal(id,q D_)
RETURN
PROC Sqr(REAL POINTER a,b)
RealMult(a,a,b)
RETURN
PROC QuatNorm(Quaternion POINTER q REAL POINTER res)
REAL r1,r2,r3
Sqr(q A_,r1) ;r1=q.a^2
Sqr(q B_,r2) ;r2=q.b^2
RealAdd(r1,r2,r3) ;r3=q.a^2+q.b^2
Sqr(q C_,r1) ;r1=q.c^2
RealAdd(r3,r1,r2) ;r2=q.a^2+q.b^2+q.c^2
Sqr(q D_,r1) ;r1=q.d^2
RealAdd(r2,r1,r3) ;r3=q.a^2+q.b^2+q.c^2+q.d^2
Sqrt(r3,res) ;res=sqrt(q.a^2+q.b^2+q.c^2+q.d^2)
RETURN
PROC QuatNegative(Quaternion POINTER q,res)
RealMult(q A_,neg,res A_) ;res.a=-q.a
RealMult(q B_,neg,res B_) ;res.b=-q.b
RealMult(q C_,neg,res C_) ;res.c=-q.c
RealMult(q D_,neg,res D_) ;res.d=-q.d
RETURN
PROC QuatConjugate(Quaternion POINTER q,res)
RealAssign(q A_,res A_) ;res.a=q.a
RealMult(q B_,neg,res B_) ;res.b=-q.b
RealMult(q C_,neg,res C_) ;res.c=-q.c
RealMult(q D_,neg,res D_) ;res.d=-q.d
RETURN
PROC QuatAddReal(Quaternion POINTER q REAL POINTER r
Quaternion POINTER res)
RealAdd(q A_,r,res A_) ;res.a=q.a+r
RealAssign(q B_,res B_) ;res.b=q.b
RealAssign(q C_,res C_) ;res.c=q.c
RealAssign(q D_,res D_) ;res.d=q.d
RETURN
PROC QuatAdd(Quaternion POINTER q1,q2,res)
RealAdd(q1 A_,q2 A_,res A_) ;res.a=q1.a+q2.a
RealAdd(q1 B_,q2 B_,res B_) ;res.b=q1.b+q2.b
RealAdd(q1 C_,q2 C_,res C_) ;res.c=q1.c+q2.c
RealAdd(q1 D_,q2 D_,res D_) ;res.d=q1.d+q2.d
RETURN
PROC QuatMultReal(Quaternion POINTER q REAL POINTER r
Quaternion POINTER res)
RealMult(q A_,r,res A_) ;res.a=q.a*r
RealMult(q B_,r,res B_) ;res.b=q.b*r
RealMult(q C_,r,res C_) ;res.c=q.c*r
RealMult(q D_,r,res D_) ;res.d=q.d*r
RETURN
PROC QuatMult(Quaternion POINTER q1,q2,res)
REAL r1,r2
RealMult(q1 A_,q2 A_,r1) ;r1=q1.a*q2.a
RealMult(q1 B_,q2 B_,r2) ;r2=q1.b*q2.b
RealSub(r1,r2,r3) ;r3=q1.a*q2.a-q1.b*q2.b
RealMult(q1 C_,q2 C_,r1) ;r1=q1.c*q2.c
RealSub(r3,r1,r2) ;r2=q1.a*q2.a-q1.b*q2.b-q1.c*q2.c
RealMult(q1 D_,q2 D_,r1) ;r1=q1.d*q2.d
RealSub(r2,r1,res A_) ;res.a=q1.a*q2.a-q1.b*q2.b-q1.c*q2.c-q1.d*q2.d
RealMult(q1 A_,q2 B_,r1) ;r1=q1.a*q2.b
RealMult(q1 B_,q2 A_,r2) ;r2=q1.b*q2.a
RealAdd(r1,r2,r3) ;r3=q1.a*q2.b+q1.b*q2.a
RealMult(q1 C_,q2 D_,r1) ;r1=q1.c*q2.d
RealAdd(r3,r1,r2) ;r2=q1.a*q2.b+q1.b*q2.a+q1.c*q2.d
RealMult(q1 D_,q2 C_,r1) ;r1=q1.d*q2.c
RealSub(r2,r1,res B_) ;res.b=q1.a*q2.b+q1.b*q2.a+q1.c*q2.d-q1.d*q2.c
RealMult(q1 A_,q2 C_,r1) ;r1=q1.a*q2.c
RealMult(q1 B_,q2 D_,r2) ;r2=q1.b*q2.d
RealSub(r1,r2,r3) ;r3=q1.a*q2.c-q1.b*q2.d
RealMult(q1 C_,q2 A_,r1) ;r1=q1.c*q2.a
RealAdd(r3,r1,r2) ;r2=q1.a*q2.c-q1.b*q2.d+q1.c*q2.a
RealMult(q1 D_,q2 B_,r1) ;r1=q1.d*q2.b
RealAdd(r2,r1,res C_) ;res.c=q1.a*q2.c-q1.b*q2.d+q1.c*q2.a+q1.d*q2.b
RealMult(q1 A_,q2 D_,r1) ;r1=q1.a*q2.d
RealMult(q1 B_,q2 C_,r2) ;r2=q1.b*q2.c
RealAdd(r1,r2,r3) ;r3=q1.a*q2.d+q1.b*q2.c
RealMult(q1 C_,q2 B_,r1) ;r1=q1.c*q2.b
RealSub(r3,r1,r2) ;r2=q1.a*q2.d+q1.b*q2.c-q1.c*q2.b
RealMult(q1 D_,q2 A_,r1) ;r1=q1.d*q2.a
RealAdd(r2,r1,res D_) ;res.d=q1.a*q2.d+q1.b*q2.c-q1.c*q2.b+q1.d*q2.a
RETURN
PROC Main()
Quaternion q,q1,q2,q3
REAL r,r2
Put(125) PutE() ;clear the screen
MathInit()
Init()
QuatIntInit(q,1,2,3,4)
QuatIntInit(q1,2,3,4,5)
QuatIntInit(q2,3,4,5,6)
IntToReal(7,r)
Print(" q = ") PrintQuatE(q)
Print("q1 = ") PrintQuatE(q1)
Print("q2 = ") PrintQuatE(q2)
Print(" r = ") PrintRE(r) PutE()
QuatNorm(q,r2) Print(" Norm(q) = ") PrintRE(r2)
QuatNorm(q1,r2) Print("Norm(q1) = ") PrintRE(r2)
QuatNorm(q2,r2) Print("Norm(q2) = ") PrintRE(r2)
QuatNegative(q,q3) Print(" -q = ") PrintQuatE(q3)
QuatConjugate(q,q3) Print(" Conj(q) = ") PrintQuatE(q3)
QuatAddReal(q,r,q3) Print(" q+r = ") PrintQuatE(q3)
QuatAdd(q1,q2,q3) Print(" q1+q2 = ") PrintQuatE(q3)
QuatAdd(q2,q1,q3) Print(" q2+q1 = ") PrintQuatE(q3)
QuatMultReal(q,r,q3) Print(" q*r = ") PrintQuatE(q3)
QuatMult(q1,q2,q3) Print(" q1*q2 = ") PrintQuatE(q3)
QuatMult(q2,q1,q3) Print(" q2*q1 = ") PrintQuatE(q3)
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Quaternion_type.png Screenshot from Atari 8-bit computer]
<pre>
q = 1+2i+3j+4k
q1 = 2+3i+4j+5k
q2 = 3+4i+5j+6k
r = 7
Norm(q) = 5.47722543
Norm(q1) = 7.34846906
Norm(q2) = 9.27361833
-q = -1-2i-3j-4k
Conj(q) = 1-2i-3j-4k
q+r = 8+2i+3j+4k
q1+q2 = 5+7i+9j+11k
q2+q1 = 5+7i+9j+11k
q*r = 7+14i+21j+28k
q1*q2 = -56+16i+24j+26k
q2*q1 = -56+18i+20j+28k
</pre>
=={{header|Ada}}==
The package specification (works with any floating-point type):
<
type Real is digits <>;
package Quaternions is
Line 47 ⟶ 259:
function "*" (Left, Right : Quaternion) return Quaternion;
function Image (Left : Quaternion) return String;
end Quaternions;</
The package implementation:
<
package body Quaternions is
package Elementary_Functions is
Line 107 ⟶ 319:
Real'Image (Left.D) & "k";
end Image;
end Quaternions;</
Test program:
<
with Quaternions;
procedure Test_Quaternion is
Line 134 ⟶ 346:
Put_Line ("q1 * q2 = " & Image (q1 * q2));
Put_Line ("q2 * q1 = " & Image (q2 * q1));
end Test_Quaternion;</
{{out}}
<pre>
q = 1.00000E+00 + 2.00000E+00i + 3.00000E+00j + 4.00000E+00k
Line 155 ⟶ 367:
=={{header|ALGOL 68}}==
{{trans|python}}
{{works with|ALGOL 68|Revision 1 -
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-2.6 algol68g-2.6].}}
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''.}}
'''File: prelude/Quaternion.a68'''<syntaxhighlight lang="algol68"># -*- coding: utf-8 -*- #
COMMENT REQUIRES:
MODE QUATSCAL = REAL; # Scalar #
QUATSCAL quat small scal = small real;
END COMMENT
# PROVIDES: #
FORMAT quat scal fmt := $g(-0, 4)$;
FORMAT signed fmt = $b("+", "")f(quat scal fmt)$;
FORMAT quat fmt = $f(quat scal fmt)"+"f(quat scal fmt)"i+"f(quat scal fmt)"j+"f(quat scal fmt)"k"$;
FORMAT squat fmt = $f(signed fmt)f(signed fmt)"i"f(signed fmt)"j"f(signed fmt)"k"$;
MODE QUAT = STRUCT(QUATSCAL r, i, j, k);
QUAT i=(0, 1, 0, 0),
j=(0, 0, 1, 0),
k=(0, 0, 0, 1);
MODE QUATCOSCAL = UNION(INT, SHORT REAL, SHORT INT);
MODE QUATSUBSCAL = UNION(QUATCOSCAL, QUATSCAL);
MODE COMPLSCAL = STRUCT(QUATSCAL r, im);
# compatable but not the same #
MODE ISOQUAT = UNION([]REAL, []INT, []SHORT REAL, []SHORT INT, []QUATSCAL);
MODE COQUAT = UNION(COMPLSCAL, QUATCOSCAL, ISOQUAT);
MODE SUBQUAT = UNION(COQUAT, QUAT); # subset is itself #
MODE QUATERNION = QUAT;
PROC quat fix type error = (QUAT quat, []STRING msg)BOOL: (
putf(stand error, ($"Type error:"$,$" "g$, msg, quat fmt, quat, $l$));
stop
);
COMMENT
For a list of coercions expected in A68 c.f.
* http://rosettacode.org/wiki/ALGOL_68#Coercion_.28casting.29 # ...
Pre-Strong context: Deproceduring, dereferencing & uniting. e.g. OP arguments
* soft(deproceduring for assignment),
* weak(dereferencing for slicing and OF selection),
* meek(dereferencing for indexing, enquiries and PROC calls),
* firm(uniting of OPerators),
Strong context only: widening (INT=>REAL=>COMPL), rowing (REAL=>[]REAL) & voiding
* strong(widening,rowing,voiding for identities/initialisations, arguments and casts et al)
Key points:
* arguments to OPerators do not widen or row!
* UNITING is permitted in OP/String ccontext.
There are 4 principle scenerios for most operators:
+---------------+-------------------------------+-------------------------------+
| OP e.g. * | SCALar | QUATernion |
+---------------+-------------------------------+-------------------------------+
| SCALar | SCAL * SCAL ... inherit | SCAL * QUAT |
+---------------+-------------------------------+-------------------------------+
| QUATernion | QUAT * SCAL | QUAT * QUAT |
+---------------+-------------------------------+-------------------------------+
However this is compounded with SUBtypes of the SCALar & isomorphs the QUATernion,
e.g.
* SCAL may be a superset of SHORT REAL or INT - a widening coercion is required
* QUAT may be a superset eg of COMPL or [4]INT
* QUAT may be a structural isomorph eg of [4]REAL
+---------------+---------------+---------------+---------------+---------------+
| OP e.g. * | SUBSCAL | SCALar | COQUAT | QUATernion |
+---------------+---------------+---------------+---------------+---------------+
| SUBSCAL | | inherit | SUBSCAT*QUAT |
+---------------+ inherit +---------------+---------------+
| SCALar | | inherit | SCAL * QUAT |
+---------------+---------------+---------------+---------------+---------------+
| COQUAT | inherit | inherit | inherit | COQUAT*QUAT |
+---------------+---------------+---------------+---------------+---------------+
| QUATernion | QUAT*SUBSCAL | QUAT*SCAL | QUAT * COQUAT | QUAT * QUAT |
+---------------+---------------+---------------+---------------+---------------+
Keypoint: if an EXPLICIT QUAT is not involved, then we can simple inherit, OR QUATINIT!
END COMMENT
MODE CLASSQUAT = STRUCT(
PROC (REF QUAT #new#,
PROC (REF QUAT #self#)QUAT conjugate,
PROC (REF QUAT #self#)
PROC (REF QUAT #self#)
PROC (REF QUAT #self#)QUAT reciprocal,
PROC (REF QUAT #self#)STRING repr,
Line 185 ⟶ 469:
CLASSQUAT class quat = (
# PROC new =#(REF QUAT new,
# 'Defaults all parts of quaternion to zero' #
IF new ISNT REF QUAT(NIL) THEN new ELSE HEAP QUAT FI := (
),
# PROC conjugate =#(REF QUAT self)QUAT:
(
# PROC norm sq =#(REF QUAT self)
# PROC norm =#(REF QUAT self)
sqrt((norm sq OF class quat)(self)),
# PROC reciprocal =#(REF QUAT self)QUAT:(
QUAT conj = (conjugate OF class quat)(self);
(
),
Line 208 ⟶ 492:
# 'Shorter form of Quaternion as string' #
FILE f; STRING s; associate(f, s);
putf(f, (squat fmt,
i OF self>=0, i OF self, j OF self>=0, j OF self, k OF self>=0, k OF self));
close(f);
Line 215 ⟶ 499:
# PROC neg =#(REF QUAT self)QUAT:
(-
# PROC add =#(REF QUAT self, SUBQUAT other)QUAT:
CASE other IN
(QUAT other): (
(
OUT IF quat fix type error(SKIP,"in add") THEN SKIP ELSE stop FI
ESAC,
Line 228 ⟶ 513:
# PROC sub =#(REF QUAT self, SUBQUAT other)QUAT:
CASE other IN
(QUAT other): (
(
OUT IF quat fix type error(self,"in sub") THEN SKIP ELSE stop FI
ESAC,
Line 235 ⟶ 521:
CASE other IN
(QUAT other):(
),
(
OUT IF quat fix type error(self,"in mul") THEN SKIP ELSE stop FI
ESAC,
Line 246 ⟶ 533:
CASE other IN
(QUAT other): (mul OF class quat)(LOC QUAT := other, self),
(
OUT IF quat fix type error(self,"in rmul") THEN SKIP ELSE stop FI
ESAC,
Line 252 ⟶ 540:
CASE other IN
(QUAT other): (mul OF class quat)(self, (reciprocal OF class quat)(LOC QUAT := other)),
(
OUT IF quat fix type error(self,"in div") THEN SKIP ELSE stop FI
ESAC,
Line 258 ⟶ 547:
CASE other IN
(QUAT other): (div OF class quat)(LOC QUAT := other, self),
(
OUT IF quat fix type error(self,"in rdiv") THEN SKIP ELSE stop FI
ESAC,
Line 264 ⟶ 554:
QUAT fac := self;
QUAT sum := 1.0 + fac;
FOR i FROM 2 TO bits width WHILE ABS(fac + quat small
VOID(sum +:= (fac *:= self /
OD;
sum
Line 271 ⟶ 561:
);
PRIO INIT = 1;
OP QUATSCALINIT = (QUATSUBSCAL scal)QUATSCAL:
CASE scal IN
(INT scal): scal,
(SHORT INT scal): scal,
(SHORT REAL scal): scal
OUT IF quat fix type error(SKIP,"in QUATSCALINIT") THEN SKIP ELSE stop FI
ESAC;
OP INIT = (REF QUAT new, SUBQUAT from)REF QUAT:
new :=
CASE from IN
(QUATSUBSCAL scal):(QUATSCALINIT scal, 0, 0, 0)
#(COQUAT rijk):(new OF class quat)(LOC QUAT := new, rijk[1], rijk[2], rijk[3], rijk[4]),#
OUT IF quat fix type error(SKIP,"in INIT") THEN SKIP ELSE stop FI
ESAC;
OP
OP + = (QUAT q)QUAT: q,
- = (QUAT q)QUAT: (neg OF class quat)(LOC QUAT := q),
CONJ = (QUAT q)QUAT: (conjugate OF class quat)(LOC QUAT := q),
ABS = (QUAT q)
REPR = (QUAT q)STRING: (repr OF class quat)(LOC QUAT := q);
# missing: Diadic: I, J, K END #
OP +:= = (REF QUAT a, QUAT b)QUAT: a:=( add OF class quat)(a, b),
+:= = (REF QUAT a,
+=: = (QUAT a, REF QUAT b)QUAT: b:=(radd OF class quat)(b, a),
+=: = (
# missing: Worthy PLUSAB, PLUSTO for SHORT/LONG INT
OP -:= = (REF QUAT a, QUAT b)QUAT: a:=( sub OF class quat)(a, b),
-:= = (REF QUAT a,
# missing: Worthy MINUSAB for SHORT/LONG INT
PRIO *=: = 1, /=: = 1;
OP *:= = (REF QUAT a, QUAT b)QUAT: a:=( mul OF class quat)(a, b),
*:= = (REF QUAT a,
*=: = (QUAT a, REF QUAT b)QUAT: b:=(rmul OF class quat)(b, a),
*=: = (
# missing: Worthy TIMESAB, TIMESTO for SHORT/LONG INT
OP /:= = (REF QUAT a, QUAT b)QUAT: a:=( div OF class quat)(a, b),
/:= = (REF QUAT a,
/=: = (QUAT a, REF QUAT b)QUAT: b:=(rdiv OF class quat)(b, a),
/=: = (
# missing: Worthy OVERAB, OVERTO for SHORT/LONG INT
OP + = (QUAT a, b)QUAT: ( add OF class quat)(LOC QUAT := a, b),
+ = (QUAT a,
+ = (
OP - = (QUAT a, b)QUAT: ( sub OF class quat)(LOC QUAT := a, b),
- = (QUAT a,
- = (
OP * = (QUAT a, b)QUAT: ( mul OF class quat)(LOC QUAT := a, b),
* = (QUAT a,
* = (
OP / = (QUAT a, b)QUAT: ( div OF class quat)(LOC QUAT := a, b),
/ = (QUAT a,
/ = (
( div OF class quat)(LOC QUAT := QUATINIT 1, a);
PROC quat exp = (QUAT q)QUAT: (exp OF class quat)(LOC QUAT := q);
SKIP # missing: quat arc{sin, cos, tan}h, log, exp, ln etc END #</syntaxhighlight>'''File: test/Quaternion.a68'''<syntaxhighlight lang="algol68">#!/usr/bin/a68g --script #
# -*- coding: utf-8 -*- #
# REQUIRES: #
MODE QUATSCAL = REAL; # Scalar #
QUATSCAL quat small scal = small real;
PR READ "prelude/Quaternion.a68" PR;
test:(
Line 338 ⟶ 646:
printf((
$"r = " f(
$"q = " f(quat fmt)l$, q,
$"q1 = " f(quat fmt)l$, q1,
$"q2 = " f(quat fmt)l$, q2,
$"ABS q = " f(
$"ABS q1 = " f(
$"ABS q2 = " f(
$"-q = " f(quat fmt)l$, -q,
$"CONJ q = " f(quat fmt)l$, CONJ q,
Line 358 ⟶ 666:
CO
$"ASSERT q1 * q2 != q2 * q1 = "f(quat fmt)l$, ASSERT q1 * q2 != q2 * q1, $l$
END CO
printf((
Line 377 ⟶ 681:
$"quat exp(pi * i) = " f(quat fmt)l$, quat exp(pi * i),
$"quat exp(pi * j) = " f(quat fmt)l$, quat exp(pi * j),
$"quat exp(pi *
));
print((REPR(-q1*q2), ", ", REPR(-q2*q1), new line))
)</
{{out}}
<pre>
r = 7.0000
Line 405 ⟶ 709:
q1 / q2 * q2 = 2.0000+3.0000i+4.0000j+5.0000k
q2 * q1 / q2 = 2.0000+3.4651i+3.9070j+4.7674k
1/q1 * q1 =
q1 / q1 = 1.0000+.0000i+.0000j+.0000k
quat exp(pi * i) = -1.0000+.0000i+.0000j+.0000k
quat exp(pi * j) = -1.0000+.0000i+.0000j+.0000k
quat exp(pi *
+56.0000-16.0000i-24.0000j-26.0000k, +56.0000-18.0000i-20.0000j-28.0000k
</pre>
=={{header|
<syntaxhighlight lang="algolw">begin
% Quaternion record type %
record Quaternion ( real a, b, c, d );
% returns the norm of the specified quaternion %
real procedure normQ ( reference(Quaternion) value q ) ;
sqrt( (a(q) * a(q)) + (b(q) * b(q)) + (c(q) * c(q)) + (d(q) * d(q)) );
% returns the negative of the specified quaternion %
reference(Quaternion) procedure negQ ( reference(Quaternion) value q ) ;
Quaternion( - a(q), - b(q), - c(q), - d(q) );
% returns the conjugate of the specified quaternion %
reference(Quaternion) procedure conjQ ( reference(Quaternion) value q ) ;
Quaternion( a(q), - b(q), - c(q), - d(q) );
% returns the sum of a real and a quaternion %
reference(Quaternion) procedure addRQ ( real value r
; reference(Quaternion) value q
) ;
Quaternion( r + a(q), b(q), c(q), d(q) );
% returns the sum of a quaternion and a real %
reference(Quaternion) procedure addQR ( reference(Quaternion) value q
; real value r
) ;
Quaternion( r + a(q), b(q), c(q), d(q) );
% returns the sum of the specified quaternions %
reference(Quaternion) procedure addQQ ( reference(Quaternion) value q1
; reference(Quaternion) value q2
) ;
Quaternion( a(q1) + a(q2), b(q1) + b(q2), c(q1) + c(q2), d(q1) + d(q2) );
% returns the specified quaternion multiplied by a real %
reference(Quaternion) procedure mulQR ( reference(Quaternion) value q
; real value r
) ;
Quaternion( r * a(q), r * b(q), r * c(q), r * d(q) );
% returns a real multiplied by the specified quaternion %
reference(Quaternion) procedure mulRQ ( real value r
; reference(Quaternion) value q
) ;
mulQR( q, r );
% returns the Quaternion product of the specified quaternions %
reference(Quaternion) procedure mulQQ( reference(Quaternion) value q1
; reference(Quaternion) value q2
) ;
Quaternion( (a(q1) * a(q2)) - (b(q1) * b(q2)) - (c(q1) * c(q2)) - (d(q1) * d(q2))
, (a(q1) * b(q2)) + (b(q1) * a(q2)) + (c(q1) * d(q2)) - (d(q1) * c(q2))
, (a(q1) * c(q2)) - (b(q1) * d(q2)) + (c(q1) * a(q2)) + (d(q1) * b(q2))
, (a(q1) * d(q2)) + (b(q1) * c(q2)) - (c(q1) * b(q2)) + (d(q1) * a(q2))
);
% returns true if the two quaternions are equal, false otherwise %
logical procedure equalQ( reference(Quaternion) value q1
; reference(Quaternion) value q2
) ;
a(q1) = a(q2) and b(q1) = b(q2) and c(q1) = c(q2) and d(q1) = d(q2);
% writes a quaternion %
procedure writeonQ( reference(Quaternion) value q ) ;
writeon( "(", a(q), ", ", b(q), ", ", c(q), ", ", d(q), ")" );
% test q1q2 = q2q1 %
reference(Quaternion) q, q1, q2;
q := Quaternion( 1, 2, 3, 4 );
q1 := Quaternion( 2, 3, 4, 5 );
q2 := Quaternion( 3, 4, 5, 6 );
% set output format %
s_w := 0; r_format := "A"; r_w := 5; r_d := 1;
write( " q:" );writeonQ( q );
write( " q1:" );writeonQ( q1 );
write( " q2:" );writeonQ( q2 );
write( "norm q:" );writeon( normQ( q ) );
write( "norm q1:" );writeon( normQ( q1 ) );
write( "norm q2:" );writeon( normQ( q2 ) );
write( " conj q:" );writeonQ( conjQ( q ) );
write( " - q:" );writeonQ( negQ( q ) );
write( " 7 + q:" );writeonQ( addRQ( 7, q ) );
write( " q + 9:" );writeonQ( addQR( q, 9 ) );
write( " q + q1:" );writeonQ( addQQ( q, q1 ) );
write( " 3 * q:" );writeonQ( mulRQ( 3, q ) );
write( " q * 4:" );writeonQ( mulQR( q, 4 ) );
% check that q1q2 not = q2q1 %
if equalQ( mulQQ( q1, q2 ), mulQQ( q2, q1 ) )
then write( "q1q2 = q2q1 ??" )
else write( "q1q2 <> q2q1" );
write( " q1q2:" );writeonQ( mulQQ( q1, q2 ) );
write( " q2q1:" );writeonQ( mulQQ( q2, q1 ) );
end.
</syntaxhighlight>
{{out}}
<pre>
q:( 1.0, 2.0, 3.0, 4.0)
q1:( 2.0, 3.0, 4.0, 5.0)
q2:( 3.0, 4.0, 5.0, 6.0)
norm q: 5.4
norm q1: 7.3
norm q2: 9.2
conj q:( 1.0, -2.0, -3.0, -4.0)
- q:( -1.0, -2.0, -3.0, -4.0)
7 + q:( 8.0, 2.0, 3.0, 4.0)
q + 9:( 10.0, 2.0, 3.0, 4.0)
q + q1:( 3.0, 5.0, 7.0, 9.0)
3 * q:( 3.0, 6.0, 9.0, 12.0)
q * 4:( 4.0, 8.0, 12.0, 16.0)
q1q2 <> q2q1
q1q2:(-56.0, 16.0, 24.0, 26.0)
q2q1:(-56.0, 18.0, 20.0, 28.0)
</pre>
=={{header|Arturo}}==
<syntaxhighlight lang="arturo">qnorm: $ => [sqrt fold & [x y] -> x + y*y]
qneg: $ => [map & => neg]
qconj: $[q] [@[q\0] ++ qneg drop q]
qaddr: function [q r][
[a b c d]: q
@[a+r b c d]
]
qadd: $ => [map couple & & => sum]
qmulr: $[q r] [map q'x -> x*r]
qmul: function [q1 q2][
[a1 b1 c1 d1]: q1
[a2 b2 c2 d2]: q2
@[
(((a1*a2) - b1*b2) - c1*c2) - d1*d2,
(((a1*b2) + b1*a2) + c1*d2) - d1*c2,
(((a1*c2) - b1*d2) + c1*a2) + d1*b2,
(((a1*d2) + b1*c2) - c1*b2) + d1*a2
]
]
; --- test quaternions ---
q: [1 2 3 4]
q1: [2 3 4 5]
q2: [3 4 5 6]
r: 7
print ['qnorm q '= qnorm q]
print ['qneg q '= qneg q]
print ['qconj q '= qconj q]
print ['qaddr q r '= qaddr q r]
print ['qmulr q r '= qmulr q r]
print ['qadd q1 q2 '= qadd q1 q2]
print ['qmul q1 q2 '= qmul q1 q2]
print ['qmul q2 q1 '= qmul q2 q1]</syntaxhighlight>
{{out}}
<pre>qnorm [1 2 3 4] = 5.477225575051661
qneg [1 2 3 4] = [-1 -2 -3 -4]
qconj [1 2 3 4] = [1 -2 -3 -4]
qaddr [1 2 3 4] 7 = [8 2 3 4]
qmulr [1 2 3 4] 7 = [7 14 21 28]
qadd [2 3 4 5] [3 4 5 6] = [5 7 9 11]
qmul [2 3 4 5] [3 4 5 6] = [-56 16 24 26]
qmul [3 4 5 6] [2 3 4 5] = [-56 18 20 28]</pre>
=={{header|ATS}}==
{{libheader|ats2-xprelude}}
<syntaxhighlight lang="ATS">
//--------------------------------------------------------------------
#include "share/atspre_staload.hats"
//--------------------------------------------------------------------
(* Here is one way to get a sqrt function without going beyond the ATS
prelude. The prelude (at the time of this writing) contains some
templates for which implementations were never added. Here I add an
implementation.
The ats2-xprelude package at
https://sourceforge.net/p/chemoelectric/ats2-xprelude contains a
much more extensive and natural interface to the C math library. *)
%{^
#include <math.h>
%}
implement (* "Generic" square root. *)
gsqrt_val<double> x =
(* Call "sqrt" from the C math library. *)
$extfcall (double, "sqrt", x)
//--------------------------------------------------------------------
abst@ype quaternion (tk : tkind) =
(* The following determines the SIZE of a quaternion, but not its
actual representation: *)
@(g0float tk, g0float tk, g0float tk, g0float tk)
extern fn {tk : tkind} quaternion_make :
(g0float tk, g0float tk, g0float tk, g0float tk) -<> quaternion tk
extern fn {tk : tkind} fprint_quaternion :
(FILEref, quaternion tk) -> void
extern fn {tk : tkind} print_quaternion :
quaternion tk -> void
extern fn {tk : tkind} quaternion_norm_squared :
quaternion tk -<> g0float tk
extern fn {tk : tkind} quaternion_norm :
quaternion tk -< !exn > g0float tk
extern fn {tk : tkind} quaternion_neg :
quaternion tk -<> quaternion tk
extern fn {tk : tkind} quaternion_conj :
quaternion tk -<> quaternion tk
extern fn {tk : tkind} add_quaternion_g0float :
(quaternion tk, g0float tk) -<> quaternion tk
extern fn {tk : tkind} add_g0float_quaternion :
(g0float tk, quaternion tk) -<> quaternion tk
extern fn {tk : tkind} add_quaternion_quaternion :
(quaternion tk, quaternion tk) -<> quaternion tk
extern fn {tk : tkind} mul_quaternion_g0float :
(quaternion tk, g0float tk) -<> quaternion tk
extern fn {tk : tkind} mul_g0float_quaternion :
(g0float tk, quaternion tk) -<> quaternion tk
extern fn {tk : tkind} mul_quaternion_quaternion :
(quaternion tk, quaternion tk) -<> quaternion tk
extern fn {tk : tkind} quaternion_eq :
(quaternion tk, quaternion tk) -<> bool
overload fprint with fprint_quaternion
overload print with print_quaternion
overload norm_squared with quaternion_norm_squared
overload norm with quaternion_norm
overload ~ with quaternion_neg
overload conj with quaternion_conj
overload + with add_quaternion_g0float
overload + with add_g0float_quaternion
overload + with add_quaternion_quaternion
overload * with mul_quaternion_g0float
overload * with mul_g0float_quaternion
overload * with mul_quaternion_quaternion
overload = with quaternion_eq
//--------------------------------------------------------------------
local
(* Now we decide the REPRESENTATION of a quaternion. A quaternion is
represented as an unboxed 4-tuple of "real" numbers of any one
particular typekind. *)
typedef _quaternion (tk : tkind) =
@(g0float tk, g0float tk, g0float tk, g0float tk)
assume quaternion tk = _quaternion tk
in (* local *)
implement {tk}
quaternion_make (a, b, c, d) =
@(a, b, c, d)
implement {tk}
fprint_quaternion (outf, q) =
let
typedef t = g0float tk
val @(a, b, c, d) = q
in
fprint_val<t> (outf, a);
if g0i2f 0 <= b then fprint_val<string> (outf, "+");
fprint_val<t> (outf, b);
fprint_val<string> (outf, "i");
if g0i2f 0 <= c then fprint_val<string> (outf, "+");
fprint_val<t> (outf, c);
fprint_val<string> (outf, "j");
if g0i2f 0 <= d then fprint_val<string> (outf, "+");
fprint_val<t> (outf, d);
fprint_val<string> (outf, "k");
end
implement {tk}
print_quaternion q =
fprint_quaternion (stdout_ref, q)
implement {tk}
quaternion_norm_squared q =
let
val @(a, b, c, d) = q
in
(a * a) + (b * b) + (c * c) + (d * d)
end
implement {tk}
quaternion_norm q =
gsqrt_val<g0float tk> (quaternion_norm_squared q)
implement {tk}
quaternion_neg q =
let
val @(a, b, c, d) = q
in
@(~a, ~b, ~c, ~d)
end
implement {tk}
quaternion_conj q =
let
val @(a, b, c, d) = q
in
@(a, ~b, ~c, ~d)
end
implement {tk}
add_quaternion_g0float (q, r) =
let
val @(a, b, c, d) = q
in
@(a + r, b, c, d)
end
implement {tk}
add_g0float_quaternion (r, q) =
let
val @(a, b, c, d) = q
in
@(r + a, b, c, d)
end
implement {tk}
add_quaternion_quaternion (q1, q2) =
let
val @(a1, b1, c1, d1) = q1
and @(a2, b2, c2, d2) = q2
in
@(a1 + a2, b1 + b2, c1 + c2, d1 + d2)
end
implement {tk}
mul_quaternion_g0float (q, r) =
let
val @(a, b, c, d) = q
in
@(a * r, b * r, c * r, d * r)
end
implement {tk}
mul_g0float_quaternion (r, q) =
let
val @(a, b, c, d) = q
in
@(r * a, r * b, r * c, r * d)
end
implement {tk}
mul_quaternion_quaternion (q1, q2) =
let
val @(a1, b1, c1, d1) = q1
and @(a2, b2, c2, d2) = q2
in
@((a1 * a2) - (b1 * b2) - (c1 * c2) - (d1 * d2),
(a1 * b2) + (b1 * a2) + (c1 * d2) - (d1 * c2),
(a1 * c2) - (b1 * d2) + (c1 * a2) + (d1 * b2),
(a1 * d2) + (b1 * c2) - (c1 * b2) + (d1 * a2))
end
implement {tk}
quaternion_eq (q1, q2) =
let
val @(a1, b1, c1, d1) = q1
and @(a2, b2, c2, d2) = q2
in
(a1 = a2) * (b1 = b2) * (c1 = c2) * (d1 = d2)
end
end (* local *)
//--------------------------------------------------------------------
val q = quaternion_make (1.0, 2.0, 3.0, 4.0)
and q1 = quaternion_make (2.0, 3.0, 4.0, 5.0)
and q2 = quaternion_make (3.0, 4.0, 5.0, 6.0)
and r = 7.0
implement
main0 () =
let
(* Let us print double precision numbers in a format more readable
than is the prelude's default. *)
implement
fprint_val<double> (outf, x) =
let
typedef f = $extype"FILE *"
val _ = $extfcall (int, "fprintf", $UNSAFE.cast{f} outf,
"%g", x)
in
end
in
println! ("q = ", q);
println! ("q1 = ", q1);
println! ("q2 = ", q2);
println! ();
println! ("||q|| = ", norm q);
println! ("||q1|| = ", norm q1);
println! ("||q2|| = ", norm q2);
println! ();
println! ("-q = ", ~q);
println! ("-q1 = ", ~q1);
println! ("-q2 = ", ~q2);
println! ();
println! ("conj q = ", conj q);
println! ("conj q1 = ", conj q1);
println! ("conj q2 = ", conj q2);
println! ();
println! ("q + r = ", q + r);
println! ("r + q = ", r + q);
println! ("q1 + q2 = ", q1 + q2);
println! ();
println! ("q * r = ", q * r);
println! ("r * q = ", r * q);
println! ("q1 * q2 = ", q1 * q2);
println! ("q2 * q1 = ", q2 * q1);
println! ("((q1 * q2) = (q2 * q1)) is ", (q1 * q2) = (q2 * q1))
end
//--------------------------------------------------------------------
</syntaxhighlight>
{{out}}
<pre>$ patscc -std=gnu2x -O2 quaternions_task.dats -lm && ./a.out
q = 1+2i+3j+4k
q1 = 2+3i+4j+5k
q2 = 3+4i+5j+6k
||q|| = 5.477226
||q1|| = 7.348469
||q2|| = 9.273618
-q = -1-2i-3j-4k
-q1 = -2-3i-4j-5k
-q2 = -3-4i-5j-6k
conj q = 1-2i-3j-4k
conj q1 = 2-3i-4j-5k
conj q2 = 3-4i-5j-6k
q + r = 8+2i+3j+4k
r + q = 8+2i+3j+4k
q1 + q2 = 5+7i+9j+11k
q * r = 7+14i+21j+28k
r * q = 7+14i+21j+28k
q1 * q2 = -56+16i+24j+26k
q2 * q1 = -56+18i+20j+28k
((q1 * q2) = (q2 * q1)) is false</pre>
=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}} (AutoHotkey1.1+)
<syntaxhighlight lang="autohotkey">q := [1, 2, 3, 4]
q1 := [2, 3, 4, 5]
q2 := [3, 4, 5, 6]
r := 7
MsgBox, % "q = " PrintQ(q)
. "`nq1 = " PrintQ(q1)
. "`nq2 = " PrintQ(q2)
. "`nr = " r
. "`nNorm(q) = " Norm(q)
. "`nNegative(q) = " PrintQ(Negative(q))
. "`nConjugate(q) = " PrintQ(Conjugate(q))
. "`nq + r = " PrintQ(AddR(q, r))
. "`nq1 + q2 = " PrintQ(AddQ(q1, q2))
. "`nq2 + q1 = " PrintQ(AddQ(q2, q1))
. "`nqr = " PrintQ(MulR(q, r))
. "`nq1q2 = " PrintQ(MulQ(q1, q2))
. "`nq2q1 = " PrintQ(MulQ(q2, q1))
Norm(q) {
return sqrt(q[1]**2 + q[2]**2 + q[3]**2 + q[4]**2)
}
Negative(q) {
a := []
for k, v in q
a[A_Index] := v * -1
return a
}
Conjugate(q) {
a := []
for k, v in q
a[A_Index] := v * (A_Index = 1 ? 1 : -1)
return a
}
AddR(q, r) {
a := []
for k, v in q
a[A_Index] := v + (A_Index = 1 ? r : 0)
return a
}
AddQ(q1, q2) {
a := []
for k, v in q1
a[A_Index] := v + q2[A_Index]
return a
}
MulR(q, r) {
a := []
for k, v in q
a[A_Index] := v * r
return a
}
MulQ(q, u) {
a := []
, a[1] := q[1]*u[1] - q[2]*u[2] - q[3]*u[3] - q[4]*u[4]
, a[2] := q[1]*u[2] + q[2]*u[1] + q[3]*u[4] - q[4]*u[3]
, a[3] := q[1]*u[3] - q[2]*u[4] + q[3]*u[1] + q[4]*u[2]
, a[4] := q[1]*u[4] + q[2]*u[3] - q[3]*u[2] + q[4]*u[1]
return a
}
PrintQ(q, b="(") {
for k, v in q
b .= v (A_Index = q.MaxIndex() ? ")" : ", ")
return b
}</syntaxhighlight>
{{out}}
<pre>q = (1, 2, 3, 4)
q1 = (2, 3, 4, 5)
q2 = (3, 4, 5, 6)
r = 7
Norm(q) = 5.477226
Negative(q) = (-1, -2, -3, -4)
Conjugate(q) = (1, -2, -3, -4)
q + r = (8, 2, 3, 4)
q1 + q2 = (5, 7, 9, 11)
q2 + q1 = (5, 7, 9, 11)
qr = (7, 14, 21, 28)
q1q2 = (-56, 16, 24, 26)
q2q1 = (-56, 18, 20, 28)</pre>
=={{header|Axiom}}==
Axiom has built-in support for quaternions.
<syntaxhighlight lang="axiom">qi := quatern$Quaternion(Integer);
Type: ((Integer,Integer,Integer,Integer) -> Quaternion(Integer))
q := qi(1,2,3,4);
Type: Quaternion(Integer)
q1 := qi(2,3,4,5);
Type: Quaternion(Integer)
q2 := qi(3,4,5,6);
Type: Quaternion(Integer)
r : Integer := 7;
Type: Integer
sqrt norm q
+--+
(6) \|30
Type: AlgebraicNumber
-q
(7) - 1 - 2i - 3j - 4k
Type: Quaternion(Integer)
conjugate q
(8) 1 - 2i - 3j - 4k
Type: Quaternion(Integer)
r + q
(9) 8 + 2i + 3j + 4k
Type: Quaternion(Integer)
q1 + q2
(10) 5 + 7i + 9j + 11k
Type: Quaternion(Integer)
q*r
(11) 7 + 14i + 21j + 28k
Type: Quaternion(Integer)
r*q
(12) 7 + 14i + 21j + 28k
Type: Quaternion(Integer)
q1*q2 ~= q2*q1
(13) true
Type: Boolean</syntaxhighlight>
=={{header|BASIC}}==
==={{header|BASIC256}}===
{{works with|BASIC256|2.0.0.11}}
<syntaxhighlight lang="basic256">
dim q(4)
dim q1(4)
dim q2(4)
q[0] = 1: q[1] = 2: q[2] = 3: q[3] = 4
q1[0] = 2: q1[1] = 3: q1[2] = 4: q1[3] = 5
q2[0] = 3: q2[1] = 4: q2[2] = 5: q2[3] = 6
r = 7
function printq(q)
return "("+q[0]+", "+q[1]+", "+q[2]+", "+q[3]+")"
end function
function q_equal(q1, q2)
return q1[0]=q2[0] and q1[1]=q2[1] and q1[2]=q2[2] and q1[3]=q2[3]
end function
function q_norm(q)
return sqr(q[0]*q[0]+q[1]*q[1]+q[2]*q[2]+q[3]*q[3])
end function
function q_neg(q)
dim result[4]
result[0] = -q[0]
result[1] = -q[1]
result[2] = -q[2]
result[3] = -q[3]
return result
end function
function q_conj(q)
dim result[4]
result[0] = q[0]
result[1] = -q[1]
result[2] = -q[2]
result[3] = -q[3]
return result
end function
function q_addreal(q, r)
dim result[4]
result[0] = q[0]+r
result[1] = q[1]
result[2] = q[2]
result[3] = q[3]
return result
end function
function q_add(q1, q2)
dim result[4]
result[0] = q1[0]+q2[0]
result[1] = q1[1]+q2[1]
result[2] = q1[2]+q2[2]
result[3] = q1[3]+q2[3]
return result
end function
function q_mulreal(q, r)
dim result[4]
result[0] = q[0]*r
result[1] = q[1]*r
result[2] = q[2]*r
result[3] = q[3]*r
return result
end function
function q_mul(q1, q2)
dim result[4]
result[0] = q1[0]*q2[0]-q1[1]*q2[1]-q1[2]*q2[2]-q1[3]*q2[3]
result[1] = q1[0]*q2[1]+q1[1]*q2[0]+q1[2]*q2[3]-q1[3]*q2[2]
result[2] = q1[0]*q2[2]-q1[1]*q2[3]+q1[2]*q2[0]+q1[3]*q2[1]
result[3] = q1[0]*q2[3]+q1[1]*q2[2]-q1[2]*q2[1]+q1[3]*q2[0]
return result
end function
print "q = ";printq(q)
print "q1 = ";printq(q1)
print "q2 = ";printq(q2)
print "r = "; r
print "norm(q) = "; q_norm(q)
print "neg(q) = ";printq(q_neg(q))
print "conjugate(q) = ";printq(q_conj(q))
print "q+r = ";printq(q_addreal(q,r))
print "q1+q2 = ";printq(q_add(q1,q2))
print "qr = ";printq(q_mulreal(q,r))
print "q1q2 = ";printq(q_mul(q1,q2))
print "q2q1 = ";printq(q_mul(q2,q1))
</syntaxhighlight>
{{out}}
<pre>
q = (1, 2, 3, 4)
q1 = (2, 3, 4, 5)
q2 = (3, 4, 5, 6)
r = 7
norm(q) = 5.47722557505
neg(q) = (-1, -2, -3, -4)
conjugate(q) = (1, -2, -3, -4)
q+r = (8, 2, 3, 4)
q1+q2 = (5, 7, 9, 11)
qr = (7, 14, 21, 28)
q1q2 = (-56, 16, 24, 26)
q2q1 = (-56, 18, 20, 28)
</pre>
==={{header|BBC BASIC}}===
Although BBC BASIC doesn't have native support for quaternions its array arithmetic provides all of the required operations either directly or very straightforwardly.
<
q() = 1, 2, 3, 4
q1() = 2, 3, 4, 5
Line 456 ⟶ 1,484:
DEF FNq_show(q()) : LOCAL i%, a$ : a$ = "("
FOR i% = 0 TO 3 : a$ += STR$(q(i%)) + ", " : NEXT
= LEFT$(LEFT$(a$)) + ")"</
{{out}}
<pre>
q = (1, 2, 3, 4)
Line 475 ⟶ 1,503:
=={{header|C}}==
<
#include <stdlib.h>
#include <stdbool.h>
Line 605 ⟶ 1,633:
printf("(%lf, %lf, %lf, %lf)\n",
q->q[0], q->q[1], q->q[2], q->q[3]);
}</
<
{
size_t i;
Line 664 ⟶ 1,692:
free(q[0]); free(q[1]); free(q[2]); free(r);
return EXIT_SUCCESS;
}</
=={{header|C sharp}}==
<syntaxhighlight lang="csharp">using System;
struct Quaternion : IEquatable<Quaternion>
{
public readonly double A, B, C, D;
public Quaternion(double a, double b, double c, double d)
{
this.A = a;
this.B = b;
this.C = c;
this.D = d;
}
public double Norm()
{
return Math.Sqrt(A * A + B * B + C * C + D * D);
}
public static Quaternion operator -(Quaternion q)
{
return new Quaternion(-q.A, -q.B, -q.C, -q.D);
}
public Quaternion Conjugate()
{
return new Quaternion(A, -B, -C, -D);
}
// implicit conversion takes care of real*quaternion and real+quaternion
public static implicit operator Quaternion(double d)
{
return new Quaternion(d, 0, 0, 0);
}
public static Quaternion operator +(Quaternion q1, Quaternion q2)
{
return new Quaternion(q1.A + q2.A, q1.B + q2.B, q1.C + q2.C, q1.D + q2.D);
}
public static Quaternion operator *(Quaternion q1, Quaternion q2)
{
return new Quaternion(
q1.A * q2.A - q1.B * q2.B - q1.C * q2.C - q1.D * q2.D,
q1.A * q2.B + q1.B * q2.A + q1.C * q2.D - q1.D * q2.C,
q1.A * q2.C - q1.B * q2.D + q1.C * q2.A + q1.D * q2.B,
q1.A * q2.D + q1.B * q2.C - q1.C * q2.B + q1.D * q2.A);
}
public static bool operator ==(Quaternion q1, Quaternion q2)
{
return q1.A == q2.A && q1.B == q2.B && q1.C == q2.C && q1.D == q2.D;
}
public static bool operator !=(Quaternion q1, Quaternion q2)
{
return !(q1 == q2);
}
#region Object Members
public override bool Equals(object obj)
{
if (obj is Quaternion)
return Equals((Quaternion)obj);
return false;
}
public override int GetHashCode()
{
return A.GetHashCode() ^ B.GetHashCode() ^ C.GetHashCode() ^ D.GetHashCode();
}
public override string ToString()
{
return string.Format("Q({0}, {1}, {2}, {3})", A, B, C, D);
}
#endregion
#region IEquatable<Quaternion> Members
public bool Equals(Quaternion other)
{
return other == this;
}
#endregion
}</syntaxhighlight>
Demonstration:
<syntaxhighlight lang="csharp">using System;
static class Program
{
static void Main(string[] args)
{
Quaternion q = new Quaternion(1, 2, 3, 4);
Quaternion q1 = new Quaternion(2, 3, 4, 5);
Quaternion q2 = new Quaternion(3, 4, 5, 6);
double r = 7;
Console.WriteLine("q = {0}", q);
Console.WriteLine("q1 = {0}", q1);
Console.WriteLine("q2 = {0}", q2);
Console.WriteLine("r = {0}", r);
Console.WriteLine("q.Norm() = {0}", q.Norm());
Console.WriteLine("q1.Norm() = {0}", q1.Norm());
Console.WriteLine("q2.Norm() = {0}", q2.Norm());
Console.WriteLine("-q = {0}", -q);
Console.WriteLine("q.Conjugate() = {0}", q.Conjugate());
Console.WriteLine("q + r = {0}", q + r);
Console.WriteLine("q1 + q2 = {0}", q1 + q2);
Console.WriteLine("q2 + q1 = {0}", q2 + q1);
Console.WriteLine("q * r = {0}", q * r);
Console.WriteLine("q1 * q2 = {0}", q1 * q2);
Console.WriteLine("q2 * q1 = {0}", q2 * q1);
Console.WriteLine("q1*q2 {0} q2*q1", (q1 * q2) == (q2 * q1) ? "==" : "!=");
}
}</syntaxhighlight>
{{out}}
<pre>q = Q(1, 2, 3, 4)
q1 = Q(2, 3, 4, 5)
q2 = Q(3, 4, 5, 6)
r = 7
q.Norm() = 5.47722557505166
q1.Norm() = 7.34846922834953
q2.Norm() = 9.2736184954957
-q = Q(-1, -2, -3, -4)
q.Conjugate() = Q(1, -2, -3, -4)
q + r = Q(8, 2, 3, 4)
q1 + q2 = Q(5, 7, 9, 11)
q2 + q1 = Q(5, 7, 9, 11)
q * r = Q(7, 14, 21, 28)
q1 * q2 = Q(-56, 16, 24, 26)
q2 * q1 = Q(-56, 18, 20, 28)
q1*q2 != q2*q1</pre>
=={{header|C++}}==
Line 670 ⟶ 1,844:
This example uses templates to provide the underlying data-type, and includes several extra functions and constructors that often come up when using quaternions.
<
using namespace std;
Line 785 ⟶ 1,959:
(q.z < T()) ? (io << " - " << (-q.z) << "k") : (io << " + " << q.z << "k");
return io;
}</
Test program:
<
{
Quaternion<> q0(1, 2, 3, 4);
Line 827 ⟶ 2,001:
Quaternion<int> q5(2), q6(3);
cout << endl << q5*q6 << endl;
}</
{{out}}
<pre>
q0: 1 + 2i + 3j + 4k
Line 863 ⟶ 2,037:
</pre>
=={{header|
<syntaxhighlight lang="clu">quat = cluster is make, minus, norm, conj, add, addr, mul, mulr,
equal, get_a, get_b, get_c, get_d, q_form
rep = struct[a,b,c,d: real]
make = proc (a,b,c,d: real) returns (cvt)
return (rep${a:a, b:b, c:c, d:d})
end make
minus = proc (q: cvt) returns (cvt)
return (down(make(-q.a, -q.b, -q.c, -q.d)))
end minus
norm = proc (q: cvt) returns (real)
return ((q.a**2.0 + q.b**2.0 + q.c**2.0 + q.d**2.0) ** 0.5)
end norm
conj = proc (q: cvt) returns (cvt)
return (down(make(q.a, -q.b, -q.c, q.d)))
end conj
add = proc (q1, q2: cvt) returns (cvt)
return (down(make(q1.a+q2.a, q1.b+q2.b, q1.c+q2.c, q1.d+q2.d)))
end add
addr = proc (q: cvt, r: real) returns (cvt)
return (down(make(q.a+r, q.b+r, q.c+r, q.d+r)))
end addr
mul = proc (q1, q2: cvt) returns (cvt)
a: real := q1.a*q2.a - q1.b*q2.b - q1.c*q2.c - q1.d*q2.d
b: real := q1.a*q2.b + q1.b*q2.a + q1.c*q2.d - q1.d*q2.c
c: real := q1.a*q2.c - q1.b*q2.d + q1.c*q2.a + q1.d*q2.b
d: real := q1.a*q2.d + q1.b*q2.c - q1.c*q2.b + q1.d*q2.a
return (down(make(a,b,c,d)))
end mul
mulr = proc (q: cvt, r: real) returns (cvt)
return (down(make(q.a*r, q.b*r, q.c*r, q.d*r)))
end mulr
equal = proc (q1, q2: cvt) returns (bool)
return (q1.a = q2.a & q1.b = q2.b & q1.c = q2.c & q1.d = q2.d)
end equal
get_a = proc (q: cvt) returns (real) return (q.a) end get_a
get_b = proc (q: cvt) returns (real) return (q.b) end get_b
get_c = proc (q: cvt) returns (real) return (q.c) end get_c
get_d = proc (q: cvt) returns (real) return (q.d) end get_d
q_form = proc (q: cvt, a, b: int) returns (string)
return ( f_form(q.a, a, b) || " + "
|| f_form(q.b, a, b) || "i + "
|| f_form(q.c, a, b) || "j + "
|| f_form(q.d, a, b) || "k" )
end q_form
end quat
start_up = proc ()
po: stream := stream$primary_output()
q0: quat := quat$make(1.0, 2.0, 3.0, 4.0)
q1: quat := quat$make(2.0, 3.0, 4.0, 5.0)
q2: quat := quat$make(3.0, 4.0, 5.0, 6.0)
r: real := 7.0
stream$putl(po, " q0 = " || quat$q_form(q0, 3, 3))
stream$putl(po, " q1 = " || quat$q_form(q1, 3, 3))
stream$putl(po, " q2 = " || quat$q_form(q2, 3, 3))
stream$putl(po, " r = " || f_form(r, 3, 3))
stream$putl(po, "")
stream$putl(po, "norm(q0) = " || f_form(quat$norm(q0), 3, 3))
stream$putl(po, " -q0 = " || quat$q_form(-q0, 3, 3))
stream$putl(po, "conj(q0) = " || quat$q_form(quat$conj(q0), 3, 3))
stream$putl(po, " q0 + r = " || quat$q_form(quat$addr(q0, r), 3, 3))
stream$putl(po, " q1 + q2 = " || quat$q_form(q1 + q2, 3, 3))
stream$putl(po, " q0 * r = " || quat$q_form(quat$mulr(q0, r), 3, 3))
stream$putl(po, " q1 * q2 = " || quat$q_form(q1 * q2, 3, 3))
stream$putl(po, " q2 * q1 = " || quat$q_form(q2 * q1, 3, 3))
if q1*q2 ~= q2*q1 then stream$putl(po, "q1 * q2 ~= q2 * q1") end
end start_up</syntaxhighlight>
{{out}}
<pre> q0 = 1.000 + 2.000i + 3.000j + 4.000k
q1 = 2.000 + 3.000i + 4.000j + 5.000k
q2 = 3.000 + 4.000i + 5.000j + 6.000k
r = 7.000
norm(q0) = 5.477
-q0 = -1.000 + -2.000i + -3.000j + -4.000k
conj(q0) = 1.000 + -2.000i + -3.000j + 4.000k
q0 + r = 8.000 +
q1 + q2 = 5.000 + 7.000i +
q0 * r = 7.000 +
q1 * q2 = -56.000 + 16.000i + 24.000j + 26.000k
q2 * q1 = -56.000 + 18.000i + 20.000j + 28.000k
q1 * q2 ~= q2 * q1</pre>
=={{header|Common Lisp}}==
<syntaxhighlight lang="lisp">
(defclass quaternion () ((a :accessor q-a :initarg :a :type real)
(b :accessor q-b :initarg :b :type real)
(c :accessor q-c :initarg :c :type real)
(d :accessor q-d :initarg :d :type real))
(:default-initargs :a 0 :b 0 :c 0 :d 0))
(defun make-q (&optional (a 0) (b 0) (c 0) (d 0))
(make-instance 'quaternion :a a :b b :c c :d d))
(defgeneric sum (x y))
(defmethod sum ((x
(make-q (+ (q-a x) (q-a y))
(+ (q-b x) (q-b y))
(+ (q-d x) (q-d y))))
(defmethod sum ((x quaternion) (y real))
(make-q (+ (q-a x) y) (q-b x) (q-c x) (q-d x)))
(defmethod sum ((x real) (y quaternion))
(make-q (+ (q-a y) x) (q-b y) (q-c y) (q-d y)))
(defgeneric sub (x y))
(defmethod sub ((x quaternion) (y quaternion))
(make-q (- (q-a x) (q-a y))
(- (q-c x) (q-c y))
(- (q-d x) (q-d y))))
(defmethod sub ((x quaternion) (y real))
(make-q (- (q-a x) y)
(q-b x)
(q-c x)
(q-d x)))
(defmethod sub ((x real) (y quaternion))
(make-q (- (q-a y) x)
(q-c
(q-d y)))
(defgeneric mul (x y))
(defmethod mul ((x quaternion) (y real))
(make-q (* (q-a x) y)
(* (q-b x) y)
(* (q-c x) y)
(* (q-d x) y)))
(defmethod mul ((x real) (y quaternion))
(make-q (* (q-a y) x)
(* (q-c y) x)
(* (q-d y) x)))
(defmethod mul ((x quaternion) (y quaternion))
(make-q (- (* (q-a x) (q-a y)) (* (q-b x) (q-b y)) (* (q-c x) (q-c y)) (* (q-d x) (q-d y)))
(- (+ (* (q-a x) (q-b y)) (* (q-b x) (q-a y)) (* (q-c x) (q-d y))) (* (q-d x) (q-c y)))
(- (+ (* (q-a x) (q-c y)) (* (q-c x) (q-a y)) (* (q-d x) (q-b y))) (* (q-b x) (q-d y)))
(- (+ (* (q-a x) (q-d y)) (* (q-b x) (q-c y)) (* (q-d x) (q-a y))) (* (q-c x) (q-b y)))))
(defmethod norm ((x quaternion))
(+ (sqrt (q-a x)) (sqrt (q-b x)) (sqrt (q-c x)) (sqrt (q-d x))))
(defmethod print-object ((x quaternion) stream)
(format stream "~@f~@fi~@fj~@fk" (q-a x) (q-b x) (q-c x) (q-d x)))
(defvar q (make-q 0 1 0 0))
(defvar q1 (make-q 0 0 1 0))
(defvar q2 (make-q 0 0 0 1))
(defvar r 7)
(format t "q+q1+q2 = ~a~&" (reduce #'sum (list q q1 q2)))
(format t "r*(q+q1+q2) = ~a~&" (mul r (reduce #'sum (list q q1 q2))))
(format t "q*q1*q2 = ~a~&" (reduce #'mul (list q q1 q2)))
(format t "q-q1-q2 = ~a~&" (reduce #'sub (list q q1 q2)))
</syntaxhighlight>
{{out}}
<pre>
q+q1+q2 = +0.0+1.0i+1.0j+1.0k
r*(q+q1+q2) = +0.0+7.0i+7.0j+7.0k
q*q1*q2 = -1.0+0.0i+0.0j+0.0k
q-q1-q2 = +0.0+1.0i-1.0j-1.0k
</pre>
=={{header|Crystal}}==
{{trans|Rust and Ruby}}
<syntaxhighlight lang="ruby">class Quaternion
property a, b, c, d
def initialize(@a : Int64, @b : Int64, @c : Int64, @d : Int64) end
def norm; Math.sqrt(a**2 + b**2 + c**2 + d**2) end
def conj; Quaternion.new(a, -b, -c, -d) end
def +(n) Quaternion.new(a + n, b, c, d) end
def -(n) Quaternion.new(a - n, b, c, d) end
def -() Quaternion.new(-a, -b, -c, -d) end
def *(n) Quaternion.new(a * n, b * n, c * n, d * n) end
def ==(rhs : Quaternion) self.to_s == rhs.to_s end
def +(rhs : Quaternion)
Quaternion.new(a + rhs.a, b + rhs.b, c + rhs.c, d + rhs.d)
end
def -(rhs : Quaternion)
Quaternion.new(a - rhs.a, b - rhs.b, c - rhs.c, d - rhs.d)
end
def *(rhs : Quaternion)
Quaternion.new(
a *
a * rhs.b + b * rhs.a + c * rhs.d - d * rhs.c,
a * rhs.c - b * rhs.d + c * rhs.a + d * rhs.b,
a * rhs.d + b * rhs.c - c * rhs.b + d * rhs.a)
end
def to_s(io : IO) io << "(#{a} #{sgn(b)}i #{sgn(c)}j #{sgn(d)}k)\n" end
private def sgn(n) n.sign|1 == 1 ? "+ #{n}" : "- #{n.abs}" end
end
struct Number
def +(rhs : Quaternion)
Quaternion.new(rhs.a + self, rhs.b, rhs.c, rhs.d)
end
def -(rhs : Quaternion)
Quaternion.new(-rhs.a + self, -rhs.b, -rhs.c, -rhs.d)
end
def *(rhs : Quaternion)
Quaternion.new(rhs.a * self, rhs.b * self, rhs.c * self, rhs.d * self)
end
end
puts "q0 = #{q0}"
puts "r = #{r}"
puts
puts "normal of q0 = #{q0.norm}"
puts "-q0 = #{-q0}"
puts "conjugate of q0 = #{q0.conj}"
puts "q0 * (conjugate of q0) = #{q0 * q0.conj}"
puts "(conjugate of q0) * q0 = #{q0.conj * q0}"
puts
puts "r + q0 = #{r + q0}"
puts "q0 + r = #{q0 + r}"
puts
puts " q0 - r = #{q0 - r}"
puts "-q0 - r = #{-q0 - r}"
puts " r - q0 = #{r - q0}"
puts "-q0 + r = #{-q0 + r}"
puts
puts "r * q0 = #{r * q0}"
puts "q0 * r = #{q0 * r}"
puts
puts "q0 + q1 = #{q0 + q1}"
puts "q0 - q1 = #{q2 - q1}"
puts "q0 * q1 = #{q0 * q1}"
puts
puts " q0 + q1 * q2 = #{q0 + q1 * q2}"
puts "(q0 + q1) * q2 = #{(q0 + q1) * q2}"
puts
puts " q0 * q1 * q2 = #{q0 * q1 * q2}"
puts "(q0 * q1) * q2 = #{(q0 * q1) * q2}"
puts " q0 * (q1 * q2) = #{q0 * (q1 * q2)}"
puts
puts "q1 * q2 = #{q1 * q2}"
puts "q2 * q1 = #{q2 * q1}"
puts
puts "q1 * q2 != q2 * q1 => #{(q1 * q2) != (q2 * q1)}"
puts "q1 * q2 == q2 * q1 => #{(q1 * q2) == (q2 * q1)}"</syntaxhighlight>
{{out}}
<pre>q0 = (1 + 2i + 3j + 4k)
q1 = (2 + 3i + 4j + 5k)
q2 = (3 + 4i + 5j + 6k)
r = 7
normal of q0 = 5.477225575051661
-q0 = (-1 - 2i - 3j - 4k)
conjugate of q0 = (1 - 2i - 3j - 4k)
q0 * (conjugate of q0) = (30 + 0i + 0j + 0k)
(conjugate of q0) * q0 = (30 + 0i + 0j + 0k)
r + q0 = (8 + 2i + 3j + 4k)
q0 + r = (8 + 2i + 3j + 4k)
q0 - r = (-6 + 2i + 3j + 4k)
-q0 - r = (-8 - 2i - 3j - 4k)
r - q0 = (6 - 2i - 3j - 4k)
-q0 + r = (6 - 2i - 3j - 4k)
r * q0 = (7 + 14i + 21j + 28k)
q0 * r = (7 + 14i + 21j + 28k)
q0 + q1 = (3 + 5i + 7j + 9k)
q0 - q1 = (1 + 1i + 1j + 1k)
q0 * q1 = (-36 + 6i + 12j + 12k)
q0 + q1 * q2 = (-55 + 18i + 27j + 30k)
(q0 + q1) * q2 = (-100 + 24i + 42j + 42k)
q0 * q1 * q2 = (-264 - 114i - 132j - 198k)
(q0 * q1) * q2 = (-264 - 114i - 132j - 198k)
q0 * (q1 * q2) = (-264 - 114i - 132j - 198k)
q1 * q2 = (-56 + 16i + 24j + 26k)
q2 * q1 = (-56 + 18i + 20j + 28k)
q1 * q2 != q2 * q1 => true
q1 * q2 == q2 * q1 => false</pre>
=={{header|D}}==
<
struct Quat(T) if (isFloatingPoint!T) {
alias CT = Complex!T
union {
struct { T re, i, j, k; } // Default init to NaN.
struct { CT x, y; }
struct { T[4] vector; }
}
string toString() const
return
}
@property T norm2() const pure nothrow @safe @nogc { /// Norm squared.
return re ^^ 2 + i ^^ 2 + j ^^ 2 + k ^^ 2;
}
@property T abs() const pure nothrow @safe @nogc { /// Norm.
return sqrt(norm2);
}
@property T arg() const pure nothrow @safe @nogc { /// Theta.
return acos(re / abs); // this may be incorrect...
}
@property Quat!T conj() const pure nothrow @safe @nogc { /// Conjugate.
return Quat!T(re, -i, -j, -k);
}
@property Quat!T recip() const pure nothrow @safe @nogc { /// Reciprocal.
return Quat!T(re / norm2, -i / norm2, -j / norm2, -k / norm2);
}
@property Quat!T pureim() const pure nothrow @safe @nogc { /// Pure imagery.
return Quat!T(0, i, j, k);
}
@property Quat!T versor() const pure nothrow @safe @nogc { /// Unit versor.
return this / abs;
}
/// Unit versor of imagery part.
@property Quat!T iversor() const pure nothrow @safe @nogc {
return pureim / pureim.abs;
}
/// Assignment.
Quat!T opAssign(U : T)(Quat!U z) pure nothrow @safe @nogc {
x = z.x; y = z.y;
return this;
}
Quat!T opAssign(U : T)(Complex!U c) pure nothrow @safe @nogc {
x = c; y = 0;
return this;
}
Quat!T opAssign(U : T)(U r) pure nothrow
if (isNumeric!U) {
re = r; i = 0; y = 0;
return this;
}
/// Test for equal, not ordered so no opCmp.
bool opEquals(U : T)(Quat!U z) const pure nothrow @safe @nogc {
return re == z.re && i == z.i && j == z.j && k == z.k;
}
bool opEquals(U : T)(Complex!U c) const pure nothrow @safe @nogc {
return re == c.re && i == c.im && j == 0 && k == 0;
}
bool opEquals(U : T)(U r) const pure nothrow
if (isNumeric!U) {
return re == r && i == 0 && j == 0 && k == 0;
}
/// Unary op.
Quat!T opUnary(string op)() const pure nothrow
if (op == "+") {
return this;
}
Quat!T opUnary(string op)() const pure nothrow
if (op == "-") {
return Quat!T(-re, -i, -j, -k);
}
/// Binary op, Quaternion on left of op.
Quat!(CommonType!(T,U)) opBinary(string op, U)(Quat!U z)
const pure nothrow @safe @nogc {
alias typeof(return) C;
Line 1,116 ⟶ 2,467:
}
/// Extend complex to quaternion.
Quat!(CommonType!(T,U)) opBinary(string op, U)(Complex!U c)
const pure nothrow @safe @nogc {
return opBinary!op(typeof(return)(c.re, c.im, 0, 0));
}
/// For scalar.
Quat!(CommonType!(T,U)) opBinary(string op, U)(U r)
const pure nothrow
if (isNumeric!U) {
alias typeof(return) C;
Line 1,140 ⟶ 2,492:
}
/// Power function.
Quat!(CommonType!(T,U)) pow(U)(U r)
const pure nothrow
if (isNumeric!U) {
return (abs^^r) * exp(r * iversor * arg);
}
Line 1,149 ⟶ 2,502:
/// not quaternion.
Quat!(CommonType!(T,U)) opBinaryRight(string op, U)(Complex!U c)
const pure nothrow @safe @nogc {
alias typeof(return) C;
auto w = C(c.re, c.im, 0, 0);
Line 1,156 ⟶ 2,509:
Quat!(CommonType!(T,U)) opBinaryRight(string op, U)(U r)
const pure nothrow
if (isNumeric!U) {
alias typeof(return) C;
Line 1,171 ⟶ 2,525:
HT exp(HT)(HT z) pure nothrow
if (is(HT T == Quat!T)) {
immutable inorm = z.pureim.abs;
return std.math.exp(z.re) * (cos(inorm) + z.iversor * sin(inorm));
}
HT log(HT)(HT z) pure nothrow
if (is(HT T == Quat!T)) {
return std.math.log(z.abs) + z.iversor * acos(z.re / z.abs);
}
void main() @safe { // Demo code.
import std.stdio;
enum real r = 7.0;
immutable QR q = QR(2, 3, 4, 5),
Line 1,219 ⟶ 2,576:
writeln(" exp(log(q)): ", exp(log(q)));
writeln(" log(exp(q)): ", log(exp(q)));
immutable s =
writeln("9.5 let s = log(exp(q)): ", s);
writeln(" exp(s): ", exp(s));
Line 1,225 ⟶ 2,582:
writeln(" exp(log(s)): ", exp(log(s)));
writeln(" log(exp(s)): ", log(exp(s)));
}</
{{out}}
<pre>1. q - norm: 7.34847
Line 1,257 ⟶ 2,614:
exp(log(s)): [2, 0.33427, 0.445694, 0.557117]
log(exp(s)): [2, 0.33427, 0.445694, 0.557117]</pre>
=={{header|Dart}}==
{{trans|Kotlin}}
<syntaxhighlight lang="Dart">
import 'dart:math' as math;
class Quaternion {
final double a, b, c, d;
Quaternion(this.a, this.b, this.c, this.d);
Quaternion operator +(Object other) {
if (other is Quaternion) {
return Quaternion(a + other.a, b + other.b, c + other.c, d + other.d);
} else if (other is double) {
return Quaternion(a + other, b, c, d);
}
throw ArgumentError('Invalid type for addition: ${other.runtimeType}');
}
Quaternion operator *(Object other) {
if (other is Quaternion) {
return Quaternion(
a * other.a - b * other.b - c * other.c - d * other.d,
a * other.b + b * other.a + c * other.d - d * other.c,
a * other.c - b * other.d + c * other.a + d * other.b,
a * other.d + b * other.c - c * other.b + d * other.a,
);
} else if (other is double) {
return Quaternion(a * other, b * other, c * other, d * other);
}
throw ArgumentError('Invalid type for multiplication: ${other.runtimeType}');
}
Quaternion operator -() => Quaternion(-a, -b, -c, -d);
Quaternion conj() => Quaternion(a, -b, -c, -d);
double norm() => math.sqrt(a * a + b * b + c * c + d * d);
@override
String toString() => '($a, $b, $c, $d)';
}
void main() {
var q = Quaternion(1.0, 2.0, 3.0, 4.0);
var q1 = Quaternion(2.0, 3.0, 4.0, 5.0);
var q2 = Quaternion(3.0, 4.0, 5.0, 6.0);
var r = 7.0;
print("q = $q");
print("q1 = $q1");
print("q2 = $q2");
print("r = $r\n");
print("norm(q) = ${q.norm().toStringAsFixed(6)}");
print("-q = ${-q}");
print("conj(q) = ${q.conj()}\n");
print("r + q = ${q + r}");
print("q + r = ${q + r}");
print("q1 + q2 = ${q1 + q2}\n");
print("r * q = ${q * r}");
print("q * r = ${q * r}");
var q3 = q1 * q2;
var q4 = q2 * q1;
print("q1 * q2 = $q3");
print("q2 * q1 = $q4\n");
print("q1 * q2 != q2 * q1 = ${q3 != q4}");
}
</syntaxhighlight>
{{out}}
<pre>
q = (1.0, 2.0, 3.0, 4.0)
q1 = (2.0, 3.0, 4.0, 5.0)
q2 = (3.0, 4.0, 5.0, 6.0)
r = 7.0
norm(q) = 5.477226
-q = (-1.0, -2.0, -3.0, -4.0)
conj(q) = (1.0, -2.0, -3.0, -4.0)
r + q = (8.0, 2.0, 3.0, 4.0)
q + r = (8.0, 2.0, 3.0, 4.0)
q1 + q2 = (5.0, 7.0, 9.0, 11.0)
r * q = (7.0, 14.0, 21.0, 28.0)
q * r = (7.0, 14.0, 21.0, 28.0)
q1 * q2 = (-56.0, 16.0, 24.0, 26.0)
q2 * q1 = (-56.0, 18.0, 20.0, 28.0)
q1 * q2 != q2 * q1 = true
</pre>
=={{header|Delphi}}==
<
interface
Line 1,388 ⟶ 2,838:
end;
end.</
Test program
<
{$APPTYPE CONSOLE}
Line 1,422 ⟶ 2,872:
writeln('q1 * q2 = ', (q1 * q2).ToString);
writeln('q2 * q1 = ', (q2 * q1).ToString);
end.</
{{out}}
<pre>
q = 1.00 + 2.00i + 3.00j + 4.00k
Line 1,447 ⟶ 2,897:
=={{header|E}}==
<
def makeQuaternion(a, b, c, d) {
return def quaternion implements QS {
Line 1,507 ⟶ 2,957:
to d() { return d }
}
}</
<
# value: (2 + 3i + 4j + 5k)
Line 1,525 ⟶ 2,975:
? q1+(-2)
# value: (0 + 3i + 4j + 5k)</
=={{header|EasyLang}}==
<syntaxhighlight>
func qnorm q[] .
for i to 4
s += q[i] * q[i]
.
return sqrt s
.
func[] qneg q[] .
for i to 4
q[i] = -q[i]
.
return q[]
.
func[] qconj q[] .
for i = 2 to 4
q[i] = -q[i]
.
return q[]
.
func[] qaddreal q[] r .
q[1] += r
return q[]
.
func[] qadd q[] q2[] .
for i to 4
q[i] += q2[i]
.
return q[]
.
func[] qmulreal q[] r .
for i to 4
q[i] *= r
.
return q[]
.
func[] qmul q1[] q2[] .
res[] &= q1[1] * q2[1] - q1[2] * q2[2] - q1[3] * q2[3] - q1[4] * q2[4]
res[] &= q1[1] * q2[2] + q1[2] * q2[1] + q1[3] * q2[4] - q1[4] * q2[3]
res[] &= q1[1] * q2[3] - q1[2] * q2[4] + q1[3] * q2[1] + q1[4] * q2[2]
res[] &= q1[1] * q2[4] + q1[2] * q2[3] - q1[3] * q2[2] + q1[4] * q2[1]
return res[]
.
q[] = [ 1 2 3 4 ]
q1[] = [ 2 3 4 5 ]
q2[] = [ 3 4 5 6 ]
r = 7
#
print "q = " & q[]
print "q1 = " & q1[]
print "q2 = " & q2[]
print "r = " & r
print "norm(q) = " & qnorm q[]
print "neg(q) = " & qneg q[]
print "conjugate(q) = " & qconj q[]
print "q+r = " & qaddreal q[] r
print "q1+q2 = " & qadd q1[] q2[]
print "qr = " & qmulreal q[] r
print "q1q2 = " & qmul q1[] q2[]
print "q2q1 = " & qmul q2[] q1[]
if q1[] <> q2[]
print "q1 != q2"
.
</syntaxhighlight>
{{out}}
<pre>
q = [ 1 2 3 4 ]
q1 = [ 2 3 4 5 ]
q2 = [ 3 4 5 6 ]
r = 7
norm(q) = 5.48
neg(q) = [ -1 -2 -3 -4 ]
conjugate(q) = [ 1 -2 -3 -4 ]
q+r = [ 8 2 3 4 ]
q1+q2 = [ 5 7 9 11 ]
qr = [ 7 14 21 28 ]
q1q2 = [ -56 16 24 26 ]
q2q1 = [ -56 18 20 28 ]
q1 != q2
</pre>
=={{header|Eero}}==
<syntaxhighlight lang="objc">#import <Foundation/Foundation.h>
interface Quaternion : Number
// Properties -- note that this is an immutable class.
double real, i, j, k {readonly}
end
implementation Quaternion
initWithReal: double, i: double, j: double, k: double, return instancetype
self = super.init
if self
_real = real; _i = i; _j = j; _k = k
return self
+new: double real, ..., return instancetype
va_list args
va_start(args, real)
object := Quaternion.alloc.initWithReal: real,
i: va_arg(args, double),
j: va_arg(args, double),
k: va_arg(args, double)
va_end(args)
return object
descriptionWithLocale: id, return String = String.stringWithFormat:
'(%.1f, %.1f, %.1f, %.1f)', self.real, self.i, self.j, self.k
norm, return double =
sqrt(self.real * self.real +
self.i * self.i + self.j * self.j + self.k * self.k)
negative, return Quaternion =
Quaternion.new: -self.real, -self.i, -self.j, -self.k
conjugate, return Quaternion =
Quaternion.new: self.real, -self.i, -self.j, -self.k
// Overload "+" operator (left operand is Quaternion)
plus: Number operand, return Quaternion
real := self.real, i = self.i, j = self.j, k = self.k
if operand.isKindOfClass: Quaternion.class
q := (Quaternion)operand
real += q.real; i += q.i; j += q.j; k += q.k
else
real += (double)operand
return Quaternion.new: real, i, j, k
// Overload "*" operator (left operand is Quaternion)
multipliedBy: Number operand, return Quaternion
real := self.real, i = self.i, j = self.j, k = self.k
if operand.isKindOfClass: Quaternion.class
q := (Quaternion)operand
real = self.real * q.real - self.i* q.i - self.j * q.j - self.k * q.k
i = self.real * q.i + self.i * q.real + self.j * q.k - self.k * q.j
j = self.real * q.j - self.i * q.k + self.j * q.real + self.k * q.i
k = self.real * q.k + self.i * q.j - self.j * q.i + self.k * q.real
else
real *= (double)operand
i *= (double)operand; j *= (double)operand; k *= (double)operand
return Quaternion.new: real, i, j, k
end
implementation Number (QuaternionOperators)
// Overload "+" operator (left operand is Number)
plus: Quaternion operand, return Quaternion
real := (double)self + operand.real
return Quaternion.new: real, operand.i, operand.j, operand.k
// Overload "*" operator (left operand is Number)
multipliedBy: Quaternion operand, return Quaternion
r := (double)self
return Quaternion.new: r * operand.real, r * operand.i,
r * operand.j, r * operand.k
end
int main()
autoreleasepool
q := Quaternion.new: 1.0, 2.0, 3.0, 4.0
q1 := Quaternion.new: 2.0, 3.0, 4.0, 5.0
q2 := Quaternion.new: 3.0, 4.0, 5.0, 6.0
Log( 'q = %@', q )
Log( 'q1 = %@', q1 )
Log( 'q2 = %@\n\n', q2 )
Log( 'q norm = %.3f', q.norm )
Log( 'q negative = %@', q.negative )
Log( 'q conjugate = %@', q.conjugate )
Log( '7 + q = %@', 7.0 + q )
Log( 'q + 7 = %@', q + 7.0 )
Log( 'q1 + q2 = %@', q1 + q2 )
Log( '7 * q = %@', 7 * q)
Log( 'q * 7 = %@', q * 7.0 )
Log( 'q1 * q2 = %@', q1 * q2 )
Log( 'q2 * q1 = %@', q2 * q1 )
return 0</syntaxhighlight>
{{out}}
<pre>
2013-09-04 16:40:29.818 a.out[2170:507] q = (1.0, 2.0, 3.0, 4.0)
2013-09-04 16:40:29.819 a.out[2170:507] q1 = (2.0, 3.0, 4.0, 5.0)
2013-09-04 16:40:29.820 a.out[2170:507] q2 = (3.0, 4.0, 5.0, 6.0)
2013-09-04 16:40:29.820 a.out[2170:507] q norm = 5.477
2013-09-04 16:40:29.820 a.out[2170:507] q negative = (-1.0, -2.0, -3.0, -4.0)
2013-09-04 16:40:29.820 a.out[2170:507] q conjugate = (1.0, -2.0, -3.0, -4.0)
2013-09-04 16:40:29.821 a.out[2170:507] 7 + q = (8.0, 2.0, 3.0, 4.0)
2013-09-04 16:40:29.821 a.out[2170:507] q + 7 = (8.0, 2.0, 3.0, 4.0)
2013-09-04 16:40:29.821 a.out[2170:507] q1 + q2 = (5.0, 7.0, 9.0, 11.0)
2013-09-04 16:40:29.821 a.out[2170:507] 7 * q = (7.0, 14.0, 21.0, 28.0)
2013-09-04 16:40:29.821 a.out[2170:507] q * 7 = (7.0, 14.0, 21.0, 28.0)
2013-09-04 16:40:29.822 a.out[2170:507] q1 * q2 = (-56.0, 16.0, 24.0, 26.0)
2013-09-04 16:40:29.822 a.out[2170:507] q2 * q1 = (-56.0, 18.0, 20.0, 28.0)</pre>
=={{header|Elena}}==
{{trans|C#}}
ELENA 6.x :
<syntaxhighlight lang="elena">import system'math;
import extensions;
import extensions'text;
struct Quaternion
{
real A : rprop;
real B : rprop;
real C : rprop;
real D : rprop;
constructor new(a, b, c, d)
<= new(cast real(a), cast real(b), cast real(c), cast real(d));
constructor new(real a, real b, real c, real d)
{
A := a;
B := b;
C := c;
D := d
}
constructor(real r)
{
A := r;
B := 0.0r;
C := 0.0r;
D := 0.0r
}
real Norm = (A*A + B*B + C*C + D*D).sqrt();
Quaternion Negative = Quaternion.new(A.Negative,B.Negative,C.Negative,D.Negative);
Quaternion Conjugate = Quaternion.new(A,B.Negative,C.Negative,D.Negative);
Quaternion add(Quaternion q)
= Quaternion.new(A + q.A, B + q.B, C + q.C, D + q.D);
Quaternion multiply(Quaternion q)
= Quaternion.new(
A * q.A - B * q.B - C * q.C - D * q.D,
A * q.B + B * q.A + C * q.D - D * q.C,
A * q.C - B * q.D + C * q.A + D * q.B,
A * q.D + B * q.C - C * q.B + D * q.A);
Quaternion add(real r)
<= add(Quaternion.new(r,0,0,0));
Quaternion multiply(real r)
<= multiply(Quaternion.new(r,0,0,0));
bool equal(Quaternion q)
= (A == q.A) && (B == q.B) && (C == q.C) && (D == q.D);
string toPrintable()
= new StringWriter().printFormatted("Q({0}, {1}, {2}, {3})",A,B,C,D);
}
public program()
{
auto q := Quaternion.new(1,2,3,4);
auto q1 := Quaternion.new(2,3,4,5);
auto q2 := Quaternion.new(3,4,5,6);
real r := 7;
console.printLine("q = ", q);
console.printLine("q1 = ", q1);
console.printLine("q2 = ", q2);
console.printLine("r = ", r);
console.printLine("q.Norm() = ", q.Norm);
console.printLine("q1.Norm() = ", q1.Norm);
console.printLine("q2.Norm() = ", q2.Norm);
console.printLine("-q = ", q.Negative);
console.printLine("q.Conjugate() = ", q.Conjugate);
console.printLine("q + r = ", q + r);
console.printLine("q1 + q2 = ", q1 + q2);
console.printLine("q2 + q1 = ", q2 + q1);
console.printLine("q * r = ", q * r);
console.printLine("q1 * q2 = ", q1 * q2);
console.printLine("q2 * q1 = ", q2 * q1);
console.printLineFormatted("q1*q2 {0} q2*q1", ((q1 * q2) == (q2 * q1)).iif("==","!="))
}</syntaxhighlight>
{{out}}
<pre>
q = Q(1.0, 2.0, 3.0, 4.0)
q1 = Q(2.0, 3.0, 4.0, 5.0)
q2 = Q(3.0, 4.0, 5.0, 6.0)
r = 7.0
q.Norm() = 5.477225575052
q1.Norm() = 7.34846922835
q2.Norm() = 9.273618495496
-q = Q(-1.0, -2.0, -3.0, -4.0)
q.Conjugate() = Q(1.0, -2.0, -3.0, -4.0)
q + r = Q(8.0, 2.0, 3.0, 4.0)
q1 + q2 = Q(5.0, 7.0, 9.0, 11.0)
q2 + q1 = Q(5.0, 7.0, 9.0, 11.0)
q * r = Q(7.0, 14.0, 21.0, 28.0)
q1 * q2 = Q(-56.0, 16.0, 24.0, 26.0)
q2 * q1 = Q(-56.0, 18.0, 20.0, 28.0)
q1*q2 != q2*q1
</pre>
=={{header|ERRE}}==
<syntaxhighlight lang="erre">
PROGRAM QUATERNION
!$DOUBLE
TYPE QUATERNION=(A,B,C,D)
DIM Q:QUATERNION,Q1:QUATERNION,Q2:QUATERNION
DIM R:QUATERNION,S:QUATERNION,T:QUATERNION
PROCEDURE NORM(T.->NORM)
NORM=SQR(T.A*T.A+T.B*T.B+T.C*T.C+T.D*T.D)
END PROCEDURE
PROCEDURE NEGATIVE(T.->T.)
T.A=-T.A
T.B=-T.B
T.C=-T.C
T.D=-T.D
END PROCEDURE
PROCEDURE CONJUGATE(T.->T.)
T.A=T.A
T.B=-T.B
T.C=-T.C
T.D=-T.D
END PROCEDURE
PROCEDURE ADD_REAL(T.,REAL->T.)
T.A=T.A+REAL
T.B=T.B
T.C=T.C
T.D=T.D
END PROCEDURE
PROCEDURE ADD(T.,S.->T.)
T.A=T.A+S.A
T.B=T.B+S.B
T.C=T.C+S.C
T.D=T.D+S.D
END PROCEDURE
PROCEDURE MULT_REAL(T.,REAL->T.)
T.A=T.A*REAL
T.B=T.B*REAL
T.C=T.C*REAL
T.D=T.D*REAL
END PROCEDURE
PROCEDURE MULT(T.,S.->R.)
R.A=T.A*S.A-T.B*S.B-T.C*S.C-T.D*S.D
R.B=T.A*S.B+T.B*S.A+T.C*S.D-T.D*S.C
R.C=T.A*S.C-T.B*S.D+T.C*S.A+T.D*S.B
R.D=T.A*S.D+T.B*S.C-T.C*S.B+T.D*S.A
END PROCEDURE
PROCEDURE PRINTQ(T.)
PRINT("(";T.A;",";T.B;",";T.C;",";T.D;")")
END PROCEDURE
BEGIN
Q.A=1 Q.B=2 Q.C=3 Q.D=4
Q1.A=2 Q1.B=3 Q1.C=4 Q1.D=5
Q2.A=3 Q2.B=4 Q2.C=5 Q2.D=6
REAL=7
NORM(Q.->NORM)
PRINT("Norm(q)=";NORM)
NEGATIVE(Q.->T.)
PRINT("Negative(q) =";)
PRINTQ(T.)
CONJUGATE(Q.->T.)
PRINT("Conjugate(q) =";)
PRINTQ(T.)
ADD_REAL(Q.,REAL->T.)
PRINT("q + real =";)
PRINTQ(T.)
! addition is commutative
ADD(Q1.,Q2.->T.)
PRINT("q1 + q2 =";)
PRINTQ(T.)
ADD(Q2.,Q1.->T.)
PRINT("q2 + q1 = ";)
PRINTQ(T.)
MULT_REAL(Q.,REAL->T.)
PRINT("q * real =";)
PRINTQ(T.)
! multiplication is not commutative
MULT(Q1.,Q2.->R.)
PRINT("q1 * q2=";)
PRINTQ(R.)
MULT(Q2.,Q1.->R.)
PRINT("q2 * q1=";)
PRINTQ(R.)
END PROGRAM
</syntaxhighlight>
=={{header|Euphoria}}==
<
return sqrt(power(q[1],2)+power(q[2],2)+power(q[3],2)+power(q[4],2))
end function
Line 1,575 ⟶ 3,447:
printf(1, "q1 + q2 = %s\n", {quats(add(q1,q2))})
printf(1, "q1 * q2 = %s\n", {quats(mul(q1,q2))})
printf(1, "q2 * q1 = %s\n", {quats(mul(q2,q1))})</
{{out}}
<pre>norm(q) = 5.47723
-q = -1 + -2i + -3j + -4k
Line 1,585 ⟶ 3,457:
q1 * q2 = -76 + 24i + 40j + 38k
q2 * q1 = -76 + 30i + 28j + 44k</pre>
=={{header|F_Sharp|F#}}==
Mainly a {{trans|C#}} On the minus side we have no way to define a conversion to Quaternion from any suitable (numeric) type.
On the plus side we can avoid the stuff to make the equality structual (from the referential equality default) by just declaring it as an attribute to the type and let the compiler handle the details.
<syntaxhighlight lang="fsharp">open System
[<Struct; StructuralEquality; NoComparison>]
type Quaternion(r : float, i : float, j : float, k : float) =
member this.A = r
member this.B = i
member this.C = j
member this.D = k
new (f : float) = Quaternion(f, 0., 0., 0.)
static member (~-) (q : Quaternion) = Quaternion(-q.A, -q.B, -q.C, -q.D)
static member (+) (q1 : Quaternion, q2 : Quaternion) =
Quaternion(q1.A + q2.A, q1.B + q2.B, q1.C + q2.C, q1.D + q2.D)
static member (+) (q : Quaternion, r : float) = q + Quaternion(r)
static member (+) (r : float, q: Quaternion) = Quaternion(r) + q
static member (*) (q1 : Quaternion, q2 : Quaternion) =
Quaternion(
q1.A * q2.A - q1.B * q2.B - q1.C * q2.C - q1.D * q2.D,
q1.A * q2.B + q1.B * q2.A + q1.C * q2.D - q1.D * q2.C,
q1.A * q2.C - q1.B * q2.D + q1.C * q2.A + q1.D * q2.B,
q1.A * q2.D + q1.B * q2.C - q1.C * q2.B + q1.D * q2.A)
static member (*) (q : Quaternion, r : float) = q * Quaternion(r)
static member (*) (r : float, q: Quaternion) = Quaternion(r) * q
member this.Norm = Math.Sqrt(r * r + i * i + j * j + k * k)
member this.Conjugate = Quaternion(r, -i, -j, -k)
override this.ToString() = sprintf "Q(%f, %f, %f, %f)" r i j k
[<EntryPoint>]
let main argv =
let q = Quaternion(1., 2., 3., 4.)
let q1 = Quaternion(2., 3., 4., 5.)
let q2 = Quaternion(3., 4., 5., 6.)
let r = 7.
printfn "q = %A" q
printfn "q1 = %A" q1
printfn "q2 = %A" q2
printfn "r = %A" r
printfn "q.Norm = %A" q.Norm
printfn "q1.Norm = %A" q1.Norm
printfn "q2.Norm = %A" q2.Norm
printfn "-q = %A" -q
printfn "q.Conjugate = %A" q.Conjugate
printfn "q + r = %A" (q + (Quaternion r))
printfn "q1 + q2 = %A" (q1 + q2)
printfn "q2 + q1 = %A" (q2 + q1)
printfn "q * r = %A" (q * r)
printfn "q1 * q2 = %A" (q1 * q2)
printfn "q2 * q1 = %A" (q2 * q1)
printfn "q1*q2 %s q2*q1" (if (q1 * q2) = (q2 * q1) then "=" else "<>")
printfn "q %s Q(1.,2.,3.,4.)" (if q = Quaternion(1., 2., 3., 4.) then "=" else "<>")
0</syntaxhighlight>
{{out}}
<pre>q = Q(1.000000, 2.000000, 3.000000, 4.000000)
q1 = Q(2.000000, 3.000000, 4.000000, 5.000000)
q2 = Q(3.000000, 4.000000, 5.000000, 6.000000)
r = 7.0
q.Norm = 5.477225575
q1.Norm = 7.348469228
q2.Norm = 9.273618495
-q = Q(-1.000000, -2.000000, -3.000000, -4.000000)
q.Conjugate = Q(1.000000, -2.000000, -3.000000, -4.000000)
q + r = Q(8.000000, 2.000000, 3.000000, 4.000000)
q1 + q2 = Q(5.000000, 7.000000, 9.000000, 11.000000)
q2 + q1 = Q(5.000000, 7.000000, 9.000000, 11.000000)
q * r = Q(7.000000, 14.000000, 21.000000, 28.000000)
q1 * q2 = Q(-56.000000, 16.000000, 24.000000, 26.000000)
q2 * q1 = Q(-56.000000, 18.000000, 20.000000, 28.000000)
q1*q2 <> q2*q1
q = Q(1.,2.,3.,4.)</pre>
=={{header|Factor}}==
The <code>math.quaternions</code> vocabulary provides words for treating sequences like quaternions. <code>norm</code> and <code>vneg</code> come from the <code>math.vectors</code> vocabulary. Oddly, I wasn't able to find a word for adding a real to a quaternion, so I wrote one.
<syntaxhighlight lang="factor">USING: generalizations io kernel locals math.quaternions
math.vectors prettyprint sequences ;
IN: rosetta-code.quaternion-type
: show ( quot -- )
[ unparse 2 tail but-last "= " append write ] [ call . ] bi
; inline
: 2show ( quots -- )
[ 2curry show ] map-compose [ call ] each ; inline
: q+n ( q n -- q+n ) n>q q+ ;
[let
{ 1 2 3 4 } 7 { 2 3 4 5 } { 3 4 5 6 } :> ( q r q1 q2 )
q [ norm ]
q [ vneg ]
q [ qconjugate ]
[ curry show ] 2tri@
{
[ q r [ q+n ] ]
[ q r [ q*n ] ]
[ q1 q2 [ q+ ] ]
[ q1 q2 [ q* ] ]
[ q2 q1 [ q* ] ]
} 2show
]</syntaxhighlight>
{{out}}
<pre>
{ 1 2 3 4 } norm = 5.477225575051661
{ 1 2 3 4 } vneg = { -1 -2 -3 -4 }
{ 1 2 3 4 } qconjugate = { 1 -2 -3 -4 }
{ 1 2 3 4 } 7 q+n = { 8 2 3 4 }
{ 1 2 3 4 } 7 q*n = { 7 14 21 28 }
{ 2 3 4 5 } { 3 4 5 6 } q+ = { 5 7 9 11 }
{ 2 3 4 5 } { 3 4 5 6 } q* = { -56 16 24 26 }
{ 3 4 5 6 } { 2 3 4 5 } q* = { -56 18 20 28 }
</pre>
=={{header|Forth}}==
<
: qvariable create 1 quaternions allot ;
Line 1,663 ⟶ 3,661:
m1 q1 q2 q* m1 q. \ ( -56. 16. 24. 26. )
m2 q2 q1 q* m2 q. \ ( -56. 18. 20. 28. )
m1 m2 q= . \ 0 (false)</
=={{header|Fortran}}==
{{works with|Fortran|90 and later}}
<
implicit none
Line 1,827 ⟶ 3,825:
write(*, "(a, 4f8.3)") " q2 * q1 = ", q2 * q1
end program</
{{out}}
<pre> q = 1.000 2.000 3.000 4.000
q1 = 2.000 3.000 4.000 5.000
Line 1,843 ⟶ 3,841:
q1 * q2 = -56.000 16.000 24.000 26.000
q2 * q1 = -56.000 18.000 20.000 28.000</pre>
=={{header|FreeBASIC}}==
<syntaxhighlight lang="freebasic">
Dim Shared As Integer q(3) = {1, 2, 3, 4}
Dim Shared As Integer q1(3) = {2, 3, 4, 5}
Dim Shared As Integer q2(3) = {3, 4, 5, 6}
Dim Shared As Integer i, r = 7, t(3)
Function q_norm(q() As Integer) As Double
' medida o valor absoluto de un cuaternión
Dim As Double a = 0
For i = 0 To 3
a += q(i)^2
Next i
Return Sqr(a)
End Function
Sub q_neg(q() As Integer)
For i = 0 To 3
q(i) *= -1
Next i
End Sub
Sub q_conj(q() As Integer)
' conjugado de un cuaternión
For i = 1 To 3
q(i) *= -1
Next i
End Sub
Sub q_addreal(q() As Integer, r As Integer)
q(0) += r
End Sub
Sub q_add(q() As Integer, r() As Integer)
' adición entre cuaternios
For i = 0 To 3
q(i) += r(i)
Next i
End Sub
Sub q_mulreal(q() As Integer, r As Integer)
For i = 0 To 3
q(i) *= r
Next i
End Sub
Sub q_mul(q() As Integer, r() As Integer)
' producto entre cuaternios
Dim As Integer m(3)
m(0) = q(0)*r(0) - q(1)*r(1) - q(2)*r(2) - q(3)*r(3)
m(1) = q(0)*r(1) + q(1)*r(0) + q(2)*r(3) - q(3)*r(2)
m(2) = q(0)*r(2) - q(1)*r(3) + q(2)*r(0) + q(3)*r(1)
m(3) = q(0)*r(3) + q(1)*r(2) - q(2)*r(1) + q(3)*r(0)
For i = 0 To 3 : q(i) = m(i) : Next i
End Sub
Function q_show(q() As Integer) As String
Dim As String a = "("
For i = 0 To 3
a += Str(q(i)) + ", "
Next i
Return Mid(a,1,Len(a)-2) + ")"
End Function
'--- Programa Principal ---
Print " q = "; q_show(q())
Print "q1 = "; q_show(q1())
Print "q2 = "; q_show(q2())
Print " r = "; r
Print "norm(q) ="; q_norm(q())
For i = 0 To 3 : t(i) = q(i) : Next i : q_neg(t()) : Print " neg(q) = "; q_show(t())
For i = 0 To 3 : t(i) = q(i) : Next i : q_conj(t()) : Print "conj(q) = "; q_show(t())
For i = 0 To 3 : t(i) = q(i) : Next i : q_addreal(t(),r) : Print " r + q = "; q_show(t())
For i = 0 To 3 : t(i) = q1(i) : Next i : q_add(t(),q2()) : Print "q1 + q2 = "; q_show(t())
For i = 0 To 3 : t(i) = q2(i) : Next i : q_add(t(),q1()) : Print "q2 + q1 = "; q_show(t())
For i = 0 To 3 : t(i) = q(i) : Next i : q_mulreal(t(),r) : Print " r * q = "; q_show(t())
For i = 0 To 3 : t(i) = q1(i) : Next i : q_mul(t(),q2()) : Print "q1 * q2 = "; q_show(t())
For i = 0 To 3 : t(i) = q2(i) : Next i : q_mul(t(),q1()) : Print "q2 * q1 = "; q_show(t())
End
</syntaxhighlight>
{{out}}
<pre>
q = (1, 2, 3, 4)
q1 = (2, 3, 4, 5)
q2 = (3, 4, 5, 6)
r = 7
norm(q) = 5.477225575051661
neg(q) = (-1, -2, -3, -4)
conj(q) = (1, -2, -3, -4)
r + q = (8, 2, 3, 4)
q1 + q2 = (5, 7, 9, 11)
q2 + q1 = (5, 7, 9, 11)
r * q = (7, 14, 21, 28)
q1 * q2 = (-56, 16, 24, 26)
q2 * q1 = (-56, 18, 20, 28)
</pre>
=={{header|GAP}}==
<syntaxhighlight lang="gap"># GAP has built-in support for quaternions
A := QuaternionAlgebra(Rationals);
Line 1,856 ⟶ 3,951:
# e+(2)*i+(3)*j+(4)*k
# Conjugate
ComplexConjugate(q);
# e+(-2)*i+(-3)*j+(-4)*k
# Division
1/q;
# (1/30)*e+(-1/15)*i+(-1/10)*j+(-2/15)*k
# Computing norm may be difficult, since the result would be in a quadratic field.
# Sqrt exists in GAP, but it is quite unusual: see ?E in GAP documentation, and the following example
Sqrt(5/3);
# 1/3*E(60)^7+1/3*E(60)^11-1/3*E(60)^19-1/3*E(60)^23-1/3*E(60)^31+1/3*E(60)^43-1/3*E(60)^47+1/3*E(60)^59
# However, the square of the norm is easy to compute
q*ComplexConjugate(q);
# (30)*e
q1 := [2, 3, 4, 5]*b;
Line 1,870 ⟶ 3,978:
# Can't add directly to a rational, one must make a quaternion of it
r := 5/3*b[1];
# (5/3)*e
r + q;
Line 1,876 ⟶ 3,984:
# For multiplication, no problem (we are in an algebra over rationals !)
r
# (5/3)*e+(10/3)*i+(5)*j+(20/3)*k
5/3
# (5/3)*e+(10/3)*i+(5)*j+(20/3)*k
# Negative
-q;
(-1)*e+(-2)*i+(-3)*j+(-4)*k
# While quaternions are built-in, you can define an algebra in GAP by specifying it's multiplication table.
# See tutorial, p. 60, and reference of the functions used below.
# A multiplication table of dimension 4.
T := EmptySCTable(4, 0);
SetEntrySCTable(T, 1, 1, [1, 1]);
SetEntrySCTable(T, 1, 2, [1, 2]);
SetEntrySCTable(T, 1, 3, [1, 3]);
SetEntrySCTable(T, 1, 4, [1, 4]);
SetEntrySCTable(T, 2, 1, [1, 2]);
SetEntrySCTable(T, 2, 2, [-1, 1]);
SetEntrySCTable(T, 2, 3, [1, 4]);
SetEntrySCTable(T, 2, 4, [-1, 3]);
SetEntrySCTable(T, 3, 1, [1, 3]);
SetEntrySCTable(T, 3, 2, [-1, 4]);
SetEntrySCTable(T, 3, 3, [-1, 1]);
SetEntrySCTable(T, 3, 4, [1, 2]);
SetEntrySCTable(T, 4, 1, [1, 4]);
SetEntrySCTable(T, 4, 2, [1, 3]);
SetEntrySCTable(T, 4, 3, [-1, 2]);
SetEntrySCTable(T, 4, 4, [-1, 1]);
A := AlgebraByStructureConstants(Rationals, T, ["e", "i", "j", "k"]);
b := GeneratorsOfAlgebra(A);
IsAssociative(A);
# true
IsCommutative(A);
# false
# Then, like above
q := [1, 2, 3, 4]*b;
# e+(2)*i+(3)*j+(4)*k
# However, as is, GAP does not know division or conjugate on this algebra.
# QuaternionAlgebra is useful as well for extensions of rationals,
# and this one _has_ conjugate and division, as seen previously.
# Try this on Q[z] where z is the square root of 5 (in GAP it's ER(5))
F := FieldByGenerators([ER(5)]);
A := QuaternionAlgebra(F);
b := GeneratorsOfAlgebra(A);
q := [1, 2, 3, 4]*b;
# e+(2)*i+(3)*j+(4)*k
# Conjugate and division
ComplexConjugate(q);
# e+(-2)*i+(-3)*j+(-4)*k
1/q;
# (1/30)*e+(-1/15)*i+(-1/10)*j+(-2/15)*k</syntaxhighlight>
=={{header|Go}}==
Conventions for method receiver, parameter, and return values modeled after Go's big number package.
It provides flexibility without requiring unnecessary object creation.
The test program creates only four quaternion objects, the three inputs and one more for an output.
The three inputs are reused repeatedly without being modified.
The output is also reused repeatedly, being overwritten for each operation.
<syntaxhighlight lang="go">package main
import (
Line 1,965 ⟶ 4,135:
q1.r*q2.k+q1.i*q2.j-q1.j*q2.i+q1.k*q2.r
return z
}</
{{out}}
<pre>
Inputs
Line 1,986 ⟶ 4,156:
=={{header|Haskell}}==
<
data Quaternion a =
Q a a a a
deriving (Show, Eq)
realQ :: Quaternion a ->
realQ (Q r _ _ _) = r
imagQ :: Quaternion a -> [
imagQ (Q _ i j k) = [i, j, k]
quaternionFromScalar :: (Num a) => a -> Quaternion a
quaternionFromScalar s = Q s 0 0 0
listFromQ
listFromQ (Q a b c d) = [a, b, c, d]
quaternionFromList :: [a] -> Quaternion a
quaternionFromList [a, b, c, d] = Q a b c d
normQ = sqrt . sum . join (zipWith (*)) . listFromQ
conjQ :: (Num a) => Quaternion a -> Quaternion a
conjQ (Q a b c d) = Q a (-b) (-c) (-d)
instance (RealFloat a) => Num (Quaternion a) where
(Q a b c d) + (Q p q r s) = Q (a + p) (b + q) (c + r) (d + s)
(Q a b c d) - (Q p q r s) = Q (a - p) (b - q) (c - r) (d - s)
(Q a b c d) * (Q p q r s) =
Q
(a * q + b * p + c * s - d * r)
(a * s + b * r - c * q + d * p)
negate (Q a b c d) = Q (-a) (-b) (-c) (-d)
abs q = quaternionFromScalar (normQ q)
signum (Q 0 0 0 0) = 0
signum q@(Q a b c d) = Q (a/n) (b/n) (c/n) (d/n) where n = normQ q
fromInteger n = quaternionFromScalar (fromInteger n)
main :: IO ()
main = do
let q, q1, q2 :: Quaternion Double
q = Q 1 2 3 4
q1 = Q 2 3 4 5
q2 = Q 3 4 5 6
print $ (Q 0 1 0 0) * (Q 0 0 1 0) * (Q 0 0 0 1) -- i*j*k; prints "Q (-1.0) 0.0 0.0 0.0"
print $ q1 * q2 -- prints "Q (-56.0) 16.0 24.0 26.0"
print $ q2 * q1 -- prints "Q (-56.0) 18.0 20.0 28.0"
print $ q1 * q2 == q2 * q1 -- prints "False"
print $ imagQ q -- prints "[2.0,3.0,4.0]"</syntaxhighlight>
==Icon and {{header|Unicon}}==
Line 2,046 ⟶ 4,214:
Using Unicon's class system.
<syntaxhighlight lang="unicon">
class Quaternion(a, b, c, d)
Line 2,090 ⟶ 4,258:
self.d := if /d then 0 else d
end
</syntaxhighlight>
To test the above:
<syntaxhighlight lang="unicon">
procedure main ()
q := Quaternion (1,2,3,4)
Line 2,111 ⟶ 4,279:
write ("q2*q1 = " || q2.multiply(q1).string ())
end
</syntaxhighlight>
{{out}}
<pre>
The norm of 1+2i+3j+4k is 5.477225575
Line 2,125 ⟶ 4,293:
q2*q1 = -56+18i+20j+28k
</pre>
=={{header|Idris}}==
With [[wp:Dependent_type|dependent types]] we can implement the more general [[wp:Cayley-Dickson_construction|Cayley-Dickson construction]]. Here the dependent type <code>CD n a</code> is implemented. It depends on a natural number <code>n</code>, which is the number of iterations carried out, and the base type <code>a</code>. So the real numbers are just <code>CD 0 Double</code>, the complex numbers <code>CD 1 Double</code> and the quaternions <code>CD 2 Double</code>
<syntaxhighlight lang="idris">
module CayleyDickson
data CD : Nat -> Type -> Type where
CDBase : a -> CD 0 a
CDProd : CD n a -> CD n a -> CD (S n) a
pairTy : Nat -> Type -> Type
pairTy Z a = a
pairTy (S n) a = let b = pairTy n a in (b, b)
fromPair : (n : Nat) -> pairTy n a -> CD n a
fromPair Z x = CDBase x
fromPair (S m) (x, y) = CDProd (fromPair m x) $ fromPair m y
toPair : CD n a -> pairTy n a
toPair (CDBase x) = x
toPair (CDProd x v) = (toPair x, toPair v)
first : CD n a -> a
first (CDBase x) = x
first (CDProd x v) = first x
fromBase : Num a => (n : Nat) -> a -> CD n a
fromBase Z x = CDBase x
fromBase (S m) x = CDProd (fromBase m x) $ fromBase m 0
multSclr : Num a => CD n a -> a -> CD n a
multSclr (CDBase x) y = CDBase $ x * y
multSclr (CDProd x v) y = CDProd (multSclr x y) $ multSclr v y
divSclr : Fractional a => CD n a -> a -> CD n a
divSclr (CDBase x) y = CDBase $ x / y
divSclr (CDProd x v) y = CDProd (divSclr x y) $ divSclr v y
plusCD : Num a => CD n a -> CD n a -> CD n a
plusCD (CDBase x) (CDBase y) = CDBase $ x + y
plusCD (CDProd x v) (CDProd y w) = CDProd (plusCD x y) $ plusCD v w
negCD : Neg a => CD n a -> CD n a
negCD (CDBase x) = CDBase $ negate x
negCD (CDProd x v) = CDProd (negCD x) $ negCD v
minusCD : Neg a => CD n a -> CD n a -> CD n a
minusCD (CDBase x) (CDBase y) = CDBase $ x - y
minusCD (CDProd x v) (CDProd y w) = CDProd (minusCD x y) $ minusCD v w
conjCD : Neg a => CD n a -> CD n a
conjCD (CDBase x) = CDBase x
conjCD (CDProd x v) = CDProd (conjCD x) $ negCD v
multCD : Neg a => CD n a -> CD n a -> CD n a
multCD (CDBase x) (CDBase y) = CDBase $ x * y
multCD (CDProd x v) (CDProd y w) = CDProd (minusCD (multCD x y) (multCD (conjCD w) v)) $ plusCD (multCD w x) $ multCD v $ conjCD y
absSqrCD : Neg a => CD n a -> CD n a
absSqrCD x = multCD x $ conjCD x
sqrLnCD : Neg a => CD n a -> a
sqrLnCD = first . absSqrCD
recipCD : Neg a => Fractional a => CD n a -> CD n a
recipCD x = conjCD $ divSclr x $ sqrLnCD x
divCD : Neg a => Fractional a => CD n a -> CD n a -> CD n a
divCD x y = multCD x $ recipCD y
absCD : CD n Double -> Double
absCD x = sqrt $ sqrLnCD x
showComps : Show a => CD n a -> String
showComps (CDBase x) = show x
showComps (CDProd x v) = showComps x ++ ", " ++ showComps v
Eq a => Eq (CD n a) where
(CDBase x) == (CDBase y) = x == y
(CDProd x v) == (CDProd y w) = x == y && v == w
Show a => Show (CD n a) where
show x = "(" ++ showComps x ++ ")"
Neg a => Num (CD n a) where
(+) = plusCD
(*) = multCD
fromInteger m {n} = fromBase n $ fromInteger m
Neg a => Neg (CD n a) where
negate = negCD
(-) = minusCD
(Neg a, Fractional a) => Fractional (CD n a) where
(/) = divCD
recip = recipCD
Abs (CD n Double) where
abs {n} = fromBase n . absCD
</syntaxhighlight>
To test it:
<syntaxhighlight lang="idris">
import CayleyDickson
main : IO ()
main =
do
let q = fromPair 2 ((1, 2), (3, 4))
let q1 = fromPair 2 ((2, 3), (4, 5))
let q2 = fromPair 2 ((3, 4), (5, 6))
printLn $ q1 * q2
printLn $ q2 * q1
printLn $ q1 * q2 == q2 * q1
</syntaxhighlight>
=={{header|J}}==
Line 2,130 ⟶ 4,416:
Derived from the [[j:System/Requests/Quaternions|j wiki]]:
<
ip=: +/ .* NB. inner product
toQ=: 4&{."1 :[: NB. real scalars -> quaternion
Line 2,140 ⟶ 4,426:
conj=: 1 _1 _1 _1 * toQ NB. + y
add=: +&toQ NB. x + y
mul=: (ip
T is a rank 3 tensor which allows us to express quaternion product ab as the inner product ATB if A and B are 4 element vectors representing the quaternions a and b. (Note also that once we have defined <code>mul</code> we no longer need to retain the definition of T, so we define T using =. instead of =:). The value of T is probably more interesting than its definition, so:
<syntaxhighlight lang="j"> T
1 0 0 0
0 1 0 0
0 0 1 0
0 0 0 1
0 _1 0 0
1 0 0 0
0 0 0 _1
0 0 1 0
0 0 _1 0
0 0 0 1
1 0 0 0
0 _1 0 0
0 0 0 _1
0 0 _1 0
0 1 0 0
1 0 0 0</syntaxhighlight>
In other words, the last dimension of T corresponds to the structure of the right argument (columns, in the display of T), the first dimension of T corresponds to the structure of the left argument (tables, in the display of T) and the middle dimension of T corresponds to the structure of the result (rows, in the display of T).
Example use:
<syntaxhighlight lang="text"> q=: 1 2 3 4
q1=: 2 3 4 5
q2=: 3 4 5 6
Line 2,164 ⟶ 4,475:
_56 16 24 26
q2 mul q1
_56 18 20 28</
Finally, note that when quaternions are used to represent [[wp:Quaternions_and_spatial_rotation|orientation or rotation]], we are typically only interested in unit length quaternions. As this is the typical application for quaternions, you will sometimes see quaternion multiplication expressed using "simplifications" which are only valid for unit length quaternions. But note also that in many of those contexts you also need to normalize the quaternion length after multiplication.
(An exception to this need to normalize unit length quaternions after multiplication might be when quaternions are represented as an index into a [[wp:Geodesic_grid|geodesic grid]]. For example, a grid with 16x20 faces would have a total of 15 vertices for each face (5+4+3+2+1), 3 of those vertices would be from the original 20 vertices of the icosahedron, and 9 of those vertices (5+4+3-3) would be on the edge of the original face (and, thus, used for two faces), the remaining 3 vertices would be interior. This means we would have 170 vertices (20+(20*9%2)+20*3, which would allow a quaternion to be represented in a single byte index into a list of 170 quaternions, and would allow quaternion multiplication to be represented as a 29kbyte lookup table. In some contexts - where quaternion multiplication is needed in high volume for secondary or tertiary issues (where precision isn't vital), such low accuracy quaternions might be adequate or even an advantage...)
=={{header|Java}}==
<
private final double a, b, c, d;
Line 2,268 ⟶ 4,584:
System.out.format("q1 \u00d7 q2 %s q2 \u00d7 q1%n", (q1q2.equals(q2q1) ? "=" : "\u2260"));
}
}</
{{out}}
<pre>q = 1.00 + 2.00i + 3.00j + 4.00k
q1 = 2.00 + 3.00i + 4.00j + 5.00k
Line 2,287 ⟶ 4,602:
q1 × q2 ≠ q2 × q1</pre>
=={{header|JavaScript
Runs on Firefox 3+, limited support in other JS engines. More compatible JavaScript deserves its own entry.
<
// The Q() function takes an array argument and changes it
// prototype so that it becomes a Quaternion instance. This is
Line 2,347 ⟶ 4,662:
Quaternion.prototype = proto;
return Quaternion;
})();</
Task/Example Usage:
<
var q1 = Quaternion(2,3,4,5);
var q2 = Quaternion(3,4,5,6);
Line 2,368 ⟶ 4,683:
console.log("7.a. q1.mul(q2) = "+q1.mul(q2));
console.log("7.b. q2.mul(q1) = "+q2.mul(q1));
console.log("8. q1.mul(q2) " + (q1.mul(q2).equals(q2.mul(q1)) ? "==" : "!=") + " q2.mul(q1)");</
{{out}}
<pre>q = 1 + 2i + 3j + 4k
q1 = 2 + 3i + 4j + 5k
Line 2,385 ⟶ 4,699:
7.b. q2.mul(q1) = -56 + 18i + 20j + 28k
8. q1.mul(q2) != q2.mul(q1)</pre>
=={{header|jq}}==
Program file: quaternion.jq<syntaxhighlight lang="jq">def Quaternion(q0;q1;q2;q3): { "q0": q0, "q1": q1, "q2": q2, "q3": q3, "type": "Quaternion" };
# promotion of a real number to a quaternion
def Quaternion(r): if (r|type) == "number" then Quaternion(r;0;0;0) else r end;
# thoroughly recursive pretty-print
def pp:
def signage: if . >= 0 then "+ \(.)" else "- \(-.)" end;
if type == "object" then
if .type == "Quaternion" then
"\(.q0) \(.q1|signage)i \(.q2|signage)j \(.q3|signage)k"
else with_entries( {key, "value" : (.value|pp)} )
end
elif type == "array" then map(pp)
else .
end ;
def real(z): Quaternion(z).q0;
# Note: imag(z) returns the "i" component only,
# reflecting the embedding of the complex numbers within the quaternions:
def imag(z): Quaternion(z).q1;
def conj(z): Quaternion(z) | Quaternion(.q0; -(.q1); -(.q2); -(.q3));
def abs2(z): Quaternion(z) | .q0 * .q0 + .q1*.q1 + .q2*.q2 + .q3*.q3;
def abs(z): abs2(z) | sqrt;
def negate(z): Quaternion(z) | Quaternion(-.q0; -.q1; -.q2; -.q3);
# z + w
def plus(z; w):
def plusq(z;w): Quaternion(z.q0 + w.q0; z.q1 + w.q1;
z.q2 + w.q2; z.q3 + w.q3);
plusq( Quaternion(z); Quaternion(w) );
# z - w
def minus(z; w):
def minusq(z;w): Quaternion(z.q0 - w.q0; z.q1 - w.q1;
z.q2 - w.q2; z.q3 - w.q3);
minusq( Quaternion(z); Quaternion(w) );
# *
def times(z; w):
def timesq(z; w):
Quaternion(z.q0*w.q0 - z.q1*w.q1 - z.q2*w.q2 - z.q3*w.q3;
z.q0*w.q1 + z.q1*w.q0 + z.q2*w.q3 - z.q3*w.q2;
z.q0*w.q2 - z.q1*w.q3 + z.q2*w.q0 + z.q3*w.q1;
z.q0*w.q3 + z.q1*w.q2 - z.q2*w.q1 + z.q3*w.q0);
timesq( Quaternion(z); Quaternion(w) );
# (z/w)
def div(z; w):
if (w|type) == "number" then Quaternion(z.q0/w; z.q1/w; z.q2/w; z.q3/w)
else times(z; inv(w))
end;
def inv(z): div(conj(z); abs2(z));
# Example usage and output:
def say(msg; e): "\(msg) => \(e|pp)";
def demo:
say( "Quaternion(1;0;0;0)"; Quaternion(1;0;0;0)),
(Quaternion (1; 2; 3; 4) as $q
| Quaternion(2; 3; 4; 5) as $q1
| Quaternion(3; 4; 5; 6) as $q2
| 7 as $r
| say( "abs($q)"; abs($q) ), # norm
say( "negate($q)"; negate($q) ),
say( "conj($q)"; conj($q) ),
"",
say( "plus($r; $q)"; plus($r; $q)),
say( "plus($q; $r)"; plus($q; $r)),
"",
say( "plus($q1; $q2 )"; plus($q1; $q2)),
"",
say( "times($r;$q)"; times($r;$q)),
say( "times($q;$r)"; times($q;$r)),
"",
say( "times($q1;$q2)"; times($q1;$q2)),
say( "times($q2; $q1)"; times($q2; $q1)),
say( "times($q1; $q2) != times($q2; $q1)";
times($q1; $q2) != times($q2; $q1) )
) ;
demo</syntaxhighlight>
Example usage and output:
<syntaxhighlight lang="sh"># jq -c -n -R -f quaternion.jq
Quaternion(1;0;0;0) => 1 + 0i + 0j + 0k
abs($q) => 5.477225575051661
negate($q) => -1 - 2i - 3j + -4k
conj($q) => 1 - 2i - 3j - 4k
plus($r; $q) => 8 + 2i + 3j + 4k
plus($q; $r) => 8 + 2i + 3j + 4k
plus($q1; $q2 ) => 5 + 7i + 9j + 11k
times($r;$q) => 7 + 14i + 21j + 28k
times($q;$r) => 7 + 14i + 21j + 28k
times($q1;$q2) => -56 + 16i + 24j + 26k
times($q2; $q1) => -56 + 18i + 20j + 28k
times($q1; $q2) != times($q2; $q1) => true</syntaxhighlight>
=={{header|Julia}}==
https://github.com/andrioni/Quaternions.jl/blob/master/src/Quaternions.jl has a more complete implementation.
This is derived from the [https://github.com/JuliaLang/julia/blob/release-0.2/examples/quaternion.jl quaternion example file] included with Julia 0.2, which implements a quaternion type complete with arithmetic, type conversions / promotion rules, polymorphism over arbitrary real numeric types, and pretty-printing.
<syntaxhighlight lang="julia">import Base: convert, promote_rule, show, conj, abs, +, -, *
immutable Quaternion{T<:Real} <: Number
q0::T
q1::T
q2::T
q3::T
end
Quaternion(q0::Real,q1::Real,q2::Real,q3::Real) = Quaternion(promote(q0,q1,q2,q3)...)
convert{T}(::Type{Quaternion{T}}, x::Real) =
Quaternion(convert(T,x), zero(T), zero(T), zero(T))
convert{T}(::Type{Quaternion{T}}, z::Complex) =
Quaternion(convert(T,real(z)), convert(T,imag(z)), zero(T), zero(T))
convert{T}(::Type{Quaternion{T}}, z::Quaternion) =
Quaternion(convert(T,z.q0), convert(T,z.q1), convert(T,z.q2), convert(T,z.q3))
promote_rule{T,S}(::Type{Complex{T}}, ::Type{Quaternion{S}}) = Quaternion{promote_type(T,S)}
promote_rule{T<:Real,S}(::Type{T}, ::Type{Quaternion{S}}) = Quaternion{promote_type(T,S)}
promote_rule{T,S}(::Type{Quaternion{T}}, ::Type{Quaternion{S}}) = Quaternion{promote_type(T,S)}
function show(io::IO, z::Quaternion)
pm(x) = x < 0 ? " - $(-x)" : " + $x"
print(io, z.q0, pm(z.q1), "i", pm(z.q2), "j", pm(z.q3), "k")
end
conj(z::Quaternion) = Quaternion(z.q0, -z.q1, -z.q2, -z.q3)
abs(z::Quaternion) = sqrt(z.q0*z.q0 + z.q1*z.q1 + z.q2*z.q2 + z.q3*z.q3)
(-)(z::Quaternion) = Quaternion(-z.q0, -z.q1, -z.q2, -z.q3)
(+)(z::Quaternion, w::Quaternion) = Quaternion(z.q0 + w.q0, z.q1 + w.q1,
z.q2 + w.q2, z.q3 + w.q3)
(-)(z::Quaternion, w::Quaternion) = Quaternion(z.q0 - w.q0, z.q1 - w.q1,
z.q2 - w.q2, z.q3 - w.q3)
(*)(z::Quaternion, w::Quaternion) = Quaternion(z.q0*w.q0 - z.q1*w.q1 - z.q2*w.q2 - z.q3*w.q3,
z.q0*w.q1 + z.q1*w.q0 + z.q2*w.q3 - z.q3*w.q2,
z.q0*w.q2 - z.q1*w.q3 + z.q2*w.q0 + z.q3*w.q1,
z.q0*w.q3 + z.q1*w.q2 - z.q2*w.q1 + z.q3*w.q0)
</syntaxhighlight>
Example usage and output:
<syntaxhighlight lang="julia">julia> q = Quaternion(1,0,0,0)
julia> q = Quaternion (1, 2, 3, 4)
q1 = Quaternion(2, 3, 4, 5)
q2 = Quaternion(3, 4, 5, 6)
r = 7.
julia> norm(q)
5.477225575051661
julia> -q
-1 - 2i - 3j - 4k
julia> conj(q)
1 - 2i - 3j - 4k
julia> r + q, q + r
(8.0 + 2.0i + 3.0j + 4.0k,8.0 + 2.0i + 3.0j + 4.0k)
julia> q1 + q2
5 + 7i + 9j + 11k
julia> r*q, q*r
(7.0 + 14.0i + 21.0j + 28.0k,7.0 + 14.0i + 21.0j + 28.0k)
julia> q1*q2, q2*q1, q1*q2 != q2*q1
(-56 + 16i + 24j + 26k,-56 + 18i + 20j + 28k,true)</syntaxhighlight>
=={{header|Kotlin}}==
<syntaxhighlight lang="scala">// version 1.1.2
data class Quaternion(val a: Double, val b: Double, val c: Double, val d: Double) {
operator fun plus(other: Quaternion): Quaternion {
return Quaternion (this.a + other.a, this.b + other.b,
this.c + other.c, this.d + other.d)
}
operator fun plus(r: Double) = Quaternion(a + r, b, c, d)
operator fun times(other: Quaternion): Quaternion {
return Quaternion(
this.a * other.a - this.b * other.b - this.c * other.c - this.d * other.d,
this.a * other.b + this.b * other.a + this.c * other.d - this.d * other.c,
this.a * other.c - this.b * other.d + this.c * other.a + this.d * other.b,
this.a * other.d + this.b * other.c - this.c * other.b + this.d * other.a
)
}
operator fun times(r: Double) = Quaternion(a * r, b * r, c * r, d * r)
operator fun unaryMinus() = Quaternion(-a, -b, -c, -d)
fun conj() = Quaternion(a, -b, -c, -d)
fun norm() = Math.sqrt(a * a + b * b + c * c + d * d)
override fun toString() = "($a, $b, $c, $d)"
}
// extension functions for Double type
operator fun Double.plus(q: Quaternion) = q + this
operator fun Double.times(q: Quaternion) = q * this
fun main(args: Array<String>) {
val q = Quaternion(1.0, 2.0, 3.0, 4.0)
val q1 = Quaternion(2.0, 3.0, 4.0, 5.0)
val q2 = Quaternion(3.0, 4.0, 5.0, 6.0)
val r = 7.0
println("q = $q")
println("q1 = $q1")
println("q2 = $q2")
println("r = $r\n")
println("norm(q) = ${"%f".format(q.norm())}")
println("-q = ${-q}")
println("conj(q) = ${q.conj()}\n")
println("r + q = ${r + q}")
println("q + r = ${q + r}")
println("q1 + q2 = ${q1 + q2}\n")
println("r * q = ${r * q}")
println("q * r = ${q * r}")
val q3 = q1 * q2
val q4 = q2 * q1
println("q1 * q2 = $q3")
println("q2 * q1 = $q4\n")
println("q1 * q2 != q2 * q1 = ${q3 != q4}")
}</syntaxhighlight>
{{out}}
<pre>
q = (1.0, 2.0, 3.0, 4.0)
q1 = (2.0, 3.0, 4.0, 5.0)
q2 = (3.0, 4.0, 5.0, 6.0)
r = 7.0
norm(q) = 5.477226
-q = (-1.0, -2.0, -3.0, -4.0)
conj(q) = (1.0, -2.0, -3.0, -4.0)
r + q = (8.0, 2.0, 3.0, 4.0)
q + r = (8.0, 2.0, 3.0, 4.0)
q1 + q2 = (5.0, 7.0, 9.0, 11.0)
r * q = (7.0, 14.0, 21.0, 28.0)
q * r = (7.0, 14.0, 21.0, 28.0)
q1 * q2 = (-56.0, 16.0, 24.0, 26.0)
q2 * q1 = (-56.0, 18.0, 20.0, 28.0)
q1 * q2 != q2 * q1 = true
</pre>
=={{header|Liberty BASIC}}==
Quaternions saved as a space-separated string of four numbers.
<syntaxhighlight lang="lb">
q$ = q$( 1 , 2 , 3 , 4 )
Line 2,501 ⟶ 5,083:
add2$ =q$( ar +br, ai +bi, aj +bj, ak +bk)
end function
</
=={{header|Lua}}==
<
function Quaternion.new( a, b, c, d )
Line 2,566 ⟶ 5,148:
function Quaternion.print( p )
print( string.format( "%f + %fi + %fj + %fk\n", p.a, p.b, p.c, p.d ) )
end</
Examples:
<
q2 = Quaternion.new( 5, 6, 7, 8 )
r = 12
Line 2,580 ⟶ 5,162:
io.write( "q1*r = " ); Quaternion.print( q1*r )
io.write( "q1*q2 = " ); Quaternion.print( q1*q2 )
io.write( "q2*q1 = " ); Quaternion.print( q2*q1 )</syntaxhighlight>
{{out}}
<pre>norm(q1) = 5.4772255750517
-q1 = -1.000000 -2.000000i -3.000000j -4.000000k
conj(q1) = 1.000000 -2.000000i -3.000000j -4.000000k
Line 2,590 ⟶ 5,173:
q1*r = 12.000000 + 24.000000i + 36.000000j + 48.000000k
q1*q2 = -60.000000 + 12.000000i + 30.000000j + 24.000000k
q2*q1 = -60.000000 + 20.000000i + 14.000000j + 32.000000k</
=={{header|
We can define Quaternions using a class, using operators for specific tasks, as negate, add, multiplication and equality with rounding to 13 decimal place (thats what doing "==" operator for doubles)
<syntaxhighlight lang="m2000 interpreter">
Module CheckIt {
class Quaternion {
\\ by default are double
a,b,c,d
Property ToString$ {
Value {
link parent a,b,c, d to a,b,c,d
value$=format$("{0} + {1}i + {2}j + {3}k",a,b,c,d)
}
}
Property Norm { Value}
Operator "==" {
read n
push .a==n.a and .b==n.b and .c==n.c and .d==n.d
}
Module CalcNorm {
.[Norm]<=sqrt(.a**2+.b**2+.c**2+.d**2)
}
Operator Unary {
.a-! : .b-! : .c-! :.d-!
}
Function Conj {
q=this
for q {
.b-! : .c-! :.d-!
}
=q
}
Function Add {
q=this
for q {
.a+=Number : .CalcNorm
}
=q
}
Operator "+" {
Read q2
For this, q2 {
.a+=..a :.b+=..b:.c+=..c:.d+=..d
.CalcNorm
}
}
Function Mul(r) {
q=this
for q {
.a*=r:.b*=r:.c*=r:.d*=r:.CalcNorm
}
=q
}
Operator "*" {
Read q2
For This, q2 {
Push .a*..a-.b*..b-.c*..c-.d*..d
Push .a*..b+.b*..a+.c*..d-.d*..c
Push .a*..c-.b*..d+.c*..a+.d*..b
.d<=.a*..d+.b*..c-.c*..b+.d*..a
Read .c, .b, .a
.CalcNorm
}
}
class:
module Quaternion {
if match("NNNN") then {
Read .a,.b,.c,.d
.CalcNorm
}
}
}
\\ variables
r=7
q=Quaternion(1,2,3,4)
q1=Quaternion(2,3,4,5)
q2=Quaternion(3,4,5,6)
\\ perform negate, conjugate, multiply by real, add a real, multiply quanterions, multiply in reverse order
qneg=-q
qconj=q.conj()
qmul=q.Mul(r)
qadd=q.Add(r)
q1q2=q1*q2
q2q1=q2*q1
Print "q = ";q.ToString$
Print "Normal q = ";q.Norm
Print "Neg q = ";qneg.ToString$
Print "Conj q = ";qconj.ToString$
Print "Mul q 7 = ";qmul.ToString$
Print "Add q 7 = ";qadd.ToString$
Print "q1 = ";q1.ToString$
Print "q2 = ";q2.ToString$
Print "q1 * q2 = ";q1q2.ToString$
Print "q2 * q1 = ";q2q1.ToString$
Print q1==q1 ' true
Print q1q2==q2q1 ' false
\\ multiplication and equality in one expression
Print q1 * q2 == q2 * q1 ' false
Print q1 * q2 == q1 * q2 ' true
}
CheckIt
</syntaxhighlight>
{{out}}
<pre>
q = 1 + 2i + 3j + 4k
Normal q = 5.47722557505166
Neg q = -1 + -2i + -3j + -4k
Conj q = 1 + -2i + -3j + -4k
Mul q 7 = 7 + 14i + 21j + 28k
Add q 7 = 8 + 2i + 3j + 4k
q1 = 2 + 3i + 4j + 5k
q2 = 3 + 4i + 5j + 6k
q1 * q2 = -56 + 16i + 24j + 26k
q2 * q1 = -56 + 18i + 20j + 28k
True
False
false
True</pre>
=={{header|Maple}}==
<syntaxhighlight lang="maple">
with(ArrayTools);
module Quaternion()
option object;
local real := 0;
local i := 0;
local j := 0;
local k := 0;
export getReal::static := proc(self::Quaternion, $)
return self:-real;
end proc;
export getI::static := proc(self::Quaternion, $)
return self:-i;
end proc;
export getJ::static := proc(self::Quaternion, $)
return self:-j;
end proc;
export getK::static := proc(self::Quaternion, $)
return self:-k;
end proc;
export Norm::static := proc(self::Quaternion, $)
return sqrt(self:-real^2 + self:-i^2 + self:-j^2 + self:-k^2);
end proc;
# NegativeQuaternion returns the additive inverse of the quaternion
export NegativeQuaternion::static := proc(self::Quaternion, $)
return Quaternion(- self:-real, - self:-i, - self:-j, - self:-k);
end proc;
export Conjugate::static := proc(self::Quaternion, $)
return Quaternion(self:-real, - self:-i, - self:-j, - self:-k);
end proc;
# quaternion addition
export `+`::static := overload ([
proc(self::Quaternion, x::Quaternion) option overload;
return Quaternion(self:-real + getReal(x), self:-i + getI(x), self:-j + getJ(x), self:-k + getK(x));
end proc,
proc(self::Quaternion, x::algebraic) option overload;
return Quaternion(self:-real + x, self:-i, self:-j, self:-k);
end proc,
proc(x::algebraic, self::Quaternion) option overload;
return Quaternion(x + self:-real, self:-i, self:-j, self:-k);
end
]);
# convert quaternion to additive inverse
export `-`::static := overload([
proc(self::Quaternion) option overload;
return Quaternion(-self:-real, -self:-i, -self:-j, -self:-k);
end
]);
# quaternion multiplication is non-abelian so the `.` operator needs to be used
export `.`::static := overload([
proc(self::Quaternion, x::Quaternion) option overload;
return Quaternion(self:-real * getReal(x) - self:-i * getI(x) - self:-j * getJ(x) - self:-k * getK(x),
self:-real * getI(x) + self:-i * getReal(x) + self:-j * getK(x) - self:-k * getJ(x),
self:-real * getJ(x) + self:-j * getReal(x) - self:-i * getK(x) + self:-k * getI(x),
self:-real * getK(x) + self:-k * getReal(x) + self:-i * getJ(x) - self:-j * getI(x));
end proc,
proc(self::Quaternion, x::algebraic) option overload;
return Quaternion(self:-real * x, self:-i * x, self:-j * x, self:-k * x);
end proc,
proc(x::algebraic, self::Quaternion) option overload;
return Quaternion(self:-real * x, self:-i * x, self:-j * x, self:-k * x);
end
]);
# redirect division to `.` operator
export `*`::static := overload([
proc(self::Quaternion, x::Quaternion) option overload;
use `*` = `.` in return self * x; end use
end proc,
proc(self::Quaternion, x::algebraic) option overload;
use `*` = `.` in return x * self; end use
end proc,
proc(x::algebraic, self::Quaternion) option overload;
use `*` = `.` in return x * self; end use
end
]);
# convert quaternion to multiplicative inverse
export `/`::static := overload([
proc(self::Quaternion) option overload;
return Conjugate(self) . (1/(Norm(self)^2));
end proc
]);
# QuaternionCommutator computes the commutator of self and x
export QuaternionCommutator::static := proc(x::Quaternion, y::Quaternion, $)
return (x . y) - (y . x);
end proc;
# display quaternion
export ModulePrint::static := proc(self::Quaternion, $);
return cat(self:-real, " + ", self:-i, "i + ", self:-j, "j + ", self:-k, "k"):
end proc;
export ModuleApply::static := proc()
Object(Quaternion, _passed);
end proc;
export ModuleCopy::static := proc(new::Quaternion, proto::Quaternion, R::algebraic, imag::algebraic, J::algebraic, K::algebraic, $)
new:-real := R;
new:-i := imag;
new:-j := J;
new:-k := K;
end proc;
end module:
q := Quaternion(1, 2, 3, 4):
q1 := Quaternion(2, 3, 4, 5):
q2 := Quaternion(3, 4, 5, 6):
r := 7:
quats := Array([q, q1, q2]):
print("q, q1, q2"):
seq(quats[i], i = 1..3);
print("norms"):
seq(Norm(quats[i]), i = 1..3);
print("negative"):
seq(NegativeQuaternion(quats[i]), i = 1..3);
print("conjugate"):
seq(Conjugate(quats[i]), i = 1..3);
print("addition of real number 7"):
seq(quats[i] + r, i = 1..3);
print("multiplication by real number 7"):
seq(quats[i] . r, i = 1..3);
print("division by real number 7"):
seq(quats[i] / 7, i = 1..3);
print("add quaternions q1 and q2"):
q1 + q2;
print("multiply quaternions q1 and q2");
q1 . q2;
print("multiply quaternions q2 and q1"):
q2 . q1;
print("quaternion commutator of q1 and q2"):
QuaternionCommutator(q1,q2);
print("divide q1 by q2"):
q1 / q2;
</syntaxhighlight>
{{out}}<pre>
"q, q1, q2"
1 + 2i + 3j + 4k, 2 + 3i + 4j + 5k, 3 + 4i + 5j + 6k
"norms"
1/2 1/2 1/2
30 , 3 6 , 86
"negative"
-1 + -2i + -3j + -4k, -2 + -3i + -4j + -5k, -3 + -4i + -5j + -6k
"conjugate"
1 + -2i + -3j + -4k, 2 + -3i + -4j + -5k, 3 + -4i + -5j + -6k
"addition of real number 7"
8 + 2i + 3j + 4k, 9 + 3i + 4j + 5k, 10 + 4i + 5j + 6k
"multiplication by real number 7"
7 + 14i + 21j + 28k, 14 + 21i + 28j + 35k, 21 + 28i + 35j + 42k
"division by real number 7"
1/7 + 2/7i + 3/7j + 4/7k, 2/7 + 3/7i + 4/7j + 5/7k, 3/7 + 4/7i + 5/7j + 6/7k
"add quaternions q1 and q2"
5 + 7i + 9j + 11k
"multiply quaternions q1 and q2"
-56 + 16i + 24j + 26k
"multiply quaternions q2 and q1"
-56 + 18i + 20j + 28k
"quaternion commutator of q1 and q2"
0 + -2i + 4j + -2k
"divide q1 by q2"
34/43 + 1/43i + 0j + 2/43k
</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica"><<Quaternions`
q=Quaternion[1,2,3,4]
q1=Quaternion[2,3,4,5]
Line 2,603 ⟶ 5,507:
->7
->
-q
->Quaternion[-1,-2,-3,-4]
Conjugate[q]
->Quaternion[1,-2,-3,-4]
r+q
->Quaternion[8,2,3,4]
q+r
->Quaternion[8,2,3,4]
q1+q2
->Quaternion[5,7,9,11]
Line 2,619 ⟶ 5,527:
q2**q1
->Quaternion[-56,18,20,28]
</syntaxhighlight>
=={{header|
A possible implementation of quaternions in Mercury (the simplest representation) would look like this. Note that this is a full module implementation, complete with boilerplate, and that it works by giving an explicit conversion function for floats, converting a float into a quaternion representation of that float. Thus the float value <code>7.0</code> gets turned into the quaternion representation <code>q(7.0, 0.0, 0.0, 0.0)</code> through the function call <code>r(7.0)</code>.
<syntaxhighlight lang="mercury">:- module quaternion.
:- interface.
:- import_module float.
:- type quaternion
---> q( w :: float,
i :: float,
j :: float,
k :: float ).
% conversion
:- func r(float) = quaternion is det.
% operations
:- func norm(quaternion) = float is det.
:- func -quaternion = quaternion is det.
:- func conjugate(quaternion) = quaternion is det.
:- func quaternion + quaternion = quaternion is det.
:- func quaternion * quaternion = quaternion is det.
:- implementation.
:- import_module math.
% conversion
r(W) = q(W, 0.0, 0.0, 0.0).
% operations
norm(q(W, I, J, K)) = math.sqrt(W*W + I*I + J*J + K*K).
-q(W, I, J, K) = q(-W, -I, -J, -K).
conjugate(q(W, I, J, K)) = q(W, -I, -J, -K).
q(W0, I0, J0, K0) + q(W1, I1, J1, K1) = q(W0+W1, I0+I1, J0+J1, K0+K1).
q(W0, I0, J0, K0) * q(W1, I1, J1, K1) = q(W0*W1 - I0*I1 - J0*J1 - K0*K1,
W0*I1 + I0*W1 + J0*K1 - K0*J1,
W0*J1 - I0*K1 + J0*W1 + K0*I1,
W0*K1 + I0*J1 - J0*I1 + K0*W1 ).</syntaxhighlight>
The following test module puts the module through its paces.
<syntaxhighlight lang="mercury">:- module test_quaternion.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module quaternion.
:- import_module exception.
:- import_module float.
:- import_module list.
:- import_module string.
:- func to_string(quaternion) = string is det.
main(!IO) :-
Q = q(1.0, 2.0, 3.0, 4.0),
Q1 = q(2.0, 3.0, 4.0, 5.0),
Q2 = q(3.0, 4.0, 5.0, 6.0),
R = 7.0,
QR = r(R),
io.print("Q = ", !IO), io.print(to_string(Q), !IO), io.nl(!IO),
io.print("Q1 = ", !IO), io.print(to_string(Q1), !IO), io.nl(!IO),
io.print("Q2 = ", !IO), io.print(to_string(Q2), !IO), io.nl(!IO),
io.print("R = ", !IO), io.print(R, !IO), io.nl(!IO),
io.nl(!IO),
io.print("1. The norm of a quaternion.\n", !IO),
io.print("norm(Q) = ", !IO), io.print(norm(Q), !IO), io.nl(!IO),
io.nl(!IO),
io.print("2. The negative of a quaternion.\n", !IO),
io.print("-Q = ", !IO), io.print(to_string(-Q), !IO), io.nl(!IO),
io.nl(!IO),
io.print("3. The conjugate of a quaternion.\n", !IO),
io.print("conjugate(Q) = ", !IO), io.print(to_string(conjugate(Q)), !IO),
io.nl(!IO),
io.nl(!IO),
io.print("4. Addition of a real number and a quaternion.\n", !IO),
( Q + QR = QR + Q -> io.print("Addition is commutative.\n", !IO)
; io.print("Addition is not commutative.\n", !IO) ),
io.print("Q + R = ", !IO), io.print(to_string(Q + QR), !IO), io.nl(!IO),
io.print("R + Q = ", !IO), io.print(to_string(QR + Q), !IO), io.nl(!IO),
io.nl(!IO),
io.print("5. Addition of two quaternions.\n", !IO),
( Q1 + Q2 = Q2 + Q1 -> io.print("Addition is commutative.\n", !IO)
; io.print("Addition is not commutative.\n", !IO) ),
io.print("Q1 + Q2 = ", !IO), io.print(to_string(Q1 + Q2), !IO), io.nl(!IO),
io.print("Q2 + Q1 = ", !IO), io.print(to_string(Q2 + Q1), !IO), io.nl(!IO),
io.nl(!IO),
io.print("6. Multiplication of a real number and a quaternion.\n", !IO),
( Q * QR = QR * Q -> io.print("Multiplication is commutative.\n", !IO)
; io.print("Multiplication is not commutative.\n", !IO) ),
io.print("Q * R = ", !IO), io.print(to_string(Q * QR), !IO), io.nl(!IO),
io.print("R * Q = ", !IO), io.print(to_string(QR * Q), !IO), io.nl(!IO),
io.nl(!IO),
io.print("7. Multiplication of two quaternions.\n", !IO),
( Q1 * Q2 = Q2 * Q1 -> io.print("Multiplication is commutative.\n", !IO)
; io.print("Multiplication is not commutative.\n", !IO) ),
io.print("Q1 * Q2 = ", !IO), io.print(to_string(Q1 * Q2), !IO), io.nl(!IO),
io.print("Q2 * Q1 = ", !IO), io.print(to_string(Q2 * Q1), !IO), io.nl(!IO),
io.nl(!IO).
to_string(q(I, J, K, W)) = string.format("q(%f, %f, %f, %f)",
[f(I), f(J), f(K), f(W)]).
:- end_module test_quaternion.</syntaxhighlight>
The output of the above code follows:
% ./test_quaternion
Q = q(1.000000, 2.000000, 3.000000, 4.000000)
Q1 = q(2.000000, 3.000000, 4.000000, 5.000000)
Q2 = q(3.000000, 4.000000, 5.000000, 6.000000)
R = 7.0
1. The norm of a quaternion.
norm(Q) = 5.477225575051661
2. The negative of a quaternion.
-Q = q(-1.000000, -2.000000, -3.000000, -4.000000)
3. The conjugate of a quaternion.
conjugate(Q) = q(1.000000, -2.000000, -3.000000, -4.000000)
4. Addition of a real number and a quaternion.
Addition is commutative.
Q + R = q(8.000000, 2.000000, 3.000000, 4.000000)
R + Q = q(8.000000, 2.000000, 3.000000, 4.000000)
5. Addition of two quaternions.
Addition is commutative.
Q1 + Q2 = q(5.000000, 7.000000, 9.000000, 11.000000)
Q2 + Q1 = q(5.000000, 7.000000, 9.000000, 11.000000)
6. Multiplication of a real number and a quaternion.
Multiplication is commutative.
Q * R = q(7.000000, 14.000000, 21.000000, 28.000000)
R * Q = q(7.000000, 14.000000, 21.000000, 28.000000)
7. Multiplication of two quaternions.
Multiplication is not commutative.
Q1 * Q2 = q(-56.000000, 16.000000, 24.000000, 26.000000)
Q2 * Q1 = q(-56.000000, 18.000000, 20.000000, 28.000000)
=={{header|Nim}}==
For simplicity, we have limited the type of quaternion fields to floats (i.e. float64). An implementation could use a generic type in order to allow other field types such as float32.
<syntaxhighlight lang="nim">import math, tables
type Quaternion* = object
a, b, c, d: float
func initQuaternion*(a, b, c, d = 0.0): Quaternion =
Quaternion(a: a, b: b, c: c, d: d)
func `-`*(q: Quaternion): Quaternion =
initQuaternion(-q.a, -q.b, -q.c, -q.d)
func `+`*(q: Quaternion; r: float): Quaternion =
initQuaternion(q.a + r, q.b, q.c, q.d)
func `+`*(r: float; q: Quaternion): Quaternion =
initQuaternion(q.a + r, q.b, q.c, q.d)
func `+`*(q1, q2: Quaternion): Quaternion =
initQuaternion(q1.a + q2.a, q1.b + q2.b, q1.c + q2.c, q1.d + q2.d)
func `*`*(q: Quaternion; r: float): Quaternion =
initQuaternion(q.a * r, q.b * r, q.c * r, q.d * r)
func `*`*(r: float; q: Quaternion): Quaternion =
initQuaternion(q.a * r, q.b * r, q.c * r, q.d * r)
func `*`*(q1, q2: Quaternion): Quaternion =
initQuaternion(q1.a * q2.a - q1.b * q2.b - q1.c * q2.c - q1.d * q2.d,
q1.a * q2.b + q1.b * q2.a + q1.c * q2.d - q1.d * q2.c,
q1.a * q2.c - q1.b * q2.d + q1.c * q2.a + q1.d * q2.b,
q1.a * q2.d + q1.b * q2.c - q1.c * q2.b + q1.d * q2.a)
func conjugate*(q: Quaternion): Quaternion =
initQuaternion(q.a, -q.b, -q.c, -q.d)
func norm*(q: Quaternion): float =
sqrt(q.a * q.a + q.b * q.b + q.c * q.c + q.d * q.d)
func `==`*(q: Quaternion; r: float): bool =
if q.b != 0 or q.c != 0 or q.d != 0: false
else: q.a == r
func `$`(q: Quaternion): string =
## Return the representation of a quaternion.
const Letter = {"a": "", "b": "i", "c": "j", "d": "k"}.toTable
if q == 0: return "0"
for name, value in q.fieldPairs:
if value != 0:
var val = value
if result.len != 0:
result.add if value >= 0: '+' else: '-'
val = abs(val)
result.add $val & Letter[name]
when isMainModule:
let
q = initQuaternion(1, 2, 3, 4)
q1 = initQuaternion(2, 3, 4, 5)
q2 = initQuaternion(3, 4, 5, 6)
r = 7.0
echo "∥q∥ = ", norm(q)
echo "-q = ", -q
echo "q* = ", conjugate(q)
echo "q + r = ", q + r
echo "r + q = ", r + q
echo "q1 + q2 = ", q1 + q2
echo "qr = ", q * r
echo "rq = ", r * q
echo "q1 * q2 = ", q1 * q2
echo "q2 * q1 = ", q2 * q1</syntaxhighlight>
{{out}}
<pre>∥q∥ = 5.477225575051661
-q = -1.0-2.0i-3.0j-4.0k
q* = 1.0-2.0i-3.0j-4.0k
q + r = 8.0+2.0i+3.0j+4.0k
r + q = 8.0+2.0i+3.0j+4.0k
q1 + q2 = 5.0+7.0i+9.0j+11.0k
qr = 7.0+14.0i+21.0j+28.0k
rq = 7.0+14.0i+21.0j+28.0k
q1 * q2 = -56.0+16.0i+24.0j+26.0k
q2 * q1 = -56.0+18.0i+20.0j+28.0k</pre>
As can be seen, <code>q1 * q2 != q2 * q1</code>.
=={{header|OCaml}}==
This implementation was build strictly to the specs without looking (too much) at other implementations. The implementation as a record type with only floats is said (on the ocaml mailing list) to be especially efficient. Put this into a file quaternion.ml:
<syntaxhighlight lang="ocaml">
type quaternion = {a: float; b: float; c: float; d: float}
let norm q = sqrt (q.a**2.0 +.
q.b**2.0 +.
q.c**2.0 +.
q.d**2.0 )
let floatneg r = ~-. r (* readability *)
let negative q =
{a = floatneg q.a;
b = floatneg q.b;
c = floatneg q.c;
d = floatneg q.d }
let conjugate q =
{a = q.a;
b = floatneg q.b;
c = floatneg q.c;
d = floatneg q.d }
let addrq r q = {q with a = q.a +. r}
let addq q1 q2 =
{a = q1.a +. q2.a;
b = q1.b +. q2.b;
c = q1.c +. q2.c;
d = q1.d +. q2.d }
let multrq r q =
{a = q.a *. r;
b = q.b *. r;
c = q.c *. r;
d = q.d *. r }
let multq q1 q2 =
{a = q1.a*.q2.a -. q1.b*.q2.b -. q1.c*.q2.c -. q1.d*.q2.d;
b = q1.a*.q2.b +. q1.b*.q2.a +. q1.c*.q2.d -. q1.d*.q2.c;
c = q1.a*.q2.c -. q1.b*.q2.d +. q1.c*.q2.a +. q1.d*.q2.b;
d = q1.a*.q2.d +. q1.b*.q2.c -. q1.c*.q2.b +. q1.d*.q2.a }
let qmake a b c d = {a;b;c;d} (* readability omitting a= b=... *)
let qstring q =
Printf.sprintf "(%g, %g, %g, %g)" q.a q.b q.c q.d ;;
(* test data *)
let q = qmake 1.0 2.0 3.0 4.0
let q1 = qmake 2.0 3.0 4.0 5.0
let q2 = qmake 3.0 4.0 5.0 6.0
let r = 7.0
let () = (* written strictly to spec *)
let pf = Printf.printf in
pf "starting with data q=%s, q1=%s, q2=%s, r=%g\n" (qstring q) (qstring q1) (qstring q2) r;
pf "1. norm of q = %g \n" (norm q) ;
pf "2. negative of q = %s \n" (qstring (negative q));
pf "3. conjugate of q = %s \n" (qstring (conjugate q));
pf "4. adding r to q = %s \n" (qstring (addrq r q));
pf "5. adding q1 and q2 = %s \n" (qstring (addq q1 q2));
pf "6. multiply r and q = %s \n" (qstring (multrq r q));
pf "7. multiply q1 and q2 = %s \n" (qstring (multq q1 q2));
pf "8. instead q2 * q1 = %s \n" (qstring (multq q2 q1));
pf "\n";
</syntaxhighlight>
using this file on the command line will produce:
<pre>
$
starting with data q=(1, 2, 3, 4), q1=(2, 3, 4, 5), q2=(3, 4, 5, 6), r=7
1. norm of q = 5.47723
2. negative of q = (-1, -2, -3, -4)
3. conjugate of q = (1, -2, -3, -4)
4. adding r to q = (8, 2, 3, 4)
5. adding q1 and q2 = (5, 7, 9, 11)
6. multiply r and q = (7, 14, 21, 28)
7. multiply q1 and q2 = (-56, 16, 24, 26)
8. instead q2 * q1 = (-56, 18, 20, 28)
</pre>
For completeness, and since data types are of utmost importance in OCaml, here the types produced by pasting the code into the toplevel (''ocaml'' is the toplevel):
<syntaxhighlight lang="ocaml">
type quaternion = { a : float; b : float; c : float; d : float; }
val norm : quaternion -> float = <fun>
val floatneg : float -> float = <fun>
val negative : quaternion -> quaternion = <fun>
val conjugate : quaternion -> quaternion = <fun>
val addrq : float -> quaternion -> quaternion = <fun>
val addq : quaternion -> quaternion -> quaternion = <fun>
val multrq : float -> quaternion -> quaternion = <fun>
val multq : quaternion -> quaternion -> quaternion = <fun>
val qmake : float -> float -> float -> float -> quaternion = <fun>
val qstring : quaternion -> string = <fun>
</syntaxhighlight>
=={{header|Octave}}==
There is an add-on package (toolbox) to Octave available from http://octave.sourceforge.net/quaternion/
Such a package can be install with the command:
<syntaxhighlight lang="text">pkg install -forge quaternion</syntaxhighlight>
Here is a sample interactive session solving the task:
<syntaxhighlight lang="text">> q = quaternion (1, 2, 3, 4)
q = 1 + 2i + 3j + 4k
> q1 = quaternion (2, 3, 4, 5)
q1 = 2 + 3i + 4j + 5k
> q2 = quaternion (3, 4, 5, 6)
q2 = 3 + 4i + 5j + 6k
> r = 7
r = 7
> norm(q)
ans = 5.4772
> -q
ans = -1 - 2i - 3j - 4k
> conj(q)
ans = 1 - 2i - 3j - 4k
> q + r
ans = 8 + 2i + 3j + 4k
> q1 + q2
ans = 5 + 7i + 9j + 11k
> q * r
ans = 7 + 14i + 21j + 28k
> q1 * q2
ans = -56 + 16i + 24j + 26k
> q1 == q2
ans = 0</syntaxhighlight>
=={{header|Oforth}}==
Setting a priority (here 160) to Quaternion class and defining #asQuaternion, integers and floats can be fully mixed with quaternions.
neg is defined as "0 self -" into Number class, so no need to define it (if #- is defined).
<syntaxhighlight lang="oforth">160 Number Class newPriority: Quaternion(a, b, c, d)
Quaternion method: _a @a ;
Quaternion method: _b @b ;
Quaternion method: _c @c ;
Quaternion method: _d @d ;
Quaternion method: initialize := d := c := b := a ;
Quaternion method: << '(' <<c @a << ',' <<c @b << ',' <<c @c << ',' <<c @d << ')' <<c ;
Integer method: asQuaternion self 0 0 0 Quaternion new ;
Float method: asQuaternion self 0 0 0 Quaternion new ;
Quaternion method: ==(q) q _a @a == q _b @b == and q _c @c == and q _d @d == and ;
Quaternion method: norm @a sq @b sq + @c sq + @d sq + sqrt ;
Quaternion method: conj @a @b neg @c neg @d neg Quaternion new ;
Quaternion method: +(q) Quaternion new(q _a @a +, q _b @b +, q _c @c +, q _d @d +) ;
Quaternion method: -(q) Quaternion new(q _a @a -, q _b @b -, q _c @c -, q _d @d -) ;
Quaternion method: *(q)
Quaternion new(q _a @a * q _b @b * - q _c @c * - q _d @d * -,
q _a @b * q _b @a * + q _c @d * + q _d @c * -,
q _a @c * q _b @d * - q _c @a * + q _d @b * +,
q _a @d * q _b @c * + q _c @b * - q _d @a * + ) ;</syntaxhighlight>
Usage :
<syntaxhighlight lang="oforth">: test
| q q1 q2 r |
Quaternion new(1, 2, 3, 4) ->q
Quaternion new(2, 3, 4, 5) ->q1
Quaternion new(3, 4, 5, 6) ->q2
7.0 -> r
System.Out "q = " << q << cr
System.Out "q1 = " << q1 << cr
System.Out "q2 = " << q2 << cr
System.Out "norm q = " << q norm << cr
System.Out "neg q = " << q neg << cr
System.Out "conj q = " << q conj << cr
System.Out "q +r = " << q r + << cr
System.Out "q1 + q2 = " << q1 q2 + << cr
System.Out "q * r = " << q r * << cr
System.Out "q1 * q2 = " << q1 q2 * << cr
q1 q2 * q2 q1 * == ifFalse: [ "q1q2 and q2q1 are different quaternions" println ] ;</syntaxhighlight>
{{out}}
<pre>
q = (1,2,3,4)
q1 = (2,3,4,5)
q2 = (3,4,5,6)
norm q = 5.47722557505166
neg q = (-1,-2,-3,-4)
conj q = (1,-2,-3,-4)
q +r = (8,2,3,4)
q1 + q2 = (5,7,9,11)
q * r = (7,14,21,28)
q1 * q2 = (-56,16,24,26)
q1q2 and q2q1 are different quaternions
</pre>
=={{header|Ol}}==
See also [[#Scheme|the entry for Scheme]].
<syntaxhighlight lang="scheme">
;;
;; This program is written to run without modification both in Otus
;; Lisp and in any of many Scheme dialects. I assume the presence of
;; "case-lambda", but not of "let-values". The program has worked
;; (without modification) in Otus Lisp 2.4, Guile >= 2.0 (but not in
;; Guile version 1.8), CHICKEN Scheme 5.3.0, Chez Scheme 9.5.8, Gauche
;; Scheme 0.9.12, Ypsilon 0.9.6-update3.
;;
;; Here a quaternion is represented as a linked list of four real
;; numbers. Such a representation probably has the greatest
;; portability between Scheme dialects. However, this representation
;; can be replaced, simply by redefining the procedures "quaternion?",
;; "quaternion-components", "quaternion->list", and "quaternion".
;;
(define (quaternion? q) ; Can q be used as a quaternion?
(and (pair? q)
(let ((a (car q))
(q (cdr q)))
(and (real? a) (pair? q)
(let ((b (car q))
(q (cdr q)))
(and (real? b) (pair? q)
(let ((c (car q))
(q (cdr q)))
(and (real? c) (pair? q)
(let ((d (car q))
(q (cdr q)))
(and (real? d) (null? q)))))))))))
(define (quaternion-components q) ; Extract the basis components.
(let ((a (car q))
(q (cdr q)))
(let ((b (car q))
(q (cdr q)))
(let ((c (car q))
(q (cdr q)))
(let ((d (car q)))
(values a b c d))))))
(define (quaternion->list q) ; Get a list of the basis components.
q)
(define quaternion ; Make a quaternion.
(case-lambda
((a b c d)
;; Make the quaternion from basis components.
(list a b c d))
((q)
;; Make the quaternion from a scalar or from another quaternion.
;; WARNING: in the latter case, the quaternion is NOT
;; copied. This is not a problem, if you avoid things like
;; "set-car!" and "set-cdr!".
(if (real? q)
(list q 0 0 0)
q))))
(define (quaternion-norm q) ; The euclidean norm of a quaternion.
(let ((q (quaternion q)))
(call-with-values (lambda () (quaternion-components q))
(lambda (a b c d)
(sqrt (+ (* a a) (* b b) (* c c) (* d d)))))))
(define (quaternion-conjugate q) ; Conjugate a quaternion.
(let ((q (quaternion q)))
(call-with-values (lambda () (quaternion-components q))
(lambda (a b c d)
(quaternion a (- b) (- c) (- d))))))
(define quaternion+ ; Add quaternions.
(let ((quaternion-add
(lambda (q1 q2)
(let ((q1 (quaternion q1))
(q2 (quaternion q2)))
(call-with-values
(lambda () (quaternion-components q1))
(lambda (a1 b1 c1 d1)
(call-with-values
(lambda () (quaternion-components q2))
(lambda (a2 b2 c2 d2)
(quaternion (+ a1 a2) (+ b1 b2)
(+ c1 c2) (+ d1 d2))))))))))
(case-lambda
(() (quaternion 0))
((q . q*)
(let loop ((accum q)
(q* q*))
(if (pair? q*)
(loop (quaternion-add accum (car q*)) (cdr q*))
accum))))))
(define quaternion- ; Negate or subtract quaternions.
(let ((quaternion-sub
(lambda (q1 q2)
(let ((q1 (quaternion q1))
(q2 (quaternion q2)))
(call-with-values
(lambda () (quaternion-components q1))
(lambda (a1 b1 c1 d1)
(call-with-values
(lambda () (quaternion-components q2))
(lambda (a2 b2 c2 d2)
(quaternion (- a1 a2) (- b1 b2)
(- c1 c2) (- d1 d2))))))))))
(case-lambda
((q)
(let ((q (quaternion q)))
(call-with-values (lambda () (quaternion-components q))
(lambda (a b c d)
(quaternion (- a) (- b) (- c) (- d))))))
((q . q*)
(let loop ((accum q)
(q* q*))
(if (pair? q*)
(loop (quaternion-sub accum (car q*)) (cdr q*))
accum))))))
(define quaternion* ; Multiply quaternions.
(let ((quaternion-mul
(lambda (q1 q2)
(let ((q1 (quaternion q1))
(q2 (quaternion q2)))
(call-with-values
(lambda () (quaternion-components q1))
(lambda (a1 b1 c1 d1)
(call-with-values
(lambda () (quaternion-components q2))
(lambda (a2 b2 c2 d2)
(quaternion (- (* a1 a2) (* b1 b2)
(* c1 c2) (* d1 d2))
(- (+ (* a1 b2) (* b1 a2) (* c1 d2))
(* d1 c2))
(- (+ (* a1 c2) (* c1 a2) (* d1 b2))
(* b1 d2))
(- (+ (* a1 d2) (* b1 c2) (* d1 a2))
(* c1 b2)))))))))))
(case-lambda
(() (quaternion 1))
((q . q*)
(let loop ((accum q)
(q* q*))
(if (pair? q*)
(loop (quaternion-mul accum (car q*)) (cdr q*))
accum))))))
(define quaternion=? ; Are the quaternions equal?
(let ((=? (lambda (q1 q2)
(let ((q1 (quaternion q1))
(q2 (quaternion q2)))
(call-with-values
(lambda () (quaternion-components q1))
(lambda (a1 b1 c1 d1)
(call-with-values
(lambda () (quaternion-components q2))
(lambda (a2 b2 c2 d2)
(and (= a1 a2) (= b1 b2)
(= c1 c2) (= d1 d2))))))))))
(lambda (q . q*)
(let loop ((q* q*))
(if (pair? q*)
(and (=? q (car q*))
(loop (cdr q*)))
#t)))))
(define q (quaternion 1 2 3 4))
(define q1 (quaternion 2 3 4 5))
(define q2 (quaternion 3 4 5 6))
(define r 7)
(display "q = ") (display (quaternion->list q)) (newline)
(display "q1 = ") (display (quaternion->list q1)) (newline)
(display "q2 = ") (display (quaternion->list q2)) (newline)
(display "r = ") (display r) (newline)
(newline)
(display "(quaternion? q) = ") (display (quaternion? q)) (newline)
(display "(quaternion? q1) = ") (display (quaternion? q1)) (newline)
(display "(quaternion? q2) = ") (display (quaternion? q2)) (newline)
(display "(quaternion? r) = ") (display (quaternion? r)) (newline)
(newline)
(display "(quaternion-norm q) = ")
(display (quaternion-norm q)) (newline)
(display "(quaternion-norm q1) = ")
(display (quaternion-norm q1)) (newline)
(display "(quaternion-norm q2) = ")
(display (quaternion-norm q2)) (newline)
(newline)
(display "(quaternion- q) = ")
(display (quaternion->list (quaternion- q))) (newline)
(display "(quaternion- q1 q2) = ")
(display (quaternion->list (quaternion- q1 q2))) (newline)
(display "(quaternion- q q1 q2) = ")
(display (quaternion->list (quaternion- q q1 q2))) (newline)
(newline)
(display "(quaternion-conjugate q) = ")
(display (quaternion->list (quaternion-conjugate q))) (newline)
(newline)
(display "(quaternion+) = ")
(display (quaternion->list (quaternion+))) (newline)
(display "(quaternion+ q) = ")
(display (quaternion->list (quaternion+ q))) (newline)
(display "(quaternion+ r q) = ")
(display (quaternion->list (quaternion+ r q))) (newline)
(display "(quaternion+ q r) = ")
(display (quaternion->list (quaternion+ q r))) (newline)
(display "(quaternion+ q1 q2) = ")
(display (quaternion->list (quaternion+ q1 q2))) (newline)
(display "(quaternion+ q q1 q2) = ")
(display (quaternion->list (quaternion+ q q1 q2))) (newline)
(newline)
(display "(quaternion*) = ")
(display (quaternion->list (quaternion*))) (newline)
(display "(quaternion* q) = ")
(display (quaternion->list (quaternion* q))) (newline)
(display "(quaternion* r q) = ")
(display (quaternion->list (quaternion* r q))) (newline)
(display "(quaternion* q r) = ")
(display (quaternion->list (quaternion* q r))) (newline)
(display "(quaternion* q1 q2) = ")
(display (quaternion->list (quaternion* q1 q2))) (newline)
(display "(quaternion* q q1 q2) = ")
(display (quaternion->list (quaternion* q q1 q2))) (newline)
(newline)
(display "(quaternion=? q) = ")
(display (quaternion=? q)) (newline)
(display "(quaternion=? q q) = ")
(display (quaternion=? q q)) (newline)
(display "(quaternion=? q1 q2) = ")
(display (quaternion=? q1 q2)) (newline)
(display "(quaternion=? q q q) = ")
(display (quaternion=? q q q)) (newline)
(display "(quaternion=? q1 q1 q2) = ")
(display (quaternion=? q1 q1 q2)) (newline)
(newline)
(display "(quaternion* q1 q2) = ")
(display (quaternion->list (quaternion* q1 q2))) (newline)
(display "(quaternion* q2 q1) = ")
(display (quaternion->list (quaternion* q2 q1))) (newline)
(display "(quaternion=? (quaternion* q1 q2)") (newline)
(display " (quaternion* q2 q1)) = ")
(display (quaternion=? (quaternion* q1 q2)
(quaternion* q2 q1))) (newline)
</syntaxhighlight>
{{out}}
<pre>$ ol quaternions_task.scm
q = (1 2 3 4)
q1 = (2 3 4 5)
q2 = (3 4 5 6)
r = 7
(quaternion? q) = #true
(quaternion? q1) = #true
(quaternion? q2) = #true
(quaternion? r) = #false
(quaternion-norm q) = 116161/21208
(quaternion-norm q1) = 898285873/122241224
(quaternion-norm q2) = 6216793393/670374072
(quaternion- q) = (-1 -2 -3 -4)
(quaternion- q1 q2) = (-1 -1 -1 -1)
(quaternion- q q1 q2) = (-4 -5 -6 -7)
(quaternion-conjugate q) = (1 -2 -3 -4)
(quaternion+) = (0 0 0 0)
(quaternion+ q) = (1 2 3 4)
(quaternion+ r q) = (8 2 3 4)
(quaternion+ q r) = (8 2 3 4)
(quaternion+ q1 q2) = (5 7 9 11)
(quaternion+ q q1 q2) = (6 9 12 15)
(quaternion*) = (1 0 0 0)
(quaternion* q) = (1 2 3 4)
(quaternion* r q) = (7 14 21 28)
(quaternion* q r) = (7 14 21 28)
(quaternion* q1 q2) = (-56 16 24 26)
(quaternion* q q1 q2) = (-264 -114 -132 -198)
(quaternion=? q) = #true
(quaternion=? q q) = #true
(quaternion=? q1 q2) = #false
(quaternion=? q q q) = #true
(quaternion=? q1 q1 q2) = #false
(quaternion* q1 q2) = (-56 16 24 26)
(quaternion* q2 q1) = (-56 18 20 28)
(quaternion=? (quaternion* q1 q2)
(quaternion* q2 q1)) = #false</pre>
=={{header|ooRexx}}==
Note, this example uses operator overloads to perform the math operation. The operator overloads only work if the left-hand-side of the operation is a quaterion instance. Thus something like "7 + q1" would not work because this would get passed to the "+" of the string class. For those situations, the best solution would be an addition method on the .Quaternion class itself that took the appropriate action. I've chosen not to implement those to keep the example shorter.
<syntaxhighlight lang="oorexx">
q = .quaternion~new(1, 2, 3, 4)
q1 = .quaternion~new(2, 3, 4, 5)
Line 2,864 ⟶ 6,427:
::requires rxmath LIBRARY
</syntaxhighlight>
{{out}}
<pre>
q = 1 + 2i + 3j + 4k
Line 2,886 ⟶ 6,449:
{{works with|PARI/GP|version 2.4.2 and above}}<!-- Needs closures -->
Here is a simple solution in GP. I think it's possible to implement this type directly in Pari by abusing t_COMPLEX, but I haven't attempted this.
<
if(type(q) != "t_VEC" || #q != 4, error("incorrect type"));
sqrt(q[1]^2+q[2]^2+q[3]^2+q[4]^2)
Line 2,920 ⟶ 6,483:
)
)
};</
Usage:
<
q.norm
-q
Line 2,931 ⟶ 6,494:
q.mult(r) \\ or r*q or q*r
q1.mult(q2)
q1.mult(q2) != q2.mult(q1)</
=={{header|Pascal}}==
Line 2,937 ⟶ 6,500:
=={{header|Perl}}==
<
use List::Util 'reduce';
use List::MoreUtils 'pairwise';
Line 3,006 ⟶ 6,569:
print "a conjugate is ", $a->conjugate, "\n";
print "a * b = ", $a * $b, "\n";
print "b * a = ", $b * $a, "\n";</
=={{header|
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">norm</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">q</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sq_power</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)))</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">conjugate</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">q</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">q</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">q</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..</span><span style="color: #000000;">4</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sq_uminus</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..</span><span style="color: #000000;">4</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">q</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">negative</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">q</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sq_uminus</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">add</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">q1</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">q2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">atom</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">)!=</span><span style="color: #004080;">atom</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">atom</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">q1</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">q2</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sq_add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">mul</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">q1</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">q2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">and</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">atom</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">r1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k1</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">q1</span><span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">r2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k2</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">q2</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">r1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">r2</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">i1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">i2</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">j1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">j2</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">k1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">k2</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">r1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">i2</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">i1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">r2</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">j1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">k2</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">k1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">j2</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">r1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">j2</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">i1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">k2</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">j1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">r2</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">k1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">i2</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">r1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">k2</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">i1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">j2</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">j1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">i2</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">k1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">r2</span> <span style="color: #0000FF;">}</span>
<span style="color: #008080;">else</span>
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sq_mul</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">q</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%g%+gi%+gj%+gk"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">constant</span>
<span style="color: #000000;">q</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">},</span>
<span style="color: #000000;">q1</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">5</span><span style="color: #0000FF;">},</span>
<span style="color: #000000;">q2</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">6</span><span style="color: #0000FF;">}</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">" q = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">)})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">" q1 = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">)})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">" q2 = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">)})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1. norm(q) = %g\n"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">norm</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">))</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"2. negative(q) = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">negative</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"3. conjugate(q) = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">conjugate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"4.a q + 7 = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">,</span><span style="color: #000000;">7</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">" .b 7 + q = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">7</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"5.a q1 + q2 = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">" .b q2 + q1 = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"6.a q * 49 = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mul</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">,</span><span style="color: #000000;">49</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">" .b 49 * q = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mul</span><span style="color: #0000FF;">(</span><span style="color: #000000;">49</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"7.a q1 * q2 = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mul</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">" .b q2 * q1 = %s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">quats</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mul</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"8.a 4.a === 4.b: %t\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #7060A8;">equal</span><span style="color: #0000FF;">(</span><span style="color: #000000;">add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">,</span><span style="color: #000000;">7</span><span style="color: #0000FF;">),</span><span style="color: #000000;">add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">7</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">" .b 5.a === 5.b: %t\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #7060A8;">equal</span><span style="color: #0000FF;">(</span><span style="color: #000000;">add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">),</span><span style="color: #000000;">add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">" .c 6.a === 6.b: %t\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #7060A8;">equal</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mul</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">,</span><span style="color: #000000;">49</span><span style="color: #0000FF;">),</span><span style="color: #000000;">mul</span><span style="color: #0000FF;">(</span><span style="color: #000000;">49</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q</span><span style="color: #0000FF;">))})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">" .d 7.a === 7.b: %t\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #7060A8;">equal</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mul</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">),</span><span style="color: #000000;">mul</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q1</span><span style="color: #0000FF;">))})</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
q = 1+2i+3j+4k
q1 = 2+3i+4j+5k
q2 = 3+4i+5j+6k
1. norm(q) = 5.47723
2. negative(q) = -1-2i-3j-4k
3. conjugate(q) = 1-2i-3j-4k
4.a q + 7 = 8+2i+3j+4k
.b 7 + q = 8+2i+3j+4k
5.a q1 + q2 = 5+7i+9j+11k
.b q2 + q1 = 5+7i+9j+11k
6.a q * 49 = 49+98i+147j+196k
.b 49 * q = 49+98i+147j+196k
7.a q1 * q2 = -56+16i+24j+26k
.b q2 * q1 = -56+18i+20j+28k
8.a 4.a === 4.b: true
.b 5.a === 5.b: true
.c 6.a === 6.b: true
.d 7.a === 7.b: false
</pre>
=={{header|Picat}}==
{{trans|Prolog}}
A quaternion is represented as a complex term <code>qx/4</code>.
<syntaxhighlight lang="picat">go =>
test,
nl.
add(qx(R0,I0,J0,K0), qx(R1,I1,J1,K1), qx(R,I,J,K)) :-
!, R is R0+R1, I is I0+I1, J is J0+J1, K is K0+K1.
add(qx(R0,I,J,K), F, qx(R,I,J,K)) :-
number(F), !, R is R0 + F.
add(F, qx(R0,I,J,K), Qx) :-
add($qx(R0,I,J,K), F, Qx).
mul(qx(R0,I0,J0,K0), qx(R1,I1,J1,K1), qx(R,I,J,K)) :- !,
R is R0*R1 - I0*I1 - J0*J1 - K0*K1,
I is R0*I1 + I0*R1 + J0*K1 - K0*J1,
J is R0*J1 - I0*K1 + J0*R1 + K0*I1,
K is R0*K1 + I0*J1 - J0*I1 + K0*R1.
mul(qx(R0,I0,J0,K0), F, qx(R,I,J,K)) :-
number(F), !, R is R0*F, I is I0*F, J is J0*F, K is K0*F.
mul(F, qx(R0,I0,J0,K0), Qx) :-
mul($qx(R0,I0,J0,K0),F,Qx).
abs(qx(R,I,J,K), Norm) :-
Norm is sqrt(R*R+I*I+J*J+K*K).
negate(qx(Ri,Ii,Ji,Ki),qx(R,I,J,K)) :-
R is -Ri, I is -Ii, J is -Ji, K is -Ki.
conjugate(qx(R,Ii,Ji,Ki),qx(R,I,J,K)) :-
I is -Ii, J is -Ji, K is -Ki.
data(q, qx(1,2,3,4)).
data(q1, qx(2,3,4,5)).
data(q2, qx(3,4,5,6)).
data(r, 7).
test :- data(Name, $qx(A,B,C,D)), abs($qx(A,B,C,D), Norm),
printf("abs(%w) is %w\n", Name, Norm), fail.
test :- data(q, Qx), negate(Qx, Nqx),
printf("negate(%w) is %w\n", q, Nqx), fail.
test :- data(q, Qx), conjugate(Qx, Nqx),
printf("conjugate(%w) is %w\n", q, Nqx), fail.
test :- data(q1, Q1), data(q2, Q2), add(Q1, Q2, Qx),
printf("q1+q2 is %w\n", Qx), fail.
test :- data(q1, Q1), data(q2, Q2), add(Q2, Q1, Qx),
printf("q2+q1 is %w\n", Qx), fail.
test :- data(q, Qx), data(r, R), mul(Qx, R, Nqx),
printf("q*r is %w\n", Nqx), fail.
test :- data(q, Qx), data(r, R), mul(R, Qx, Nqx),
printf("r*q is %w\n", Nqx), fail.
test :- data(q1, Q1), data(q2, Q2), mul(Q1, Q2, Qx),
printf("q1*q2 is %w\n", Qx), fail.
test :- data(q1, Q1), data(q2, Q2), mul(Q2, Q1, Qx),
printf("q2*q1 is %w\n", Qx), fail.
test.</syntaxhighlight>
{{out}}
<pre>abs(q) is 5.477225575051661
abs(q1) is 7.348469228349535
abs(q2) is 9.273618495495704
negate(q) is qx(-1,-2,-3,-4)
conjugate(q) is qx(1,-2,-3,-4)
q1+q2 is qx(5,7,9,11)
q2+q1 is qx(5,7,9,11)
q*r is qx(7,14,21,28)
r*q is qx(7,14,21,28)
q1*q2 is qx(-56,16,24,26)
q2*q1 is qx(-56,18,20,28)</pre>
=={{header|PicoLisp}}==
<
(def 'quatCopy copy)
Line 3,098 ⟶ 6,774:
(mapcar '((R S) (pack (format R *Scl) S))
Q
'(" + " "i + " "j + " "k") ) )</
Test:
<
Q (1.0 2.0 3.0 4.0)
Q1 (2.0 3.0 4.0 5.0)
Line 3,121 ⟶ 6,797:
(prinl "Q1 * Q2 = " (quatFmt (quatMul Q1 Q2)))
(prinl "Q2 * Q1 = " (quatFmt (quatMul Q2 Q1)))
(prinl (if (= (quatMul Q1 Q2) (quatMul Q2 Q1)) "Equal" "Not equal"))</
{{out}}
<pre>R = 7.000000
Q = 1.000000 + 2.000000i + 3.000000j + 4.000000k
Line 3,139 ⟶ 6,815:
Q2 * Q1 = -56.000000 + 18.000000i + 20.000000j + 28.000000k
Not equal</pre>
=={{header|PL/I}}==
<syntaxhighlight lang="pli">*process source attributes xref or(!);
qu: Proc Options(main);
/**********************************************************************
* 06.09.2013 Walter Pachl translated from REXX
* added tasks 9 and A
**********************************************************************/
dcl v(4) Char(1) Var Init('','i','j','k');
define structure 1 quat, 2 x(4) Dec Float(15);
Dcl q type quat; Call quat_init(q, 1,2,3,4);
Dcl q1 type quat; Call quat_init(q1,2,3,4,5);
Dcl q2 type quat; Call quat_init(q2,3,4,5,6);
Dcl q3 type quat; Call quat_init(q3,-2,3,-4,-5);
Dcl r Dec Float(15)Init(7);
call showq(' ','q' ,q);
call showq(' ','q1' ,q1);
call showq(' ','q2' ,q2);
call showq(' ','q3' ,q3);
call shows(' ','r' ,r);
Call shows('task 1:','norm q' ,norm(q));
Call showq('task 2:','quatneg q' ,quatneg(q));
Call showq('task 3:','conjugate q' ,quatConj(q));
Call showq('task 4:','addition r+q' ,quatAddsq(r,q));
Call showq('task 5:','addition q1+q2' ,quatAdd(q1,q2));
Call showq('task 6:','multiplication q*r' ,quatMulqs(q,r));
Call showq('task 7:','multiplication q1*q2' ,quatMul(q1,q2));
Call showq('task 8:','multiplication q2*q1' ,quatMul(q2,q1));
Call showq('task 9:','quatsub q1-q1' ,quatAdd(q1,quatneg(q1)));
Call showq('task A:','addition q1+q3' ,quatAdd(q1,q3));
Call showt('task B:','equal' ,quatEqual(quatMul(q1,q2),
quatMul(q2,q1)));
Call showt('task C:','q1=q1' ,quatEqual(q1,q1));
quatNeg: procedure(qp) Returns(type quat);
Dcl (qp,qr) type quat;
qr.x(*)=-qp.x(*);
Return (qr);
End;
quatAdd: procedure(qp,qq) Returns(type quat);
Dcl (qp,qq,qr) type quat;
qr.x(*)=qp.x(*)+qq.x(*);
Return (qr);
End;
quatAddsq: procedure(v,qp) Returns(type quat);
Dcl v Dec Float(15);
Dcl (qp,qr) type quat;
qr.x(*)=qp.x(*);
qr.x(1)=qp.x(1)+v;
Return (qr);
End;
quatConj: procedure(qp) Returns(type quat);
Dcl (qp,qr) type quat;
qr.x(*)=-qp.x(*);
qr.x(1)= qp.x(1);
Return (qr);
End;
quatMul: procedure(qp,qq) Returns(type quat);
Dcl (qp,qq,qr) type quat;
qr.x(1)=
qp.x(1)*qq.x(1)-qp.x(2)*qq.x(2)-qp.x(3)*qq.x(3)-qp.x(4)*qq.x(4);
qr.x(2)=
qp.x(1)*qq.x(2)+qp.x(2)*qq.x(1)+qp.x(3)*qq.x(4)-qp.x(4)*qq.x(3);
qr.x(3)=
qp.x(1)*qq.x(3)-qp.x(2)*qq.x(4)+qp.x(3)*qq.x(1)+qp.x(4)*qq.x(2);
qr.x(4)=
qp.x(1)*qq.x(4)+qp.x(2)*qq.x(3)-qp.x(3)*qq.x(2)+qp.x(4)*qq.x(1);
Return (qr);
End;
quatMulqs: procedure(qp,v) Returns(type quat);
Dcl (qp,qr) type quat;
Dcl v Dec Float(15);
qr.x(*)=qp.x(*)*v;
Return (qr);
End;
shows: Procedure(t1,t2,v);
Dcl (t1,t2) Char(*);
Dcl v Dec Float(15);
Put Edit(t1,right(t2,24),' --> ',v)(Skip,a,a,a,f(15,13));
End;
showt: Procedure(t1,t2,v);
Dcl (t1,t2) Char(*);
Dcl v Char(*) Var);
Put Edit(t1,right(t2,24),' --> ',v)(Skip,a,a,a,a);
End;
showq: Procedure(t1,t2,qp);
Dcl qp type quat;
Dcl (t1,t2) Char(*);
Dcl (s,s2,p) Char(100) Var Init('');
Dcl i Bin Fixed(31);
Put String(s) Edit(t1,right(t2,24),' --> ')(a,a,a);
Do i=1 To 4;
Put String(p) Edit(abs(qp.x(i)))(p'ZZZ9');
p=trim(p);
Select;
When(qp.x(i)<0) p='-'!!p!!v(i);
When(p=0) p='';
Otherwise Do
If s2^='' Then p='+'!!p;
If i>1 Then p=p!!v(i);
End;
End;
s2=s2!!p
End;
If s2='' Then
s2='0';
Put Edit(s!!s2)(Skip,a);
End;
norm: Procedure(qp) Returns(Dec Float(15));
Dcl qp type quat;
Dcl r Dec Float(15) Init(0);
Dcl i Bin Fixed(31);
Do i=1 To 4;
r=r+qp.x(i)**2;
End;
Return (sqrt(r));
End;
quat_init: Proc(qp,x,y,z,u);
Dcl qp type quat;
Dcl (x,y,z,u) Dec Float(15);
qp.x(1)=x;
qp.x(2)=y;
qp.x(3)=z;
qp.x(4)=u;
End;
quatEqual: procedure(qp,qq) Returns(Char(12) Var);
Dcl (qp,qq) type quat;
Dcl i Bin Fixed(15);
Do i=1 To 4;
If qp.x(i)^=qq.x(i) Then
Return('not equal');
End;
Return('equal');
End;
End;</syntaxhighlight>
{{out}}
<pre>
q --> 1+2i+3j+4k
q1 --> 2+3i+4j+5k
q2 --> 3+4i+5j+6k
q3 --> -2+3i-4j-5k
r --> 7.0000000000000
task 1: norm q --> 5.4772255750517
task 2: quatneg q --> -1-2i-3j-4k
task 3: conjugate q --> 1-2i-3j-4k
task 4: addition r+q --> 8+2i+3j+4k
task 5: addition q1+q2 --> 5+7i+9j+11k
task 6: multiplication q*r --> 7+14i+21j+28k
task 7: multiplication q1*q2 --> -56+16i+24j+26k
task 8: multiplication q2*q1 --> -56+18i+20j+28k
task 9: quatsub q1-q1 --> 0
task A: addition q1+q3 --> 6i
task B: equal --> not equal
task C: q1=q1 --> equal
</pre>
=={{header|PowerShell}}==
===Implementation===
<syntaxhighlight lang="powershell">
class Quaternion {
[Double]$w
[Double]$x
[Double]$y
[Double]$z
Quaternion() {
$this.w = 0
$this.x = 0
$this.y = 0
$this.z = 0
}
Quaternion([Double]$a, [Double]$b, [Double]$c, [Double]$d) {
$this.w = $a
$this.x = $b
$this.y = $c
$this.z = $d
}
[Double]abs2() {return $this.w*$this.w + $this.x*$this.x + $this.y*$this.y + $this.z*$this.z}
[Double]abs() {return [math]::sqrt($this.wbs2())}
static [Quaternion]real([Double]$r) {return [Quaternion]::new($r, 0, 0, 0)}
static [Quaternion]add([Quaternion]$m,[Quaternion]$n) {return [Quaternion]::new($m.w+$n.w, $m.x+$n.x, $m.y+$n.y, $m.z+$n.z)}
[Quaternion]addreal([Double]$r) {return [Quaternion]::add($this,[Quaternion]::real($r))}
static [Quaternion]mul([Quaternion]$m,[Quaternion]$n) {
return [Quaternion]::new(
($m.w*$n.w) - ($m.x*$n.x) - ($m.y*$n.y) - ($m.z*$n.z),
($m.w*$n.x) + ($m.x*$n.w) + ($m.y*$n.z) - ($m.z*$n.y),
($m.w*$n.y) - ($m.x*$n.z) + ($m.y*$n.w) + ($m.z*$n.x),
($m.w*$n.z) + ($m.x*$n.y) - ($m.y*$n.x) + ($m.z*$n.w))
}
[Quaternion]mul([Double]$r) {return [Quaternion]::new($r*$this.w, $r*$this.x, $r*$this.y, $r*$this.z)}
[Quaternion]negate() {return $this.mul(-1)}
[Quaternion]conjugate() {return [Quaternion]::new($this.w, -$this.x, -$this.y, -$this.z)}
static [String]st([Double]$r) {
if(0 -le $r) {return "+$r"} else {return "$r"}
}
[String]show() {return "$($this.w)$([Quaternion]::st($this.x))i$([Quaternion]::st($this.y))j$([Quaternion]::st($this.z))k"}
static [String]show([Quaternion]$other) {return $other.show()}
}
$q = [Quaternion]::new(1, 2, 3, 4)
$q1 = [Quaternion]::new(2, 3, 4, 5)
$q2 = [Quaternion]::new(3, 4, 5, 6)
$r = 7
"`$q: $($q.show())"
"`$q1: $($q1.show())"
"`$q2: $($q2.show())"
"`$r: $r"
""
"norm `$q: $($q.wbs())"
"negate `$q: $($q.negate().show())"
"conjugate `$q: $($q.yonjugate().show())"
"`$q + `$r: $($q.wddreal($r).show())"
"`$q1 + `$q2: $([Quaternion]::show([Quaternion]::add($q1,$q2)))"
"`$q * `$r: $($q.mul($r).show())"
"`$q1 * `$q2: $([Quaternion]::show([Quaternion]::mul($q1,$q2)))"
"`$q2 * `$q1: $([Quaternion]::show([Quaternion]::mul($q2,$q1)))"
</syntaxhighlight>
<b>Output:</b>
<pre>
norm $q: 5.47722557505166
negate $q: -1-2i-3j-4k
conjugate $q: 1-2i-3j-4k
$q + $r: 8+2i+3j+4k
$q1 + $q2: 5+7i+9j+11k
$q * $r: 7+14i+21j+28k
$q1 * $q2: -56+16i+24j+26k
$q2 * $q1: -56+18i+20j+28k
</pre>
===Library===
<syntaxhighlight lang="powershell">
function show([System.Numerics.Quaternion]$c) {
function st([Double]$r) {
if(0 -le $r) {return "+$r"} else {return "$r"}
}
return "$($c.w)$(st $c.y)i$(st $c.y)j$(st $c.z)k"
}
$q = [System.Numerics.Quaternion]::new(1, 2, 3, 4)
$q1 = [System.Numerics.Quaternion]::new(2, 3, 4, 5)
$q2 = [System.Numerics.Quaternion]::new(3, 4, 5, 6)
$r = 7
"`$q: $(show $q)"
"`$q1: $(show $q1)"
"`$q2: $(show $q2)"
"`$r: $r"
"norm `$q: $($q.Length())"
"negate `$q: $(show ([System.Numerics.Quaternion]::Negate($q)))"
"conjugate `$q: $(show ([System.Numerics.Quaternion]::Conjugate($q)))"
"`$q + `$r: $(show ([System.Numerics.Quaternion]::new($q.w + $r, $q.x, $q.y, $q.z)))"
"`$q1 + `$q2: $(show ([System.Numerics.Quaternion]::Add($q1,$q2)))"
"`$q * `$r: $(show ([System.Numerics.Quaternion]::new($q.w * $r, $q.x * $r, $q.y * $r, $q.z * $r)))"
"`$q1 * `$q2: $(show ([System.Numerics.Quaternion]::Multiply($q1,$q2)))"
"`$q2 * `$q1: $(show ([System.Numerics.Quaternion]::Multiply($q2,$q1)))"
</syntaxhighlight>
<b>Output:</b>
<pre>
norm $q: 5.47722557505166
negate $q: -1-2i-3j-4k
conjugate $q: 1-2i-3j-4k
$q + $r: 8+2i+3j+4k
$q1 + $q2: 5+7i+9j+11k
$q * $r: 7+14i+21j+28k
$q1 * $q2: -56+16i+24j+26k
$q2 * $q1: -56+18i+20j+28k
</pre>
=={{header|Prolog}}==
<syntaxhighlight lang="prolog">% A quaternion is represented as a complex term qx/4
add(qx(R0,I0,J0,K0), qx(R1,I1,J1,K1), qx(R,I,J,K)) :-
!, R is R0+R1, I is I0+I1, J is J0+J1, K is K0+K1.
add(qx(R0,I,J,K), F, qx(R,I,J,K)) :-
number(F), !, R is R0 + F.
add(F, qx(R0,I,J,K), Qx) :-
add(qx(R0,I,J,K), F, Qx).
mul(qx(R0,I0,J0,K0), qx(R1,I1,J1,K1), qx(R,I,J,K)) :- !,
R is R0*R1 - I0*I1 - J0*J1 - K0*K1,
I is R0*I1 + I0*R1 + J0*K1 - K0*J1,
J is R0*J1 - I0*K1 + J0*R1 + K0*I1,
K is R0*K1 + I0*J1 - J0*I1 + K0*R1.
mul(qx(R0,I0,J0,K0), F, qx(R,I,J,K)) :-
number(F), !, R is R0*F, I is I0*F, J is J0*F, K is K0*F.
mul(F, qx(R0,I0,J0,K0), Qx) :-
mul(qx(R0,I0,J0,K0),F,Qx).
abs(qx(R,I,J,K), Norm) :-
Norm is sqrt(R*R+I*I+J*J+K*K).
negate(qx(Ri,Ii,Ji,Ki),qx(R,I,J,K)) :-
R is -Ri, I is -Ii, J is -Ji, K is -Ki.
conjugate(qx(R,Ii,Ji,Ki),qx(R,I,J,K)) :-
I is -Ii, J is -Ji, K is -Ki.</syntaxhighlight>
'''Test:'''
<syntaxhighlight lang="prolog">data(q, qx(1,2,3,4)).
data(q1, qx(2,3,4,5)).
data(q2, qx(3,4,5,6)).
data(r, 7).
test :- data(Name, qx(A,B,C,D)), abs(qx(A,B,C,D), Norm),
writef('abs(%w) is %w\n', [Name, Norm]), fail.
test :- data(q, Qx), negate(Qx, Nqx),
writef('negate(%w) is %w\n', [q, Nqx]), fail.
test :- data(q, Qx), conjugate(Qx, Nqx),
writef('conjugate(%w) is %w\n', [q, Nqx]), fail.
test :- data(q1, Q1), data(q2, Q2), add(Q1, Q2, Qx),
writef('q1+q2 is %w\n', [Qx]), fail.
test :- data(q1, Q1), data(q2, Q2), add(Q2, Q1, Qx),
writef('q2+q1 is %w\n', [Qx]), fail.
test :- data(q, Qx), data(r, R), mul(Qx, R, Nqx),
writef('q*r is %w\n', [Nqx]), fail.
test :- data(q, Qx), data(r, R), mul(R, Qx, Nqx),
writef('r*q is %w\n', [Nqx]), fail.
test :- data(q1, Q1), data(q2, Q2), mul(Q1, Q2, Qx),
writef('q1*q2 is %w\n', [Qx]), fail.
test :- data(q1, Q1), data(q2, Q2), mul(Q2, Q1, Qx),
writef('q2*q1 is %w\n', [Qx]), fail.
test.</syntaxhighlight>
{{out}}
<pre> ?- test.
abs(q) is 5.477225575051661
abs(q1) is 7.3484692283495345
abs(q2) is 9.273618495495704
negate(q) is qx(-1,-2,-3,-4)
conjugate(q) is qx(1,-2,-3,-4)
q1+q2 is qx(5,7,9,11)
q2+q1 is qx(5,7,9,11)
q*r is qx(7,14,21,28)
r*q is qx(7,14,21,28)
q1*q2 is qx(-56,16,24,26)
q2*q1 is qx(-56,18,20,28)</pre>
=={{header|PureBasic}}==
<
a.f
b.f
Line 3,225 ⟶ 7,242:
EndIf
ProcedureReturn 1 ;true
EndProcedure</
Implementation & test
<
ProcedureReturn "{" + StrF(*x\a, NN) + "," + StrF(*x\b, NN) + "," + StrF(*x\c, NN) + "," + StrF(*x\d, NN) + "}"
EndProcedure
Line 3,255 ⟶ 7,272:
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</
Result
<pre>Q0 = {1,2,3,4}
Line 3,272 ⟶ 7,289:
=={{header|Python}}==
This example extends Pythons [http://docs.python.org/library/collections.html?highlight=namedtuple#collections.namedtuple namedtuples] to add extra functionality.
<
import math
Line 3,353 ⟶ 7,370:
q1 = Q(2, 3, 4, 5)
q2 = Q(3, 4, 5, 6)
r = 7</
'''Continued shell session'''
Run the above with the -i flag to python on the command line, or run with idle then continue in the shell as follows:
<
Quaternion(real=1.0, i=2.0, j=3.0, k=4.0)
>>> q1
Line 3,412 ⟶ 7,429:
>>> q1 * q1.reciprocal()
Quaternion(real=0.9999999999999999, i=0.0, j=0.0, k=0.0)
>>> </
=={{header|R}}==
Line 3,420 ⟶ 7,435:
Using the quaternions package.
<syntaxhighlight lang="r">
library(quaternions)
Line 3,455 ⟶ 7,470:
## q1*q2 != q2*q1
</syntaxhighlight>
=={{header|Racket}}==
<
(struct quaternion (a b c d)
#:transparent)
(define-match-expander quaternion:
(λ (stx)
(syntax-case stx ()
[(_ a b c d)
#'(or (quaternion a b c d)
(and a (app (λ(_) 0) b) (app (λ(_) 0) c) (app (λ(_) 0) d)))])))
(define (norm q)
(match q
[(quaternion: a b c d)
(sqrt (+ (sqr a) (sqr b) (sqr c) (sqr d)))]))
(define (negate q)
(match q
[(quaternion: a b c d)
(quaternion (- a) (- b) (- c) (- d))]))
(define (conjugate q)
(match q
[(quaternion: a b c d)
(quaternion a (- b) (- c) (- d))]))
(define (add q1 q2 . q-rest)
(let ((ans (match* (q1 q2)
[((quaternion: a1 b1 c1 d1) (quaternion: a2 b2 c2 d2))
(quaternion (+ a1 a2) (+ b1 b2) (+ c1 c2) (+ d1 d2))])))
(if (empty? q-rest)
ans
(apply add (cons ans q-rest)))))
(define (
(let ((ans (match* (q1 q2)
[((quaternion: a1 b1 c1 d1) (quaternion: a2 b2 c2 d2))
(quaternion (
(+ (* a1 b2) (* b1 a2) (* c1 d2) (- (* d1 c2)))
(+ (* a1 c2) (- (* b1 d2)) (* c1 a2) (* d1 b2))
(+ (* a1 d2) (* b1 c2) (- (* c1 b2)) (* d1 a2)))])))
(if (empty? q-rest)
ans
(apply multiply (cons ans q-rest)))))
;; Tests
(module+ main
(define i (quaternion 0 1 0 0))
(define j (quaternion 0 0 1 0))
(define k (quaternion 0 0 0 1))
(displayln (multiply i j k))
(newline)
(define q (quaternion 1 2 3 4))
(define q1 (quaternion 2 3 4 5))
(define q2 (quaternion 3 4 5 6))
(define r 7)
(for ([quat (list q q1 q2)])
(displayln quat)
(displayln (norm quat))
(displayln (negate quat))
(displayln (conjugate quat))
(newline))
(add r q)
(add q1 q2)
(multiply r q)
(newline)
(multiply q1 q2)
(multiply q2 q1)
(equal? (multiply q1 q2)
(multiply q2 q1)))</syntaxhighlight>
{{out}}
<pre>
#(struct:quaternion 1 2 3 4)
5.477225575051661
#(struct:quaternion -1 -2 -3 -4)
#(struct:quaternion 1 -2 -3 -4)
#(struct:quaternion 2 3 4 5)
7.3484692283495345
#(struct:quaternion -2 -3 -4 -5)
#(struct:quaternion 2 -3 -4 -5)
#(struct:quaternion 3 4 5 6)
9.273618495495704
#(struct:quaternion -3 -4 -5 -6)
#(struct:quaternion 3 -4 -5 -6)
(quaternion 8 2 3 4)
(quaternion 5 7 9 11)
(quaternion 7 14 21 28)
(quaternion -56 16 24 26)
(quaternion -56 18 20 28)
#f
</pre>
=={{header|Raku}}==
(formerly Perl 6)
<syntaxhighlight lang="raku" line>class Quaternion {
has Real ( $.r, $.i, $.j, $.k );
multi method new ( Real $r, Real $i, Real $j, Real $k ) {
self.bless: :$r, :$i, :$j, :$k;
}
multi qu(*@r) is export { Quaternion.new: |@r }
sub postfix:<j>(Real $x) is export { qu 0, 0, $x, 0 }
sub postfix:<k>(Real $x) is export { qu 0, 0, 0, $x }
method Str () { "$.r + {$.i}i + {$.j}j + {$.k}k" }
method reals () { $.r, $.i, $.j, $.k }
method conj () { qu $.r, -$.i, -$.j, -$.k }
method norm () { sqrt [+] self.reals X** 2 }
multi infix:<eqv> ( Quaternion $a, Quaternion $b ) is export { $a.reals eqv $b.reals }
multi infix:<+> ( Quaternion $a, Real $b ) is export { qu $b+$a.r, $a.i, $a.j, $a.k }
multi infix:<+> ( Real $a, Quaternion $b ) is export { qu $a+$b.r, $b.i, $b.j, $b.k }
multi infix:<+> ( Quaternion $a, Complex $b ) is export { qu $b.re + $a.r, $b.im + $a.i, $a.j, $a.k }
multi infix:<+> ( Complex $a, Quaternion $b ) is export { qu $a.re + $b.r, $a.im + $b.i, $b.j, $b.k }
multi infix:<+> ( Quaternion $a, Quaternion $b ) is export { qu $a.reals Z+ $b.reals }
multi prefix:<-> ( Quaternion $a ) is export { qu $a.reals X* -1 }
multi infix:<*> ( Quaternion $a, Real $b ) is export { qu $a.reals X* $b }
multi infix:<*> ( Real $a, Quaternion $b ) is export { qu $b.reals X* $a }
multi infix:<*> ( Quaternion $a, Complex $b ) is export { $a * qu $b.reals, 0, 0 }
multi infix:<*> ( Complex $a, Quaternion $b ) is export { $b R* qu $a.reals, 0, 0 }
multi infix:<*> ( Quaternion $a, Quaternion $b ) is export {
my @a_rijk = $a.reals;
my ( $r, $i, $j, $k ) = $b.reals;
return qu [+]( @a_rijk Z* $r, -$i, -$j, -$k ), # real
[+]( @a_rijk Z* $i, $r, $k, -$j ), # i
[+]( @a_rijk Z* $j, -$k, $r, $i ), # j
[+]( @a_rijk Z* $k, $j, -$i, $r ); # k
}
}
import Quaternion;
my $q = 1 + 2i + 3j + 4k;
my $q1 = 2 + 3i + 4j + 5k;
my $q2 = 3 + 4i + 5j + 6k;
my $r = 7;
say "1) q norm = {$q.norm}";
say "2) -q = {-$q}";
say "3) q conj = {$q.conj}";
say "4) q + r = {$q + $r}";
say "5) q1 + q2 = {$q1 + $q2}";
say "6) q * r = {$q * $r}";
say "7) q1 * q2 = {$q1 * $q2}";
say "8) q1q2 { $q1 * $q2 eqv $q2 * $q1 ?? '==' !! '!=' } q2q1";</syntaxhighlight>
{{out}}
<pre>1) q norm = 5.47722557505166
2) -q = -1 + -2i + -3j + -4k
3) q conj = 1 + -2i + -3j + -4k
4) q + r = 8 + 2i + 3j + 4k
5) q1 + q2 = 5 + 7i + 9j + 11k
6) q * r = 7 + 14i + 21j + 28k
7) q1 * q2 = -56 + 16i + 24j + 26k
8) q1q2 != q2q1</pre>
=={{header|Red}}==
<syntaxhighlight lang="red">
quaternion: context [
quaternion!: make typeset! [block! hash! vector!]
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)]
]
set [q q1 q2 r] [[1 2 3 4] [2 3 4 5] [3 4 5 6] 7]
print [{
1. The norm of a quaternion:
`quaternion/norm q` =>} quaternion/norm q {
2. The negative of a quaternion:
`quaternion/negate q` =>} mold quaternion/negate q {
3. The conjugate of a quaternion:
<code>quaternion/conjugate q</code> =>} mold quaternion/conjugate q {
4. Addition of a real number `r` and a quaternion `q`:
`quaternion/add r q` =>} mold quaternion/add r q {
`quaternion/add q r` =>} mold quaternion/add q r {
5. Addition of two quaternions:
`quaternion/add q1 q2` =>} mold quaternion/add q1 q2 {
6. Multiplication of a real number and a quaternion:
`quaternion/multiply q r` =>} mold quaternion/multiply q r {
`quaternion/multiply r q` =>} mold quaternion/multiply r q {
7. Multiplication of two quaternions `q1` and `q2` is given by:
`quaternion/multiply q1 q2` =>} mold quaternion/multiply q1 q2 {
8. Show that, for the two quaternions `q1` and `q2`:
`equal? quaternion/multiply q1 q2 mold quaternion/multiply q2 q1` =>}
equal? quaternion/multiply q1 q2 quaternion/multiply q2 q1]
</syntaxhighlight>
Output:
1. The norm of a quaternion: <br>
<code>quaternion/norm q</code> => <code>5.477225575051661</code>
2. The negative of a quaternion: <br>
<code>quaternion/negate q</code> => <code>[-1 -2 -3 -4]</code>
3. The conjugate of a quaternion:<br>
<code>quaternion/conjugate q</code> => <code>[1 -2 -3 -4]</code>
4. Addition of a real number <code>r</code> and a quaternion <code>q</code>:<br>
<code>quaternion/add r q</code> => <code>[8 2 3 4]</code> <br>
<code>quaternion/add q r</code> => <code>[8 2 3 4]</code>
5. Addition of two quaternions: <br>
<code>quaternion/add q1 q2</code> => <code>[5 7 9 11]</code>
6. Multiplication of a real number and a quaternion: <br>
<code>quaternion/multiply q r</code> => <code>[7 14 21 28]</code> <br>
<code>quaternion/multiply r q</code> => <code>[7 14 21 28]</code>
7. Multiplication of two quaternions <code>q1</code> and <code>q2</code> is given by:<br>
<code>quaternion/multiply q1 q2</code> => <code>[-56 16 24 26]</code>
8. Show that, for the two quaternions <code>q1</code> and <code>q2</code>:<br>
<code>equal? quaternion/multiply q1 q2 mold quaternion/multiply q2 q1</code> => <code>false</code>
=={{header|REXX}}==
The REXX language has no native quaternion support, but subroutines can be easily written.
<
q = 1 2 3 4 ; q1 = 2 3 4 5
r = 7 ; q2 = 3 4 5 6
call
call
call
call
call
call
call
call
call
call
call
call
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
qNeg: procedure; parse arg x; call qXY; return -x
qNorm: procedure; parse arg x; call qXY; return sqrt(x.1**2 +x.2**2 +x.3**2 +x.4**2)
/*──────────────────────────────────────────────────────────────────────────────────────*/
qMul: procedure; parse arg x,y; call qXY y
return x.1*y.1 -x.2*y.2 -x.3*y.3 -x.4*y.4 x.1*y.2 +x.2*y.1 +x.3*y.4 -x.4*y.3 ,
/*──────────────────────────────────────────────────────────────────────────────────────*/
qShow: procedure; parse arg x; call qXY; $=
do m=1 for 4; _= x.m; if _==0 then iterate; if _>=0 then _= '+'_
if m\==1 then _= _ || substr('∙ijk', m, 1); $= strip($ || _, , "+")
end /*m*/
say left(arg(3), 9) right(arg(2), 20) ' ──► ' $; return $
/*──────────────────────────────────────────────────────────────────────────────────────*/
qXY: do n=1 for 4; x.n= word( word(x, n) 0, 1)/1; end /*n*/
if arg()==1 then do m=1 for 4; y.m= word( word(y, m) 0, 1)/1; end /*m*/; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x; if
numeric digits; numeric form; if x<0 then parse value -x 'i' with x i
parse value format(x, 2, 1, , 0) 'E0' with g "E" _ .; g= g *.5'e'_ % 2
do j=0 while h>9; m.j=h; h= h % 2 + 1; end /*j*/
do k=j+5 to 0 by -1; numeric digits m.k; g= (g + x/g)* .5; end /*k*/
{{out|output|text= when using the internal default inputs:}}
<pre>
q ──► 1+2i+3j+4k
q1 ──► 2+3i+4j+5k
Line 3,573 ⟶ 7,792:
task 8: multiplication q2*q1 ──► -56+18i+20j+28k
</pre>
=={{header|RPL}}==
{{works with|Halcyon Calc|4.2.7}}
By considering quaternions as arrays, negation and addition can be directly achieved by resp. <code>NEG</code> and <code>+</code> instructions. Other operations need specific RPL words:
{| class="wikitable"
! RPL code
! Comment
|-
|
≪ 0 1 4 '''FOR''' q OVER q GET SQ + '''NEXT''' √ SWAP DROP
≫ '<span style="color:blue">QNORM</span>' STO
≪ NEG 1 DUP2 GET NEG PUT ≫ '<span style="color:blue">QCONJ</span>' STO
≪
DUP TYPE 3 == ≪ SWAP ≫ IFT
OVER 1 GET + 1 SWAP PUT
≫ '<span style="color:blue">QRADD</span>' STO
≪
ARRY→ DROP 5 ROLL ARRY→ DROP → a2 b2 c2 d2 a1 b1 c1 d1
≪ 'a1*a2 − b1*b2 − c1*c2 − d1*d2' EVAL
'a1*b2 + b1*a2 + c1*d2 − d1*c2' EVAL
'a1*c2 − b1*d2 + c1*a2 + d1*b2' EVAL
'a1*d2 + b1*c2 − c1*b2 + d1*a2' EVAL
{ 4 } →ARRY
≫ ≫ '<span style="color:blue">QMULT</span>' STO
|
<span style="color:blue">QNORM</span> ''( [ a b c d ] -- √(a²+b²+c²+d²) )''
<span style="color:blue">QCONJ</span> ''( [ a b c d ] -- [ a -b -c -d ] )''
<span style="color:blue">QRADD</span> ''( [ a b c d ] r -- [ a+r b c d ] )''
switch arguments if quaternion is at stack level 1
replace a by a+r
<span style="color:blue">QMULT</span> ''( [Q1] [Q2] -- [Q1 x Q2] )''
put the 2 quaternions in local variables
do the math in stack
convert stack to a quaternion
|}
[1 2 3 4] <span style="color:blue">QNORM</span>
[1 2 3 4] NEG
[1 2 3 4] <span style="color:blue">QCONJ</span>
[1 2 3 4] 7 <span style="color:blue">QRADD</span>
[2 3 4 5] [3 4 5 6] +
[1 2 3 4] 7 *
[2 3 4 5] [3 4 5 6] <span style="color:blue">QMULT</span>
[3 4 5 6] [2 3 4 5] <span style="color:blue">QMULT</span>
{{out}}
<pre>
8: 5.47722557505
7: [ -1 -2 -3 -4 ]
6: [ 1 -2 -3 -4 ]
5: [ 8 2 3 4 ]
4: [ 5 7 9 11 ]
3: [ 7 14 21 28 ]
2: [ -56 16 24 26 ]
1: [ -56 18 20 28 ]
</pre>
=== Quaternion multiplication through Cayley-Dickson construction===
This is a shorter and faster version of the <code>QMULT</code> word. {{trans|Ruby}}
{| class="wikitable"
! RPL code
! Comment
|-
|
≪
ARRY→ DROP R→C ROT ROT R→C ROT
ARRY→ DROP R→C ROT ROT R→C → d c b a
≪ a c * d CONJ b * - C→R
d a * b c CONJ * + C→R
{ 4 } →ARRY
≫ ≫ '<span style="color:blue">QMULT</span>' STO
|
<span style="color:blue">QMULT</span> ''( [Q1] [Q2] -- [Q1 x Q2] )''
convert the 2 quaternions into 2 pairs of complex numbers
and store them locally
(a,b)(c,d) = (ac - conj(d).b, // (a,b) and (c,d) are pairs
da + b.conj(c)) // of complex numbers
convert stack to a quaternion
|}
Output is the same.
===Using the matrix form===
This efficient implementation is based on an article of [https://edspi31415.blogspot.com/2015/06/hp-prime-and-hp-50g-quaternions.html?fbclid=IwAR1KTjHt4xVt2FoMqL-82MJ1SS3SBg8jNoF-8uNcqg2Y5bLD2oiyxVfO88Y Eddie's Math and Calculator Blog].
« ARRY→ DROP → a b c d
« a b R→C c d R→C
c NEG d R→C
3 PICK CONJ
{ 2 2 } →ARRY
» » '<span style="color:blue">→QTM</span>' STO <span style="color:grey">''@ ( [ a b c d ] → [[ a+bi c+di ][ -c+di a-bi ]] )''</span>
« DUP 1 GET RE LASTARG IM
ROT 2 GET RE LASTARG IM
{ 4 } →ARRY
» '<span style="color:blue">QTM→</span>' STO <span style="color:grey">''@ ( [[ a+bi c+di ][ -c+di a-bi ]] → [ a b c d ] )''</span>
« <span style="color:blue">→QTM</span> SWAP <span style="color:blue">QTM→</span> SWAP * <span style="color:blue">QTM→</span>
» '<span style="color:blue">QMULT</span>' STO <span style="color:grey">''@ ( q1 q2 → q1*q2 ) ''</span>
« <span style="color:blue">→QTM</span> DET √ ABS
» '<span style="color:blue">QNORM</span>' STO <span style="color:grey">''@ ( q → qnorm(q) ) ''</span>
« DUP INV SWAP <span style="color:blue">QNORM</span> SQ *
» '<span style="color:blue">QCONJ</span>' STO <span style="color:grey">''@ ( q → conj(q) ) ''</span>
Quaternions' matrix form allows to quickly develop additional operations:
« DUP <span style="color:blue">QNORM</span> /
» '<span style="color:blue">QSIGN</span>' STO <span style="color:grey">''@ ( q → q/norm(q) ) ''</span>
« <span style="color:blue">→QTM</span> INV <span style="color:blue">QTM→</span>
» '<span style="color:blue">QINV</span>' STO <span style="color:grey">''@ ( q → q^(-1) ) ''</span>
« <span style="color:blue">QINV QMULT</span>
» '<span style="color:blue">QDIV</span>' STO <span style="color:grey">''@ ( q1 q2 → q1/q2 )''</span>
=={{header|Ruby}}==
{{works with|Ruby|1.9}}
<syntaxhighlight lang="ruby">class Quaternion
def initialize(*parts)
raise ArgumentError, "
raise ArgumentError, "invalid value of quaternion parts #{parts}" unless parts.all? {|x| x.is_a?(Numeric)}
@parts = parts
end
def to_a; @parts; end
def to_s; "Quaternion#{
alias inspect to_s
def complex_parts; [Complex(*to_a[0..1]), Complex(*to_a[2..3])]; end
def real; @parts.first; end
def imag; @parts[1..3]; end
def conj; Quaternion.new(real, *imag.map(&:-@)); end
def norm;
def ==(other)
case other
when Quaternion; to_a == other.to_a
when Numeric; to_a == [other, 0, 0, 0]
else false
end
end
def -@; Quaternion.new(*to_a.map(&:-@)); end
def -(other); self + -other; end
Line 3,604 ⟶ 7,954:
Quaternion.new(real + other, *imag)
when Quaternion
Quaternion.new(*to_a.zip(other.to_a).map { |x,y| x + y }) # In Rails: zip(other).map(&:sum)
end
end
def *(other)
case other
when Numeric
Quaternion.new(*to_a.map { |x| x * other })
when Quaternion
# Multiplication of quaternions in C x C space. See "Cayley-Dickson construction".
Line 3,619 ⟶ 7,969:
end
end
# Coerce is called by Ruby to return a compatible type/receiver when the called method/operation does not accept a Quaternion
def coerce(other)
Line 3,627 ⟶ 7,977:
end
end
class Scalar
def initialize(val); @val = val; end
Line 3,634 ⟶ 7,984:
def -(other); Quaternion.new(@val, 0, 0, 0) - other; end
end
end
if __FILE__ == $0
q = Quaternion.new(1,2,3,4)
q1 = Quaternion.new(2,3,4,5)
r = 7
expressions = ["q", "q1", "q2",
"q.norm", "-q", "q.conj", "q + r", "r + q","q1 + q2", "q2 + q1",
"q * r", "r * q", "q1 * q2", "q2 * q1", "(q1 * q2 != q2 * q1)",
"q - r", "r - q"]
expressions.each do |exp|
puts "%20s = %s" % [exp, eval(exp)]
end
end</syntaxhighlight>
{{out}}
<pre>
q = Quaternion[1, 2, 3, 4]
q1 = Quaternion[2, 3, 4, 5]
q2 = Quaternion[3, 4, 5, 6]
q.norm = 5.477225575051661
-q = Quaternion[-1, -2, -3, -4]
q.conj =
q + r = Quaternion[8, 2, 3, 4]
r + q =
q1 + q2 = Quaternion[5, 7, 9, 11]
q2 + q1 =
q * r = Quaternion[7, 14, 21, 28]
r * q =
q1 * q2 = Quaternion[-56, 16, 24, 26]
q2 * q1 =
(q1 * q2 != q2 * q1) = true
q - r =
r - q = Quaternion[6, -2, -3, -4]
</pre>
=={{header|Rust}}==
<syntaxhighlight lang="rust">use std::fmt::{Display, Error, Formatter};
use std::ops::{Add, Mul, Neg};
#[derive(Clone,Copy,Debug)]
struct Quaternion {
a: f64,
b: f64,
c: f64,
d: f64
}
impl Quaternion {
pub fn new(a: f64, b: f64, c: f64, d: f64) -> Quaternion {
Quaternion {
a: a,
b: b,
c: c,
d: d
}
}
pub fn norm(&self) -> f64 {
(self.a.powi(2) + self.b.powi(2) + self.c.powi(2) + self.d.powi(2)).sqrt()
}
pub fn conjugate(&self) -> Quaternion {
Quaternion {
a: self.a,
b: -self.b,
c: -self.c,
d: -self.d
}
}
}
impl Add for Quaternion {
type Output = Quaternion;
#[inline]
fn add(self, other: Quaternion) -> Self::Output {
Quaternion {
a: self.a + other.a,
b: self.b + other.b,
c: self.c + other.c,
d: self.d + other.d
}
}
}
impl Add<f64> for Quaternion {
type Output = Quaternion;
#[inline]
fn add(self, other: f64) -> Self::Output {
Quaternion {
a: self.a + other,
b: self.b,
c: self.c,
d: self.d
}
}
}
impl Add<Quaternion> for f64 {
type Output = Quaternion;
#[inline]
fn add(self, other: Quaternion) -> Self::Output {
Quaternion {
a: other.a + self,
b: other.b,
c: other.c,
d: other.d
}
}
}
impl Display for Quaternion {
fn fmt(&self, f: &mut Formatter) -> Result<(), Error> {
write!(f, "({} + {}i + {}j + {}k)", self.a, self.b, self.c, self.d)
}
}
impl Mul for Quaternion {
type Output = Quaternion;
#[inline]
fn mul(self, rhs: Quaternion) -> Self::Output {
Quaternion {
a: self.a * rhs.a - self.b * rhs.b - self.c * rhs.c - self.d * rhs.d,
b: self.a * rhs.b + self.b * rhs.a + self.c * rhs.d - self.d * rhs.c,
c: self.a * rhs.c - self.b * rhs.d + self.c * rhs.a + self.d * rhs.b,
d: self.a * rhs.d + self.b * rhs.c - self.c * rhs.b + self.d * rhs.a,
}
}
}
impl Mul<f64> for Quaternion {
type Output = Quaternion;
#[inline]
fn mul(self, other: f64) -> Self::Output {
Quaternion {
a: self.a * other,
b: self.b * other,
c: self.c * other,
d: self.d * other
}
}
}
impl Mul<Quaternion> for f64 {
type Output = Quaternion;
#[inline]
fn mul(self, other: Quaternion) -> Self::Output {
Quaternion {
a: other.a * self,
b: other.b * self,
c: other.c * self,
d: other.d * self
}
}
}
impl Neg for Quaternion {
type Output = Quaternion;
#[inline]
fn neg(self) -> Self::Output {
Quaternion {
a: -self.a,
b: -self.b,
c: -self.c,
d: -self.d
}
}
}
fn main() {
let q0 = Quaternion { a: 1., b: 2., c: 3., d: 4. };
let q1 = Quaternion::new(2., 3., 4., 5.);
let q2 = Quaternion::new(3., 4., 5., 6.);
let r: f64 = 7.;
println!("q0 = {}", q0);
println!("q1 = {}", q1);
println!("q2 = {}", q2);
println!("r = {}", r);
println!();
println!("-q0 = {}", -q0);
println!("conjugate of q0 = {}", q0.conjugate());
println!();
println!("r + q0 = {}", r + q0);
println!("q0 + r = {}", q0 + r);
println!();
println!("r * q0 = {}", r * q0);
println!("q0 * r = {}", q0 * r);
println!();
println!("q0 + q1 = {}", q0 + q1);
println!("q0 * q1 = {}", q0 * q1);
println!();
println!("q0 * (conjugate of q0) = {}", q0 * q0.conjugate());
println!();
println!(" q0 + q1 * q2 = {}", q0 + q1 * q2);
println!("(q0 + q1) * q2 = {}", (q0 + q1) * q2);
println!();
println!(" q0 * q1 * q2 = {}", q0 *q1 * q2);
println!("(q0 * q1) * q2 = {}", (q0 * q1) * q2);
println!(" q0 * (q1 * q2) = {}", q0 * (q1 * q2));
println!();
println!("normal of q0 = {}", q0.norm());
}</syntaxhighlight>
{{out}}
<pre>
q0 = (1 + 2i + 3j + 4k)
q1 = (2 + 3i + 4j + 5k)
q2 = (3 + 4i + 5j + 6k)
r = 7
-q0 = (-1 + -2i + -3j + -4k)
conjugate of q0 = (1 + -2i + -3j + -4k)
r + q0 = (8 + 2i + 3j + 4k)
q0 + r = (8 + 2i + 3j + 4k)
r * q0 = (7 + 14i + 21j + 28k)
q0 * r = (7 + 14i + 21j + 28k)
q0 + q1 = (3 + 5i + 7j + 9k)
q0 * q1 = (-36 + 6i + 12j + 12k)
q0 * (conjugate of q0) = (30 + 0i + 0j + 0k)
q0 + q1 * q2 = (-55 + 18i + 27j + 30k)
(q0 + q1) * q2 = (-100 + 24i + 42j + 42k)
q0 * q1 * q2 = (-264 + -114i + -132j + -198k)
(q0 * q1) * q2 = (-264 + -114i + -132j + -198k)
q0 * (q1 * q2) = (-264 + -114i + -132j + -198k)
normal of q0 = 5.477225575051661
</pre>
=={{header|Scala}}==
<
lazy val im = (i, j, k)
private lazy val norm2 = re*re + i*i + j*j + k*k
lazy val norm = math.sqrt(norm2)
def negative =
def conjugate =
def reciprocal =
def +(q: Quaternion) =
def -(q: Quaternion) =
def *(q: Quaternion) =
re*q.re - i*q.i - j*q.j - k*q.k,
re*q.i + i*q.re + j*q.k - k*q.j,
Line 3,694 ⟶ 8,244:
re*q.k + i*q.j - j*q.i + k*q.re
)
def /(q: Quaternion) = this * q.reciprocal
def unary_- = negative
def unary_~ = conjugate
override def toString = "Q(%.2f, %.2fi, %.2fj, %.2fk)".formatLocal(java.util.Locale.ENGLISH, re, i, j, k)
}
object Quaternion {
import scala.language.implicitConversions
import Numeric.Implicits._
implicit def number2Quaternion[T:Numeric](n: T) = Quaternion(n.toDouble)
}</syntaxhighlight>
Demonstration:
<
val q1=Quaternion(2.0, 3.0, 4.0, 5.0);
val q2=Quaternion(3.0, 4.0, 5.0, 6.0);
Line 3,748 ⟶ 8,293:
println("q2/q1 = "+ q2/q1)
println("q1/r = "+ q1/r)
println("r/q1 = "+ r/q1)</
{{out}}
<pre>q0 = Q(1.00, 2.00i, 3.00j, 4.00k)
q1 = Q(2.00, 3.00i, 4.00j, 5.00k)
Line 3,779 ⟶ 8,324:
q1/r = Q(0.29, 0.43i, 0.57j, 0.71k)
r/q1 = Q(0.26, -0.39i, -0.52j, -0.65k)</pre>
=={{header|Scheme}}==
For the source code, see [[#Ol|the entry for Otus Lisp]]. However, with most Scheme implementations the output will look different:
{{out}}
<pre>$ ypsilon quaternions_task.scm
q = (1 2 3 4)
q1 = (2 3 4 5)
q2 = (3 4 5 6)
r = 7
(quaternion? q) = #t
(quaternion? q1) = #t
(quaternion? q2) = #t
(quaternion? r) = #f
(quaternion-norm q) = 5.477225575051661
(quaternion-norm q1) = 7.3484692283495345
(quaternion-norm q2) = 9.273618495495704
(quaternion- q) = (-1 -2 -3 -4)
(quaternion- q1 q2) = (-1 -1 -1 -1)
(quaternion- q q1 q2) = (-4 -5 -6 -7)
(quaternion-conjugate q) = (1 -2 -3 -4)
(quaternion+) = (0 0 0 0)
(quaternion+ q) = (1 2 3 4)
(quaternion+ r q) = (8 2 3 4)
(quaternion+ q r) = (8 2 3 4)
(quaternion+ q1 q2) = (5 7 9 11)
(quaternion+ q q1 q2) = (6 9 12 15)
(quaternion*) = (1 0 0 0)
(quaternion* q) = (1 2 3 4)
(quaternion* r q) = (7 14 21 28)
(quaternion* q r) = (7 14 21 28)
(quaternion* q1 q2) = (-56 16 24 26)
(quaternion* q q1 q2) = (-264 -114 -132 -198)
(quaternion=? q) = #t
(quaternion=? q q) = #t
(quaternion=? q1 q2) = #f
(quaternion=? q q q) = #t
(quaternion=? q1 q1 q2) = #f
(quaternion* q1 q2) = (-56 16 24 26)
(quaternion* q2 q1) = (-56 18 20 28)
(quaternion=? (quaternion* q1 q2)
(quaternion* q2 q1)) = #f</pre>
=={{header|Seed7}}==
<syntaxhighlight lang="seed7">$ include "seed7_05.s7i";
include "float.s7i";
include "math.s7i";
# Define the quaternion number data type.
const type: quaternion is new object struct
var float: a is 0.0;
var float: b is 0.0;
var float: c is 0.0;
var float: d is 0.0;
end struct;
# Create a quaternion number from its real and imaginary parts.
const func quaternion: quaternion
(in float: a, in float: b, in float: c, in float: d) is func
result
var quaternion: aQuaternion is quaternion.value;
begin
aQuaternion.a := a;
aQuaternion.b := b;
aQuaternion.c := c;
aQuaternion.d := d;
end func;
# Helper function for str().
const func string: signed (in float: number, in string: part) is func
result
var string: stri is str(number) & part;
begin
if number > 0.0 then
stri := "+" & stri;
elsif number = 0.0 then
stri := "";
end if;
end func;
# Convert a quaternion number to a string.
const func string: str (in quaternion: number) is func
result
var string: stri is "";
begin
if number.a <> 0.0 then
stri &:= str(number.a);
end if;
stri &:= signed(number.b, "i");
stri &:= signed(number.c, "j");
stri &:= signed(number.d, "k");
end func;
# Compute the norm of a quaternion number.
const func float: norm (in quaternion: number) is func
result
var float: qnorm is 0.0;
begin
qnorm := sqrt(
number.a ** 2.0 + number.b ** 2.0 +
number.c ** 2.0 + number.d ** 2.0
);
end func;
# Compute the negative of a quaternion number.
const func quaternion: - (in quaternion: number) is func
result
var quaternion: negatedNumber is quaternion.value;
begin
negatedNumber.a := -number.a;
negatedNumber.b := -number.b;
negatedNumber.c := -number.c;
negatedNumber.d := -number.d;
end func;
# Compute the conjugate of a quaternion number.
const func quaternion: conjugate (in quaternion: number) is func
result
var quaternion: conjugateNumber is quaternion.value;
begin
conjugateNumber.a := number.a;
conjugateNumber.b := -number.b;
conjugateNumber.c := -number.c;
conjugateNumber.d := -number.d;
end func;
# Add a float to a quaternion number.
const func quaternion: (in quaternion: number) + (in float: real) is func
result
var quaternion: sum is quaternion.value;
begin
sum.a := number.a + real;
sum.b := number.b;
sum.c := number.c;
sum.d := number.d;
end func;
# Add a quaternion number to a float.
const func quaternion: (in float: real) + (in quaternion: number) is
return number + real;
# Add two quaternion numbers.
const func quaternion: (in quaternion: number1) + (in quaternion: number2) is func
result
var quaternion: sum is quaternion.value;
begin
sum.a := number1.a + number2.a;
sum.b := number1.b + number2.b;
sum.c := number1.c + number2.c;
sum.d := number1.d + number2.d;
end func;
# Multiply a float and a quaternion number.
const func quaternion: (in float: real) * (in quaternion: number) is func
result
var quaternion: product is quaternion.value;
begin
product.a := number.a * real;
product.b := number.b * real;
product.c := number.c * real;
product.d := number.d * real;
end func;
# Multiply a quaternion number and a float.
const func quaternion: (in quaternion: number) * (in float: real) is
return real * number;
# Multiply two quaternion numbers.
const func quaternion: (in quaternion: x) * (in quaternion: y) is func
result
var quaternion: product is quaternion.value;
begin
product.a := x.a * y.a - x.b * y.b - x.c * y.c - x.d * y.d;
product.b := x.a * y.b + x.b * y.a + x.c * y.d - x.d * y.c;
product.c := x.a * y.c - x.b * y.d + x.c * y.a + x.d * y.b;
product.d := x.a * y.d + x.b * y.c - x.c * y.b + x.d * y.a;
end func;
# Allow quaternions to be written using write(), writeln() etc.
enable_output(quaternion);
# Demonstrate quaternion numbers.
const proc: main is func
local
const quaternion: q is quaternion(1.0, 2.0, 3.0, 4.0);
const quaternion: q1 is quaternion(2.0, 3.0, 4.0, 5.0);
const quaternion: q2 is quaternion(3.0, 4.0, 5.0, 6.0);
const float: r is 7.0;
begin
writeln(" q = " <& q);
writeln("q1 = " <& q1);
writeln("q2 = " <& q2);
writeln(" r = " <& r <& "\n");
writeln("norm(q) = " <& norm(q));
writeln("-q = " <& -q);
writeln("conjugate(q) = " <& conjugate(q));
writeln("q + r = " <& q + r);
writeln("r + q = " <& r + q);
writeln("q1 + q2 = " <& q1 + q2);
writeln("q2 + q1 = " <& q2 + q1);
writeln("q * r = " <& q * r);
writeln("r * q = " <& r * q);
writeln("q1 * q2 = " <& q1 * q2);
writeln("q2 * q1 = " <& q2 * q1);
end func;</syntaxhighlight>
{{out}}
<pre>
q = 1.0+2.0i+3.0j+4.0k
q1 = 2.0+3.0i+4.0j+5.0k
q2 = 3.0+4.0i+5.0j+6.0k
r = 7.0
norm(q) = 5.47722557505166
-q = -1.0-2.0i-3.0j-4.0k
conjugate(q) = 1.0-2.0i-3.0j-4.0k
q + r = 8.0+2.0i+3.0j+4.0k
r + q = 8.0+2.0i+3.0j+4.0k
q1 + q2 = 5.0+7.0i+9.0j+11.0k
q2 + q1 = 5.0+7.0i+9.0j+11.0k
q * r = 7.0+14.0i+21.0j+28.0k
r * q = 7.0+14.0i+21.0j+28.0k
q1 * q2 = -56.0+16.0i+24.0j+26.0k
q2 * q1 = -56.0+18.0i+20.0j+28.0k
</pre>
=={{header|Sidef}}==
{{trans|Raku}}
<syntaxhighlight lang="ruby">class Quaternion(r, i, j, k) {
func qu(*r) { Quaternion(r...) }
method to_s { "#{r} + #{i}i + #{j}j + #{k}k" }
method reals { [r, i, j, k] }
method conj { qu(r, -i, -j, -k) }
method norm { self.reals.map { _*_ }.sum.sqrt }
method ==(Quaternion b) { self.reals == b.reals }
method +(Number b) { qu(b+r, i, j, k) }
method +(Quaternion b) { qu((self.reals ~Z+ b.reals)...) }
method neg { qu(self.reals.map{ .neg }...) }
method *(Number b) { qu((self.reals»*»b)...) }
method *(Quaternion b) {
var (r,i,j,k) = b.reals...
qu(sum(self.reals ~Z* [r, -i, -j, -k]),
sum(self.reals ~Z* [i, r, k, -j]),
sum(self.reals ~Z* [j, -k, r, i]),
sum(self.reals ~Z* [k, j, -i, r]))
}
}
var q = Quaternion(1, 2, 3, 4)
var q1 = Quaternion(2, 3, 4, 5)
var q2 = Quaternion(3, 4, 5, 6)
var r = 7
say "1) q norm = #{q.norm}"
say "2) -q = #{-q}"
say "3) q conj = #{q.conj}"
say "4) q + r = #{q + r}"
say "5) q1 + q2 = #{q1 + q2}"
say "6) q * r = #{q * r}"
say "7) q1 * q2 = #{q1 * q2}"
say "8) q1q2 #{ q1*q2 == q2*q1 ? '==' : '!=' } q2q1"</syntaxhighlight>
{{out}}
<pre>
1) q norm = 5.47722557505166113456969782800802133952744694997983
2) -q = -1 + -2i + -3j + -4k
3) q conj = 1 + -2i + -3j + -4k
4) q + r = 8 + 2i + 3j + 4k
5) q1 + q2 = 5 + 7i + 9j + 11k
6) q * r = 7 + 14i + 21j + 28k
7) q1 * q2 = -56 + 16i + 24j + 26k
8) q1q2 != q2q1
</pre>
=={{header|Swift}}==
<syntaxhighlight lang="swift">import Foundation
struct Quaternion {
var a, b, c, d: Double
static let i = Quaternion(a: 0, b: 1, c: 0, d: 0)
static let j = Quaternion(a: 0, b: 0, c: 1, d: 0)
static let k = Quaternion(a: 0, b: 0, c: 0, d: 1)
}
extension Quaternion: Equatable {
static func ==(lhs: Quaternion, rhs: Quaternion) -> Bool {
return (lhs.a, lhs.b, lhs.c, lhs.d) == (rhs.a, rhs.b, rhs.c, rhs.d)
}
}
extension Quaternion: ExpressibleByIntegerLiteral {
init(integerLiteral: Double) {
a = integerLiteral
b = 0
c = 0
d = 0
}
}
extension Quaternion: Numeric {
var magnitude: Double {
return norm
}
init?<T>(exactly: T) { // stub to satisfy protocol requirements
return nil
}
public static func + (lhs: Quaternion, rhs: Quaternion) -> Quaternion {
return Quaternion(
a: lhs.a + rhs.a,
b: lhs.b + rhs.b,
c: lhs.c + rhs.c,
d: lhs.d + rhs.d
)
}
public static func - (lhs: Quaternion, rhs: Quaternion) -> Quaternion {
return Quaternion(
a: lhs.a - rhs.a,
b: lhs.b - rhs.b,
c: lhs.c - rhs.c,
d: lhs.d - rhs.d
)
}
public static func * (lhs: Quaternion, rhs: Quaternion) -> Quaternion {
return Quaternion(
a: lhs.a*rhs.a - lhs.b*rhs.b - lhs.c*rhs.c - lhs.d*rhs.d,
b: lhs.a*rhs.b + lhs.b*rhs.a + lhs.c*rhs.d - lhs.d*rhs.c,
c: lhs.a*rhs.c - lhs.b*rhs.d + lhs.c*rhs.a + lhs.d*rhs.b,
d: lhs.a*rhs.d + lhs.b*rhs.c - lhs.c*rhs.b + lhs.d*rhs.a
)
}
public static func += (lhs: inout Quaternion, rhs: Quaternion) {
lhs = Quaternion(
a: lhs.a + rhs.a,
b: lhs.b + rhs.b,
c: lhs.c + rhs.c,
d: lhs.d + rhs.d
)
}
public static func -= (lhs: inout Quaternion, rhs: Quaternion) {
lhs = Quaternion(
a: lhs.a - rhs.a,
b: lhs.b - rhs.b,
c: lhs.c - rhs.c,
d: lhs.d - rhs.d
)
}
public static func *= (lhs: inout Quaternion, rhs: Quaternion) {
lhs = Quaternion(
a: lhs.a*rhs.a - lhs.b*rhs.b - lhs.c*rhs.c - lhs.d*rhs.d,
b: lhs.a*rhs.b + lhs.b*rhs.a + lhs.c*rhs.d - lhs.d*rhs.c,
c: lhs.a*rhs.c - lhs.b*rhs.d + lhs.c*rhs.a + lhs.d*rhs.b,
d: lhs.a*rhs.d + lhs.b*rhs.c - lhs.c*rhs.b + lhs.d*rhs.a
)
}
}
extension Quaternion: CustomStringConvertible {
var description: String {
let formatter = NumberFormatter()
formatter.positivePrefix = "+"
let f: (Double) -> String = { formatter.string(from: $0 as NSNumber)! }
return [f(a), f(b), "i", f(c), "j", f(d), "k"].joined()
}
}
extension Quaternion {
var norm: Double {
return sqrt(a*a + b*b + c*c + d*d)
}
var conjugate: Quaternion {
return Quaternion(a: a, b: -b, c: -c, d: -d)
}
public static func + (lhs: Double, rhs: Quaternion) -> Quaternion {
var result = rhs
result.a += lhs
return result
}
public static func + (lhs: Quaternion, rhs: Double) -> Quaternion {
var result = lhs
result.a += rhs
return result
}
public static func * (lhs: Double, rhs: Quaternion) -> Quaternion {
return Quaternion(a: lhs*rhs.a, b: lhs*rhs.b, c: lhs*rhs.c, d: lhs*rhs.d)
}
public static func * (lhs: Quaternion, rhs: Double) -> Quaternion {
return Quaternion(a: lhs.a*rhs, b: lhs.b*rhs, c: lhs.c*rhs, d: lhs.d*rhs)
}
public static prefix func - (x: Quaternion) -> Quaternion {
return Quaternion(a: -x.a, b: -x.b, c: -x.c, d: -x.d)
}
}
let q: Quaternion = 1 + 2 * .i + 3 * .j + 4 * .k // 1+2i+3j+4k
let q1: Quaternion = 2 + 3 * .i + 4 * .j + 5 * .k // 2+3i+4j+5k
let q2: Quaternion = 3 + 4 * .i + 5 * .j + 6 * .k // 3+4i+5j+6k
let r: Double = 7
print("""
q = \(q)
q1 = \(q1)
q2 = \(q2)
r = \(r)
-q = \(-q)
‖q‖ = \(q.norm)
conjugate of q = \(q.conjugate)
r + q = q + r = \(r+q) = \(q+r)
q₁ + q₂ = \(q1 + q2) = \(q2 + q1)
qr = rq = \(q*r) = \(r*q)
q₁q₂ = \(q1 * q2)
q₂q₁ = \(q2 * q1)
q₁q₂ ≠ q₂q₁ is \(q1*q2 != q2*q1)
""")</syntaxhighlight>
{{out}}
<pre>
q = +1+2i+3j+4k
q1 = +2+3i+4j+5k
q2 = +3+4i+5j+6k
r = 7.0
-q = -1-2i-3j-4k
‖q‖ = 5.477225575051661
conjugate of q = +1-2i-3j-4k
r + q = q + r = +8+2i+3j+4k = +8+2i+3j+4k
q₁ + q₂ = +5+7i+9j+11k = +5+7i+9j+11k
qr = rq = +7+14i+21j+28k = +7+14i+21j+28k
q₁q₂ = -56+16i+24j+26k
q₂q₁ = -56+18i+20j+28k
q₁q₂ ≠ q₂q₁ is true
</pre>
=={{header|Tcl}}==
{{works with|Tcl|8.6}} or {{libheader|TclOO}}
<
# Support class that provides C++-like RAII lifetimes
Line 3,880 ⟶ 8,879:
export - + * ==
}</
Demonstration code:
<
set q1 [Q new 2 3 4 5]
set q2 [Q new 3 4 5 6]
Line 3,903 ⟶ 8,902:
puts "q1 * q2 = [[$q1 * $q2] p]"
puts "q2 * q1 = [[$q2 * $q1] p]"
puts "equal(q1*q2, q2*q1) = [[$q1 * $q2] == [$q2 * $q1]]"</
{{out}}
<pre>
q = Q(1.0,2.0,3.0,4.0)
Line 3,922 ⟶ 8,921:
q2 * q1 = Q(-56.0,18.0,20.0,28.0)
equal(q1*q2, q2*q1) = 0
</pre>
=={{header|VBA}}==
<syntaxhighlight lang="vb">Option Base 1
Private Function norm(q As Variant) As Double
norm = Sqr(WorksheetFunction.SumSq(q))
End Function
Private Function negative(q) As Variant
Dim res(4) As Double
For i = 1 To 4
res(i) = -q(i)
Next i
negative = res
End Function
Private Function conj(q As Variant) As Variant
Dim res(4) As Double
res(1) = q(1)
For i = 2 To 4
res(i) = -q(i)
Next i
conj = res
End Function
Private Function addr(r As Double, q As Variant) As Variant
Dim res As Variant
res = q
res(1) = r + q(1)
addr = res
End Function
Private Function add(q1 As Variant, q2 As Variant) As Variant
add = WorksheetFunction.MMult(Array(1, 1), Array(q1, q2))
End Function
Private Function multr(r As Double, q As Variant) As Variant
multr = WorksheetFunction.MMult(r, q)
End Function
Private Function mult(q1 As Variant, q2 As Variant)
Dim res(4) As Double
res(1) = q1(1) * q2(1) - q1(2) * q2(2) - q1(3) * q2(3) - q1(4) * q2(4)
res(2) = q1(1) * q2(2) + q1(2) * q2(1) + q1(3) * q2(4) - q1(4) * q2(3)
res(3) = q1(1) * q2(3) - q1(2) * q2(4) + q1(3) * q2(1) + q1(4) * q2(2)
res(4) = q1(1) * q2(4) + q1(2) * q2(3) - q1(3) * q2(2) + q1(4) * q2(1)
mult = res
End Function
Private Sub quats(q As Variant)
Debug.Print q(1); IIf(q(2) < 0, " - " & Abs(q(2)), " + " & q(2));
Debug.Print IIf(q(3) < 0, "i - " & Abs(q(3)), "i + " & q(3));
Debug.Print IIf(q(4) < 0, "j - " & Abs(q(4)), "j + " & q(4)); "k"
End Sub
Public Sub quaternions()
q = [{ 1, 2, 3, 4}]
q1 = [{2, 3, 4, 5}]
q2 = [{3, 4, 5, 6}]
Dim r_ As Double
r_ = 7#
Debug.Print "q = ";: quats q
Debug.Print "q1 = ";: quats q1
Debug.Print "q2 = ";: quats q2
Debug.Print "r = "; r_
Debug.Print "norm(q) = "; norm(q)
Debug.Print "negative(q) = ";: quats negative(q)
Debug.Print "conjugate(q) = ";: quats conj(q)
Debug.Print "r + q = ";: quats addr(r_, q)
Debug.Print "q1 + q2 = ";: quats add(q1, q2)
Debug.Print "q * r = ";: quats multr(r_, q)
Debug.Print "q1 * q2 = ";: quats mult(q1, q2)
Debug.Print "q2 * q1 = ";: quats mult(q2, q1)
End Sub</syntaxhighlight>{{out}}
<pre>q = 1 + 2i + 3j + 4k
q1 = 2 + 3i + 4j + 5k
q2 = 3 + 4i + 5j + 6k
r = 7
norm(q) = 5,47722557505166
negative(q) = -1 - 2i - 3j - 4k
conjugate(q) = 1 - 2i - 3j - 4k
r + q = 8 + 2i + 3j + 4k
q1 + q2 = 5 + 7i + 9j + 11k
q * r = 7 + 14i + 21j + 28k
q1 * q2 = -56 + 16i + 24j + 26k
q2 * q1 = -56 + 18i + 20j + 28k</pre>
=={{header|Visual Basic .NET}}==
{{trans|C#}}
'''Compiler:''' Roslyn Visual Basic (language version >= 14, e.g. with Visual Studio 2015)
{{works with|.NET Core|2.1}}
<syntaxhighlight lang="vbnet">Option Compare Binary
Option Explicit On
Option Infer On
Option Strict On
Structure Quaternion
Implements IEquatable(Of Quaternion), IStructuralEquatable
Public ReadOnly A, B, C, D As Double
Public Sub New(a As Double, b As Double, c As Double, d As Double)
Me.A = a
Me.B = b
Me.C = c
Me.D = d
End Sub
Public ReadOnly Property Norm As Double
Get
Return Math.Sqrt((Me.A ^ 2) + (Me.B ^ 2) + (Me.C ^ 2) + (Me.D ^ 2))
End Get
End Property
Public ReadOnly Property Conjugate As Quaternion
Get
Return New Quaternion(Me.A, -Me.B, -Me.C, -Me.D)
End Get
End Property
Public Overrides Function Equals(obj As Object) As Boolean
If TypeOf obj IsNot Quaternion Then Return False
Return Me.Equals(DirectCast(obj, Quaternion))
End Function
Public Overloads Function Equals(other As Quaternion) As Boolean Implements IEquatable(Of Quaternion).Equals
Return other = Me
End Function
Public Overloads Function Equals(other As Object, comparer As IEqualityComparer) As Boolean Implements IStructuralEquatable.Equals
If TypeOf other IsNot Quaternion Then Return False
Dim q = DirectCast(other, Quaternion)
Return comparer.Equals(Me.A, q.A) AndAlso
comparer.Equals(Me.B, q.B) AndAlso
comparer.Equals(Me.C, q.C) AndAlso
comparer.Equals(Me.D, q.D)
End Function
Public Overrides Function GetHashCode() As Integer
Return HashCode.Combine(Me.A, Me.B, Me.C, Me.D)
End Function
Public Overloads Function GetHashCode(comparer As IEqualityComparer) As Integer Implements IStructuralEquatable.GetHashCode
Return HashCode.Combine(
comparer.GetHashCode(Me.A),
comparer.GetHashCode(Me.B),
comparer.GetHashCode(Me.C),
comparer.GetHashCode(Me.D))
End Function
Public Overrides Function ToString() As String
Return $"Q({Me.A}, {Me.B}, {Me.C}, {Me.D})"
End Function
#Region "Operators"
Public Shared Operator =(left As Quaternion, right As Quaternion) As Boolean
Return left.A = right.A AndAlso
left.B = right.B AndAlso
left.C = right.C AndAlso
left.D = right.D
End Operator
Public Shared Operator <>(left As Quaternion, right As Quaternion) As Boolean
Return Not left = right
End Operator
Public Shared Operator +(q1 As Quaternion, q2 As Quaternion) As Quaternion
Return New Quaternion(q1.A + q2.A, q1.B + q2.B, q1.C + q2.C, q1.D + q2.D)
End Operator
Public Shared Operator -(q As Quaternion) As Quaternion
Return New Quaternion(-q.A, -q.B, -q.C, -q.D)
End Operator
Public Shared Operator *(q1 As Quaternion, q2 As Quaternion) As Quaternion
Return New Quaternion(
(q1.A * q2.A) - (q1.B * q2.B) - (q1.C * q2.C) - (q1.D * q2.D),
(q1.A * q2.B) + (q1.B * q2.A) + (q1.C * q2.D) - (q1.D * q2.C),
(q1.A * q2.C) - (q1.B * q2.D) + (q1.C * q2.A) + (q1.D * q2.B),
(q1.A * q2.D) + (q1.B * q2.C) - (q1.C * q2.B) + (q1.D * q2.A))
End Operator
Public Shared Widening Operator CType(d As Double) As Quaternion
Return New Quaternion(d, 0, 0, 0)
End Operator
#End Region
End Structure</syntaxhighlight>
Demonstration:
<syntaxhighlight lang="vbnet">Module Program
Sub Main()
Dim q As New Quaternion(1, 2, 3, 4),
q1 As New Quaternion(2, 3, 4, 5),
q2 As New Quaternion(3, 4, 5, 6),
r As Double = 7
Console.WriteLine($"q = {q}")
Console.WriteLine($"q1 = {q1}")
Console.WriteLine($"q2 = {q2}")
Console.WriteLine($"r = {r}")
Console.WriteLine($"q.Norm = {q.Norm}")
Console.WriteLine($"q1.Norm = {q1.Norm}")
Console.WriteLine($"q2.Norm = {q2.Norm}")
Console.WriteLine($"-q = {-q}")
Console.WriteLine($"q.Conjugate = {q.Conjugate}")
Console.WriteLine($"q + r = {q + r}")
Console.WriteLine($"q1 + q2 = {q1 + q2}")
Console.WriteLine($"q2 + q1 = {q2 + q1}")
Console.WriteLine($"q * r = {q * r}")
Console.WriteLine($"q1 * q2 = {q1 * q2}")
Console.WriteLine($"q2 * q1 = {q2 * q1}")
Console.WriteLine($"q1*q2 {If((q1 * q2) = (q2 * q1), "=", "!=")} q2*q1")
End Sub
End Module</syntaxhighlight>
{{out}}
<pre>q = Q(1, 2, 3, 4)
q1 = Q(2, 3, 4, 5)
q2 = Q(3, 4, 5, 6)
r = 7
q.Norm = 5.47722557505166
q1.Norm = 7.34846922834953
q2.Norm = 9.2736184954957
-q = Q(-1, -2, -3, -4)
q.Conjugate = Q(1, -2, -3, -4)
q + r = Q(8, 2, 3, 4)
q1 + q2 = Q(5, 7, 9, 11)
q2 + q1 = Q(5, 7, 9, 11)
q * r = Q(7, 14, 21, 28)
q1 * q2 = Q(-56, 16, 24, 26)
q2 * q1 = Q(-56, 18, 20, 28)
q1*q2 != q2*q1</pre>
=={{header|Wren}}==
<syntaxhighlight lang="wren">class Quaternion {
construct new(a, b, c, d ) {
_a = a
_b = b
_c = c
_d = d
}
a { _a }
b { _b }
c { _c }
d { _d }
norm { (a*a + b*b + c*c + d*d).sqrt }
- { Quaternion.new(-a, -b, -c, -d) }
conj { Quaternion.new(a, -b, -c, -d) }
+ (q) {
if (q is Num) return Quaternion.new(a + q, b, c, d)
return Quaternion.new(a + q.a, b + q.b, c + q.c, d + q.d)
}
* (q) {
if (q is Num) return Quaternion.new(a * q, b * q, c * q, d * q)
return Quaternion.new(a*q.a - b*q.b - c*q.c - d*q.d,
a*q.b + b*q.a + c*q.d - d*q.c,
a*q.c - b*q.d + c*q.a + d*q.b,
a*q.d + b*q.c - c*q.b + d*q.a)
}
== (q) { a == q.a && b == q.b && c == q.c && d == q.d }
!= (q) { !(this == q) }
toString { "(%(a), %(b), %(c), %(d))" }
static realAdd(r, q) { q + r }
static realMul(r, q) { q * r }
}
var q = Quaternion.new(1, 2, 3, 4)
var q1 = Quaternion.new(2, 3, 4, 5)
var q2 = Quaternion.new(3, 4, 5, 6)
var q3 = q1 * q2
var q4 = q2 * q1
var r = 7
System.print("q = %(q)")
System.print("q1 = %(q1)")
System.print("q2 = %(q2)")
System.print("r = %(r)")
System.print("norm(q) = %(q.norm)")
System.print("-q = %(-q)")
System.print("conj(q) = %(q.conj)")
System.print("r + q = %(Quaternion.realAdd(r, q))")
System.print("q + r = %(q + r))")
System.print("q1 + q2 = %(q1 + q2)")
System.print("q2 + q1 = %(q2 + q1)")
System.print("rq = %(Quaternion.realMul(r, q))")
System.print("qr = %(q * r)")
System.print("q1q2 = %(q3)")
System.print("q2q1 = %(q4)")
System.print("q1q2 ≠ q2q1 = %(q3 != q4)")</syntaxhighlight>
{{out}}
<pre>
q = (1, 2, 3, 4)
q1 = (2, 3, 4, 5)
q2 = (3, 4, 5, 6)
r = 7
norm(q) = 5.4772255750517
-q = (-1, -2, -3, -4)
conj(q) = (1, -2, -3, -4)
r + q = (8, 2, 3, 4)
q + r = (8, 2, 3, 4))
q1 + q2 = (5, 7, 9, 11)
q2 + q1 = (5, 7, 9, 11)
rq = (7, 14, 21, 28)
qr = (7, 14, 21, 28)
q1q2 = (-56, 16, 24, 26)
q2q1 = (-56, 18, 20, 28)
q1q2 ≠ q2q1 = true
</pre>
=={{header|XPL0}}==
<syntaxhighlight lang="xpl0">proc QPrint(Q); \Display quaternion
real Q;
[RlOut(0, Q(0)); Text(0, " + "); RlOut(0, Q(1)); Text(0, "i + ");
RlOut(0, Q(2)); Text(0, "j + "); RlOut(0, Q(3)); Text(0, "k");
CrLf(0);
];
func real QNorm(Q); \Return norm of a quaternion
real Q;
return sqrt( Q(0)*Q(0) + Q(1)*Q(1) + Q(2)*Q(2) + Q(3)*Q(3) );
func real QNeg(Q, R); \Return negative of a quaternion: Q:= -R
real Q, R;
[Q(0):= -R(0); Q(1):= -R(1); Q(2):= -R(2); Q(3):= -R(3);
return Q;
];
func real QConj(Q, R); \Return conjugate of a quaternion: Q:= conj R
real Q, R;
[Q(0):= R(0); Q(1):= -R(1); Q(2):= -R(2); Q(3):= -R(3);
return Q;
];
func real QRAdd(Q, R, Real); \Return quaternion plus real: Q:= R + Real
real Q, R, Real;
[Q(0):= R(0) + Real; Q(1):= R(1); Q(2):= R(2); Q(3):= R(3);
return Q;
];
func real QAdd(Q, R, S); \Return quaternion sum: Q:= R + S
real Q, R, S;
[Q(0):= R(0) + S(0); Q(1):= R(1) + S(1); Q(2):= R(2) + S(2); Q(3):= R(3) + S(3);
return Q;
];
func real QRMul(Q, R, Real); \Return quaternion times real: Q:= R + Real
real Q, R, Real;
[Q(0):= R(0) * Real; Q(1):= R(1) * Real; Q(2):= R(2) * Real; Q(3):= R(3) * Real;
return Q;
];
func real QMul(Q, R, S); \Return quaternion product: Q:= R * S
real Q, R, S;
[Q(0):= R(0)*S(0) - R(1)*S(1) - R(2)*S(2) - R(3)*S(3);
Q(1):= R(0)*S(1) + R(1)*S(0) + R(2)*S(3) - R(3)*S(2);
Q(2):= R(0)*S(2) - R(1)*S(3) + R(2)*S(0) + R(3)*S(1);
Q(3):= R(0)*S(3) + R(1)*S(2) - R(2)*S(1) + R(3)*S(0);
return Q;
];
real Q, Q1, Q2, R, Q0(4),;
[Q:= [1.0, 2.0, 3.0, 4.0];
Q1:= [2.0, 3.0, 4.0, 5.0];
Q2:= [3.0, 4.0, 5.0, 6.0];
R:= 7.0;
Format(3, 1);
Text(0, "q = "); QPrint(Q);
Text(0, "q1 = "); QPrint(Q1);
Text(0, "q2 = "); QPrint(Q2);
Text(0, "norm(q) = "); RlOut(0, QNorm(Q)); CrLf(0);
Text(0, "-q = "); QPrint(QNeg(Q0, Q));
Text(0, "conj(q) = "); QPrint(QConj(Q0, Q));
Text(0, "r + q = "); QPrint(QRAdd(Q0, Q, R));
Text(0, "q1 + q2 = "); QPrint(QAdd (Q0, Q1, Q2));
Text(0, "r * q = "); QPrint(QRMul(Q0, Q, R));
Text(0, "q1 * q2 = "); QPrint(QMul (Q0, Q1, Q2));
Text(0, "q2 * q1 = "); QPrint(QMul (Q0, Q2, Q1));
]</syntaxhighlight>
{{out}}
<pre>
q = 1.0 + 2.0i + 3.0j + 4.0k
q1 = 2.0 + 3.0i + 4.0j + 5.0k
q2 = 3.0 + 4.0i + 5.0j + 6.0k
norm(q) = 5.5
-q = -1.0 + -2.0i + -3.0j + -4.0k
conj(q) = 1.0 + -2.0i + -3.0j + -4.0k
r + q = 8.0 + 2.0i + 3.0j + 4.0k
q1 + q2 = 5.0 + 7.0i + 9.0j + 11.0k
r * q = 7.0 + 14.0i + 21.0j + 28.0k
q1 * q2 = -56.0 + 16.0i + 24.0j + 26.0k
q2 * q1 = -56.0 + 18.0i + 20.0j + 28.0k
</pre>
=={{header|zkl}}==
{{trans|D}}
<syntaxhighlight lang="zkl">class Quat{
fcn init(real=0,i1=0,i2=0,i3=0){
var [const] vector= // Quat(r,i,j,k) or Quat( (r,i,j,k) )
(if(List.isType(real)) real else vm.arglist).apply("toFloat");
var r,i,j,k; r,i,j,k=vector; // duplicate data for ease of coding
var [const] // properties: This is one way to do it
norm2=vector.apply("pow",2).sum(0.0), // Norm squared
abs=norm2.sqrt(), // Norm
arg=(r/abs()).acos(), // Theta !!!this may be incorrect...
;
}
fcn toString { String("[",vector.concat(","),"]") }
var [const proxy] // properties that need calculation (or are recursive)
conj =fcn{ Quat(r,-i,-j,-k) }, // Conjugate
recip =fcn{ n2:=norm2; Quat(r/n2,-i/n2,-j/n2,-k/n2) },// Reciprocal
pureim =fcn{ Quat(0, i, j, k) }, // Pure imagery
versor =fcn{ self / abs; }, // Unit versor
iversor=fcn{ pureim / pureim.abs; }, // Unit versor of imagery part
;
fcn __opEQ(z) { r == z.r and i == z.i and j == z.j and k == z.k }
fcn __opNEQ(z){ (not (self==z)) }
fcn __opNegate{ Quat(-r, -i, -j, -k) }
fcn __opAdd(z){
if (Quat.isInstanceOf(z)) Quat(vector.zipWith('+,z.vector));
else Quat(r+z,i,j,k);
}
fcn __opSub(z){
if (Quat.isInstanceOf(z)) Quat(vector.zipWith('-,z.vector));
else Quat(r-z,vector.xplode(1)); // same as above
}
fcn __opMul(z){
if (Quat.isInstanceOf(z)){
Quat(r*z.r - i*z.i - j*z.j - k*z.k,
r*z.i + i*z.r + j*z.k - k*z.j,
r*z.j - i*z.k + j*z.r + k*z.i,
r*z.k + i*z.j - j*z.i + k*z.r);
}
else Quat(vector.apply('*(z)));
}
fcn __opDiv(z){
if (Quat.isInstanceOf(z)) self*z.recip;
else Quat(r/z,i/z,j/z,k/z);
}
fcn pow(r){ exp(r*iversor*arg)*abs.pow(r) } // Power function
fcn log{ iversor*(r / abs).acos() + abs.log() }
fcn exp{ // e^q
inorm:=pureim.abs;
(iversor*inorm.sin() + inorm.cos()) * r.exp();
}
}</syntaxhighlight>
<syntaxhighlight lang="zkl"> // Demo code
r:=7;
q:=Quat(2,3,4,5); q1:=Quat(2,3,4,5); q2:=Quat(3,4,5,6);
println("1. norm: q.abs: ", q.abs);
println("2. -q: ", -q);
println("3. conjugate: q.conj: ", q.conj);
println("4. Quat(r) + q: ", Quat(r) + q);
println(" q + r: ", q + r);
println("5. q1 + q2: ", q1 + q2);
println("6. Quat(r) * q: ", Quat(r) * q);
println(" q * r: ", q * r);
println("7. q1 * q2: ", q1 * q2);
println(" q2 * q1: ", q2 * q1);
println("8. q1 * q2 == q2 * q1 ? ", q1 * q2 == q2 * q1);
i:=Quat(0,1); j:=Quat(0,0,1); k:=Quat(0,0,0,1);
println("9.1 i * i: ", i * i);
println(" J * j: ", j * j);
println(" k * k: ", k * k);
println(" i * j * k: ", i * j * k);
println("9.2 q1 / q2: ", q1 / q2);
println("9.3 q1 / q2 * q2: ", q1 / q2 * q2);
println(" q2 * q1 / q2: ", q2 * q1 / q2);
println("9.4 (i * pi).exp(): ", (i * (0.0).pi).exp());
println(" exp(j * pi): ", (j * (0.0).pi).exp());
println(" exp(k * pi): ", (k * (0.0).pi).exp());
println(" q.exp(): ", q.exp());
println(" q.log(): ", q.log());
println(" q.log().exp(): ", q.log().exp());
println(" q.exp().log(): ", q.exp().log());
s:=q.exp().log();
println("9.5 let s=q.exp().log(): ", s);
println(" s.exp(): ", s.exp());
println(" s.log(): ", s.log());
println(" s.log().exp(): ", s.log().exp());
println(" s.exp().log(): ", s.exp().log());</syntaxhighlight>
{{out}}
<pre>
1. norm: q.abs: 7.34847
2. -q: [-2,-3,-4,-5]
3. conjugate: q.conj: [2,-3,-4,-5]
4. Quat(r) + q: [9,3,4,5]
q + r: [9,3,4,5]
5. q1 + q2: [5,7,9,11]
6. Quat(r) * q: [14,21,28,35]
q * r: [14,21,28,35]
7. q1 * q2: [-56,16,24,26]
q2 * q1: [-56,18,20,28]
8. q1 * q2 == q2 * q1 ? False
9.1 i * i: [-1,0,0,0]
J * j: [-1,0,0,0]
k * k: [-1,0,0,0]
i * j * k: [-1,0,0,0]
9.2 q1 / q2: [0.790698,0.0232558,-2.77556e-17,0.0465116]
9.3 q1 / q2 * q2: [2,3,4,5]
q2 * q1 / q2: [2,3.46512,3.90698,4.76744]
9.4 (i * pi).exp(): [-1,1.22465e-16,0,0]
exp(j * pi): [-1,0,1.22465e-16,0]
exp(k * pi): [-1,0,0,1.22465e-16]
q.exp(): [5.21186,2.22222,2.96296,3.7037]
q.log(): [1.99449,0.549487,0.732649,0.915812]
q.log().exp(): [2,3,4,5]
q.exp().log(): [2,0.33427,0.445694,0.557117]
9.5 let s=q.exp().log(): [2,0.33427,0.445694,0.557117]
s.exp(): [5.21186,2.22222,2.96296,3.7037]
s.log(): [0.765279,0.159215,0.212286,0.265358]
s.log().exp(): [2,0.33427,0.445694,0.557117]
s.exp().log(): [2,0.33427,0.445694,0.557117]
</pre>
{{omit from|GUISS}}
[[Category:Geometry]]
| |||