Initial data commit

Task/Quaternion-type/00-META.yaml

@@ -0,0 +1,2 @@
+---
+from: http://rosettacode.org/wiki/Quaternion_type

Task/Quaternion-type/00-TASK.txt

@@ -0,0 +1,53 @@
+[[wp:Quaternion|Quaternions]]   are an extension of the idea of   [[Arithmetic/Complex|complex numbers]].
+
+A complex number has a real and complex part, &nbsp; sometimes written as &nbsp; <big> <code> a + bi, </code> </big> 
+<br>where &nbsp; <big> <code> a </code> </big> &nbsp; and &nbsp; <big> <code> b </code> </big> &nbsp; stand for real numbers, and &nbsp; <big> <code> i </code> </big> &nbsp; stands for the square root of minus 1.
+
+An example of a complex number might be &nbsp; <big> <code> -3 + 2i, </code> </big> &nbsp; 
+<br>where the real part, &nbsp; <big> <code> a </code> </big> &nbsp; is &nbsp; <big> <code> '''-3.0''' </code> </big> &nbsp; and the complex part, &nbsp; <big> <code> b </code> </big> &nbsp; is &nbsp; <big> <code> '''+2.0'''. </code> </big> 
+
+A quaternion has one real part and ''three'' imaginary parts, &nbsp; <big> <code> i, </code> </big> &nbsp; <big> <code> j, </code> </big> &nbsp; and &nbsp; <big> <code> k. </code> </big> 
+
+A quaternion might be written as &nbsp; <big> <code> a + bi + cj + dk. </code> </big>
+
+In the quaternion numbering system:
+:::* &nbsp; <big> <code> i∙i = j∙j = k∙k = i∙j∙k = -1, </code> </big> &nbsp; &nbsp; &nbsp; or more simply,
+:::* &nbsp; <big> <code> ii &nbsp;= jj &nbsp;= kk &nbsp;= ijk &nbsp; = -1. </code> </big>
+
+The order of multiplication is important, as, in general, for two quaternions:
+:::: &nbsp; <big> <code> q<sub>1</sub> </code> </big> &nbsp; and &nbsp; <big> <code> q<sub>2</sub>: </code> </big> &nbsp; &nbsp; <big> <code> q<sub>1</sub>q<sub>2</sub> &ne; q<sub>2</sub>q<sub>1</sub>. </code> </big>
+
+An example of a quaternion might be &nbsp; <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 &nbsp; <big> <code>i, </code> </big> &nbsp; <big> <code> j, </code> </big> &nbsp; and &nbsp; <big> <code> k </code> </big> &nbsp; are assumed by position. 
+
+So the example above would be written as &nbsp; <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 &nbsp; <big> <code> r = 7. </code> </big>
+
+
+Create functions &nbsp; (or classes) &nbsp; 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 &nbsp; <big> <code> r </code> </big> &nbsp; and a quaternion &nbsp; <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 &nbsp; <big> <code> q<sub>1</sub> </code> </big> &nbsp; and &nbsp; <big><code>q<sub>2</sub> </code> </big> &nbsp; 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> &nbsp; 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> &nbsp; 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> &nbsp; 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 &nbsp; <big> <code> q<sub>1</sub> </code> </big> &nbsp; and &nbsp; <big> <code> q<sub>2</sub>: <br> q<sub>1</sub>q<sub>2</sub> &ne; 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.:
+* &nbsp; [[Vector products]]
+* &nbsp; [http://www.maths.tcd.ie/pub/HistMath/People/Hamilton/QLetter/QLetter.pdf On Quaternions]; &nbsp; or on a new System of Imaginaries in Algebra. &nbsp; 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>
+

Task/Quaternion-type/ALGOL-68/quaternion-type-1.alg

@@ -0,0 +1,259 @@
+# -*- 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#, QUATSCAL #r#, QUATSCAL #i#, QUATSCAL #j#, QUATSCAL #k#)REF QUAT new,
+    PROC (REF QUAT #self#)QUAT conjugate,
+    PROC (REF QUAT #self#)QUATSCAL norm sq,
+    PROC (REF QUAT #self#)QUATSCAL norm,
+    PROC (REF QUAT #self#)QUAT reciprocal,
+    PROC (REF QUAT #self#)STRING repr,
+    PROC (REF QUAT #self#)QUAT neg,
+    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT add,
+    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT radd,
+    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT sub,
+    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT mul,
+    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT rmul,
+    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT div,
+    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT rdiv,
+    PROC (REF QUAT #self#)QUAT exp
+);
+
+CLASSQUAT class quat = (
+
+  # PROC new =#(REF QUAT new, QUATSCAL r, i, j, k)REF QUAT: (
+        # 'Defaults all parts of quaternion to zero' #
+        IF new ISNT REF QUAT(NIL) THEN new ELSE HEAP QUAT FI := (r, i, j, k)
+    ),
+
+  # PROC conjugate =#(REF QUAT self)QUAT:
+        (r OF self, -i OF self, -j OF self, -k OF self),
+
+  # PROC norm sq =#(REF QUAT self)QUATSCAL:
+        r OF self**2 + i OF self**2 + j OF self**2 + k OF self**2,
+
+  # PROC norm =#(REF QUAT self)QUATSCAL:
+        sqrt((norm sq OF class quat)(self)),
+
+  # PROC reciprocal =#(REF QUAT self)QUAT:(
+        QUATSCAL n2 = (norm sq OF class quat)(self);
+        QUAT conj = (conjugate OF class quat)(self);
+        (r OF conj/n2, i OF conj/n2, j OF conj/n2, k OF conj/n2)
+    ),
+
+  # PROC repr =#(REF QUAT self)STRING: (
+        # 'Shorter form of Quaternion as string' #
+        FILE f; STRING s; associate(f, s);
+        putf(f, (squat fmt, r OF self>=0, r OF self,
+             i OF self>=0, i OF self, j OF self>=0, j OF self, k OF self>=0, k OF self));
+        close(f);
+        s
+    ),
+
+  # PROC neg =#(REF QUAT self)QUAT:
+        (-r OF self, -i OF self, -j OF self, -k OF self),
+
+  # PROC add =#(REF QUAT self, SUBQUAT other)QUAT:
+        CASE other IN
+            (QUAT other): (r OF self + r OF other, i OF self + i OF other, j OF self + j OF other, k OF self + k OF other),
+            (QUATSUBSCAL other): (r OF self + QUATSCALINIT other, i OF self, j OF self, k OF self)
+        OUT IF quat fix type error(SKIP,"in add") THEN SKIP ELSE stop FI
+        ESAC,
+
+  # PROC radd =#(REF QUAT self, SUBQUAT other)QUAT:
+        (add OF class quat)(self, other),
+
+  # PROC sub =#(REF QUAT self, SUBQUAT other)QUAT:
+        CASE other IN
+            (QUAT other): (r OF self - r OF other, i OF self - i OF other, j OF self - j OF other, k OF self - k OF other),
+            (QUATSCAL other): (r OF self - other, i OF self, j OF self, k OF self)
+        OUT IF quat fix type error(self,"in sub") THEN SKIP ELSE stop FI
+        ESAC,
+
+  # PROC mul =#(REF QUAT self, SUBQUAT other)QUAT:
+        CASE other IN
+            (QUAT other):(
+                 r OF self*r OF other - i OF self*i  OF other - j OF self*j  OF other - k OF self*k  OF other,
+                 r OF self*i  OF other + i OF self*r OF other + j OF self*k  OF other - k OF self*j  OF other,
+                 r OF self*j  OF other - i OF self*k  OF other + j OF self*r OF other + k OF self*i  OF other,
+                 r OF self*k  OF other + i OF self*j  OF other - j OF self*i  OF other + k OF self*r OF other
+            ),
+            (QUATSCAL other): ( r OF self * other, i OF self * other, j OF self * other, k OF self * other)
+        OUT IF quat fix type error(self,"in mul") THEN SKIP ELSE stop FI
+        ESAC,
+
+  # PROC rmul =#(REF QUAT self, SUBQUAT other)QUAT:
+        CASE other IN
+          (QUAT other): (mul OF class quat)(LOC QUAT := other, self),
+          (QUATSCAL other): (mul OF class quat)(self, other)
+        OUT IF quat fix type error(self,"in rmul") THEN SKIP ELSE stop FI
+        ESAC,
+
+  # PROC div =#(REF QUAT self, SUBQUAT other)QUAT:
+        CASE other IN
+            (QUAT other): (mul OF class quat)(self, (reciprocal OF class quat)(LOC QUAT := other)),
+            (QUATSCAL other): (mul OF class quat)(self, 1/other)
+        OUT IF quat fix type error(self,"in div") THEN SKIP ELSE stop FI
+        ESAC,
+
+  # PROC rdiv =#(REF QUAT self, SUBQUAT other)QUAT:
+        CASE other IN
+          (QUAT other): (div OF class quat)(LOC QUAT := other, self),
+          (QUATSCAL other): (div OF class quat)(LOC QUAT := (other, 0, 0, 0), self)
+        OUT IF quat fix type error(self,"in rdiv") THEN SKIP ELSE stop FI
+        ESAC,
+
+  # PROC exp =#(REF QUAT self)QUAT: (
+    QUAT fac := self;
+    QUAT sum := 1.0 + fac;
+    FOR i FROM 2 TO bits width WHILE ABS(fac + quat small scal) /= quat small scal DO
+      VOID(sum +:= (fac *:= self / ##QUATSCAL(i)))
+    OD;
+    sum
+  )
+);
+
+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 QUATINIT = (COQUAT lhs)REF QUAT: (HEAP QUAT)INIT lhs;
+
+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)QUATSCAL:   (norm OF class quat)(LOC 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, COQUAT b)QUAT: a:=( add OF class quat)(a, b),
+   +=: = (QUAT a, REF QUAT b)QUAT: b:=(radd OF class quat)(b, a),
+   +=: = (COQUAT a, REF QUAT b)QUAT: b:=(radd OF class quat)(b, a);
+# missing: Worthy PLUSAB, PLUSTO for SHORT/LONG INT QUATSCAL & COMPL #
+
+OP -:= = (REF QUAT a, QUAT b)QUAT: a:=( sub OF class quat)(a, b),
+   -:= = (REF QUAT a, COQUAT b)QUAT: a:=( sub OF class quat)(a, b);
+# missing: Worthy MINUSAB for SHORT/LONG INT ##COQUAT & COMPL #
+
+PRIO *=: = 1, /=: = 1;
+OP *:= = (REF QUAT a, QUAT b)QUAT: a:=( mul OF class quat)(a, b),
+   *:= = (REF QUAT a, COQUAT b)QUAT: a:=( mul OF class quat)(a, b),
+   *=: = (QUAT a, REF QUAT b)QUAT: b:=(rmul OF class quat)(b, a),
+   *=: = (COQUAT a, REF QUAT b)QUAT: b:=(rmul OF class quat)(b, a);
+# missing: Worthy TIMESAB, TIMESTO for SHORT/LONG INT ##COQUAT & COMPL #
+
+OP /:= = (REF QUAT a, QUAT b)QUAT: a:=( div OF class quat)(a, b),
+   /:= = (REF QUAT a, COQUAT b)QUAT: a:=( div OF class quat)(a, b),
+   /=: = (QUAT a, REF QUAT b)QUAT: b:=(rdiv OF class quat)(b, a),
+   /=: = (COQUAT a, REF QUAT b)QUAT: b:=(rdiv OF class quat)(b, a);
+# missing: Worthy OVERAB, OVERTO for SHORT/LONG INT ##COQUAT & COMPL #
+
+OP + = (QUAT a, b)QUAT:      ( add OF class quat)(LOC QUAT := a, b),
+   + = (QUAT a, COQUAT b)QUAT: ( add OF class quat)(LOC QUAT := a, b),
+   + = (COQUAT a, QUAT b)QUAT: (radd OF class quat)(LOC QUAT := b, a);
+
+OP - = (QUAT a, b)QUAT:      ( sub OF class quat)(LOC QUAT := a, b),
+   - = (QUAT a, COQUAT b)QUAT: ( sub OF class quat)(LOC QUAT := a, b),
+   - = (COQUAT a, QUAT b)QUAT:-( sub OF class quat)(LOC QUAT := b, a);
+
+OP * = (QUAT a, b)QUAT:      ( mul OF class quat)(LOC QUAT := a, b),
+   * = (QUAT a, COQUAT b)QUAT: ( mul OF class quat)(LOC QUAT := a, b),
+   * = (COQUAT a, QUAT b)QUAT: (rmul OF class quat)(LOC QUAT := b, a);
+
+OP / = (QUAT a, b)QUAT:      ( div OF class quat)(LOC QUAT := a, b),
+   / = (QUAT a, COQUAT b)QUAT: ( div OF class quat)(LOC QUAT := a, b),
+   / = (COQUAT a, QUAT b)QUAT:
+         ( 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 #

Task/Quaternion-type/ALGOL-68/quaternion-type-2.alg

@@ -0,0 +1,55 @@
+#!/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:(
+    REAL r = 7;
+    QUAT q  = (1, 2, 3, 4),
+         q1 = (2, 3, 4, 5),
+         q2 = (3, 4, 5, 6);
+
+    printf((
+        $"r = "      f(quat scal fmt)l$, r,
+        $"q = "      f(quat fmt)l$, q,
+        $"q1 = "     f(quat fmt)l$, q1,
+        $"q2 = "     f(quat fmt)l$, q2,
+        $"ABS q = "  f(quat scal fmt)", "$, ABS q,
+        $"ABS q1 = " f(quat scal fmt)", "$, ABS q1,
+        $"ABS q2 = " f(quat scal fmt)l$, ABS q2,
+        $"-q = "     f(quat fmt)l$, -q,
+        $"CONJ q = " f(quat fmt)l$, CONJ q,
+        $"r + q = "  f(quat fmt)l$, r + q,
+        $"q + r = "  f(quat fmt)l$, q + r,
+        $"q1 + q2 = "f(quat fmt)l$, q1 + q2,
+        $"q2 + q1 = "f(quat fmt)l$, q2 + q1,
+        $"q * r = "  f(quat fmt)l$, q * r,
+        $"r * q = "  f(quat fmt)l$, r * q,
+        $"q1 * q2 = "f(quat fmt)l$, q1 * q2,
+        $"q2 * q1 = "f(quat fmt)l$, q2 * q1
+    ));
+
+CO
+        $"ASSERT q1 * q2 != q2 * q1 = "f(quat fmt)l$, ASSERT q1 * q2 != q2 * q1, $l$;
+END CO
+
+    printf((
+        $"i*i = "         f(quat fmt)l$, i*i,
+        $"j*j = "         f(quat fmt)l$, j*j,
+        $"k*k = "         f(quat fmt)l$, k*k,
+        $"i*j*k = "       f(quat fmt)l$, i*j*k,
+        $"q1 / q2 = "     f(quat fmt)l$, q1 / q2,
+        $"q1 / q2 * q2 = "f(quat fmt)l$, q1 / q2 * q2,
+        $"q2 * q1 / q2 = "f(quat fmt)l$, q2 * q1 / q2,
+        $"1/q1 * q1 = "   f(quat fmt)l$, 1.0/q1 * q1,
+        $"q1 / q1 = "     f(quat fmt)l$, q1 / q1,
+        $"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 * k) = " f(quat fmt)l$, quat exp(pi * k)
+    ));
+    print((REPR(-q1*q2), ", ", REPR(-q2*q1), new line))
+)

Task/Quaternion-type/ALGOL-W/quaternion-type.alg

@@ -0,0 +1,101 @@
+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.

Task/Quaternion-type/ATS/quaternion-type.ats

@@ -0,0 +1,266 @@
+//--------------------------------------------------------------------
+
+#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
+
+//--------------------------------------------------------------------

Task/Quaternion-type/Action-/quaternion-type.action

@@ -0,0 +1,164 @@
+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

Task/Quaternion-type/Ada/quaternion-type-1.ada

@@ -0,0 +1,16 @@
+generic
+   type Real is digits <>;
+package Quaternions is
+   type Quaternion is record
+      A, B, C, D : Real;
+   end record;
+   function "abs" (Left : Quaternion) return Real;
+   function Conj (Left : Quaternion) return Quaternion;
+   function "-" (Left : Quaternion) return Quaternion;
+   function "+" (Left, Right : Quaternion) return Quaternion;
+   function "-" (Left, Right : Quaternion) return Quaternion;
+   function "*" (Left : Quaternion; Right : Real) return Quaternion;
+   function "*" (Left : Real; Right : Quaternion) return Quaternion;
+   function "*" (Left, Right : Quaternion) return Quaternion;
+   function Image (Left : Quaternion) return String;
+end Quaternions;

Task/Quaternion-type/Ada/quaternion-type-2.ada

@@ -0,0 +1,59 @@
+with Ada.Numerics.Generic_Elementary_Functions;
+package body Quaternions is
+   package Elementary_Functions is
+      new Ada.Numerics.Generic_Elementary_Functions (Real);
+   use Elementary_Functions;
+   function "abs" (Left : Quaternion) return Real is
+   begin
+      return Sqrt (Left.A**2 + Left.B**2 + Left.C**2 + Left.D**2);
+   end "abs";
+   function Conj (Left : Quaternion) return Quaternion is
+   begin
+      return (A => Left.A, B => -Left.B, C => -Left.C, D => -Left.D);
+   end Conj;
+   function "-" (Left : Quaternion) return Quaternion is
+   begin
+      return (A => -Left.A, B => -Left.B, C => -Left.C, D => -Left.D);
+   end "-";
+   function "+" (Left, Right : Quaternion) return Quaternion is
+   begin
+      return
+      (  A => Left.A + Right.A, B => Left.B + Right.B,
+         C => Left.C + Right.C, D => Left.D + Right.D
+      );
+   end "+";
+   function "-" (Left, Right : Quaternion) return Quaternion is
+   begin
+      return
+      (  A => Left.A - Right.A, B => Left.B - Right.B,
+         C => Left.C - Right.C, D => Left.D - Right.D
+      );
+   end "-";
+   function "*" (Left : Quaternion; Right : Real) return Quaternion is
+   begin
+      return
+      (  A => Left.A * Right, B => Left.B * Right,
+         C => Left.C * Right, D => Left.D * Right
+      );
+   end "*";
+   function "*" (Left : Real; Right : Quaternion) return Quaternion is
+   begin
+      return Right * Left;
+   end "*";
+   function "*" (Left, Right : Quaternion) return Quaternion is
+   begin
+      return
+      (  A => Left.A * Right.A - Left.B * Right.B - Left.C * Right.C - Left.D * Right.D,
+         B => Left.A * Right.B + Left.B * Right.A + Left.C * Right.D - Left.D * Right.C,
+         C => Left.A * Right.C - Left.B * Right.D + Left.C * Right.A + Left.D * Right.B,
+         D => Left.A * Right.D + Left.B * Right.C - Left.C * Right.B + Left.D * Right.A
+      );
+   end "*";
+   function Image (Left : Quaternion) return String is
+   begin
+      return Real'Image (Left.A) & " +"  &
+             Real'Image (Left.B) & "i +" &
+             Real'Image (Left.C) & "j +" &
+             Real'Image (Left.D) & "k";
+   end Image;
+end Quaternions;

Task/Quaternion-type/Ada/quaternion-type-3.ada

@@ -0,0 +1,26 @@
+with Ada.Text_IO;  use Ada.Text_IO;
+with Quaternions;
+procedure Test_Quaternion is
+   package Float_Quaternion is new Quaternions (Float);
+   use Float_Quaternion;
+   q  : Quaternion := (1.0, 2.0, 3.0, 4.0);
+   q1 : Quaternion := (2.0, 3.0, 4.0, 5.0);
+   q2 : Quaternion := (3.0, 4.0, 5.0, 6.0);
+   r  : Float      := 7.0;
+begin
+   Put_Line ("q = "       & Image (q));
+   Put_Line ("q1 = "      & Image (q1));
+   Put_Line ("q2 = "      & Image (q2));
+   Put_Line ("r ="        & Float'Image (r));
+   Put_Line ("abs q ="    & Float'Image (abs q));
+   Put_Line ("abs q1 ="   & Float' Image (abs q1));
+   Put_Line ("abs q2 ="   & Float' Image (abs q2));
+   Put_Line ("-q = "      & Image (-q));
+   Put_Line ("conj q = "  & Image (Conj (q)));
+   Put_Line ("q1 + q2 = " & Image (q1 + q2));
+   Put_Line ("q2 + q1 = " & Image (q2 + q1));
+   Put_Line ("q * r = "   & Image (q * r));
+   Put_Line ("r * q = "   & Image (r * q));
+   Put_Line ("q1 * q2 = " & Image (q1 * q2));
+   Put_Line ("q2 * q1 = " & Image (q2 * q1));
+end Test_Quaternion;

Task/Quaternion-type/Arturo/quaternion-type.arturo

@@ -0,0 +1,40 @@
+qnorm: $ => [sqrt fold & [x y] -> x + y*y]
+
+qneg: $ => [map & => neg]
+
+qconj: $[q] [@[q\0] ++ qneg drop q 1]
+
+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]

Task/Quaternion-type/AutoHotkey/quaternion-type.ahk

@@ -0,0 +1,72 @@
+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
+}

Task/Quaternion-type/Axiom/quaternion-type.axiom

@@ -0,0 +1,48 @@
+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

Task/Quaternion-type/BASIC256/quaternion-type.basic

@@ -0,0 +1,86 @@
+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))

Task/Quaternion-type/BBC-BASIC/quaternion-type.basic

@@ -0,0 +1,42 @@
+      DIM q(3), q1(3), q2(3), t(3)
+      q() = 1, 2, 3, 4
+      q1() = 2, 3, 4, 5
+      q2() = 3, 4, 5, 6
+      r = 7
+
+      PRINT "q = " FNq_show(q())
+      PRINT "q1 = " FNq_show(q1())
+      PRINT "q2 = " FNq_show(q2())
+      PRINT "r = "; r
+      PRINT "norm(q) = "; FNq_norm(q())
+      t() = q() : PROCq_neg(t()) : PRINT "neg(q) = " FNq_show(t())
+      t() = q() : PROCq_conj(t()) : PRINT "conjugate(q) = " FNq_show(t())
+      t() = q() : PROCq_addreal(t(),r) : PRINT "q + r = " FNq_show(t())
+      t() = q1() : PROCq_add(t(),q2()) : PRINT "q1 + q2 = " FNq_show(t())
+      t() = q2() : PROCq_add(t(),q1()) : PRINT "q2 + q1 = " FNq_show(t())
+      t() = q() : PROCq_mulreal(t(),r) : PRINT "qr = " FNq_show(t())
+      t() = q1() : PROCq_mul(t(),q2()) : PRINT "q1q2 = " FNq_show(t())
+      t() = q2() : PROCq_mul(t(),q1()) : PRINT "q2q1 = " FNq_show(t())
+      END
+
+      DEF FNq_norm(q()) = MOD(q())
+
+      DEF PROCq_neg(q()) : q() *= -1 : ENDPROC
+
+      DEF PROCq_conj(q()) : q() *= -1 : q(0) *= -1 : ENDPROC
+
+      DEF PROCq_addreal(q(), r) : q(0) += r : ENDPROC
+
+      DEF PROCq_add(q(), r()) : q() += r() : ENDPROC
+
+      DEF PROCq_mulreal(q(), r) : q() *= r : ENDPROC
+
+      DEF PROCq_mul(q(), r()) : LOCAL s() : DIM s(3,3)
+      s() = r(0), -r(1), -r(2), -r(3), r(1), r(0),  r(3), -r(2), \
+      \     r(2), -r(3),  r(0),  r(1), r(3), r(2), -r(1),  r(0)
+      q() = s() . q()
+      ENDPROC
+
+      DEF FNq_show(q()) : LOCAL i%, a$ : a$ = "("
+      FOR i% = 0 TO 3 : a$ += STR$(q(i%)) + ", " : NEXT
+      = LEFT$(LEFT$(a$)) + ")"

Task/Quaternion-type/C++/quaternion-type-1.cpp

@@ -0,0 +1,116 @@
+#include <iostream>
+using namespace std;
+
+template<class T = double>
+class Quaternion
+{
+public:
+  T w, x, y, z;
+
+  // Numerical constructor
+  Quaternion(const T &w, const T &x, const T &y, const T &z): w(w), x(x), y(y), z(z) {};
+  Quaternion(const T &x, const T &y, const T &z): w(T()), x(x), y(y), z(z) {}; // For 3-rotations
+  Quaternion(const T &r): w(r), x(T()), y(T()), z(T()) {};
+  Quaternion(): w(T()), x(T()), y(T()), z(T()) {};
+
+  // Copy constructor and assignment
+  Quaternion(const Quaternion &q): w(q.w), x(q.x), y(q.y), z(q.z) {};
+  Quaternion& operator=(const Quaternion &q) { w=q.w; x=q.x; y=q.y; z=q.z; return *this; }
+
+  // Unary operators
+  Quaternion operator-() const { return Quaternion(-w, -x, -y, -z); }
+  Quaternion operator~() const { return Quaternion(w, -x, -y, -z); } // Conjugate
+
+  // Norm-squared. SQRT would have to be made generic to be used here
+  T normSquared() const { return w*w + x*x + y*y + z*z; }
+
+  // In-place operators
+  Quaternion& operator+=(const T &r)
+    { w += r; return *this; }
+  Quaternion& operator+=(const Quaternion &q)
+    { w += q.w; x += q.x; y += q.y; z += q.z; return *this; }
+
+  Quaternion& operator-=(const T &r)
+    { w -= r; return *this; }
+  Quaternion& operator-=(const Quaternion &q)
+    { w -= q.w; x -= q.x; y -= q.y; z -= q.z; return *this; }
+
+  Quaternion& operator*=(const T &r)
+    { w *= r; x *= r; y *= r; z *= r; return *this; }
+  Quaternion& operator*=(const Quaternion &q)
+  {
+    T oldW(w), oldX(x), oldY(y), oldZ(z);
+    w = oldW*q.w - oldX*q.x - oldY*q.y - oldZ*q.z;
+    x = oldW*q.x + oldX*q.w + oldY*q.z - oldZ*q.y;
+    y = oldW*q.y + oldY*q.w + oldZ*q.x - oldX*q.z;
+    z = oldW*q.z + oldZ*q.w + oldX*q.y - oldY*q.x;
+    return *this;
+  }
+
+  Quaternion& operator/=(const T &r)
+    { w /= r; x /= r; y /= r; z /= r; return *this; }
+  Quaternion& operator/=(const Quaternion &q)
+  {
+    T oldW(w), oldX(x), oldY(y), oldZ(z), n(q.normSquared());
+    w = (oldW*q.w + oldX*q.x + oldY*q.y + oldZ*q.z) / n;
+    x = (oldX*q.w - oldW*q.x + oldY*q.z - oldZ*q.y) / n;
+    y = (oldY*q.w - oldW*q.y + oldZ*q.x - oldX*q.z) / n;
+    z = (oldZ*q.w - oldW*q.z + oldX*q.y - oldY*q.x) / n;
+    return *this;
+  }
+
+  // Binary operators based on in-place operators
+  Quaternion operator+(const T &r) const { return Quaternion(*this) += r; }
+  Quaternion operator+(const Quaternion &q) const { return Quaternion(*this) += q; }
+  Quaternion operator-(const T &r) const { return Quaternion(*this) -= r; }
+  Quaternion operator-(const Quaternion &q) const { return Quaternion(*this) -= q; }
+  Quaternion operator*(const T &r) const { return Quaternion(*this) *= r; }
+  Quaternion operator*(const Quaternion &q) const { return Quaternion(*this) *= q; }
+  Quaternion operator/(const T &r) const { return Quaternion(*this) /= r; }
+  Quaternion operator/(const Quaternion &q) const { return Quaternion(*this) /= q; }
+
+  // Comparison operators, as much as they make sense
+  bool operator==(const Quaternion &q) const
+    { return (w == q.w) && (x == q.x) && (y == q.y) && (z == q.z); }
+  bool operator!=(const Quaternion &q) const { return !operator==(q); }
+
+  // The operators above allow quaternion op real. These allow real op quaternion.
+  // Uses the above where appropriate.
+  template<class T> friend Quaternion<T> operator+(const T &r, const Quaternion<T> &q);
+  template<class T> friend Quaternion<T> operator-(const T &r, const Quaternion<T> &q);
+  template<class T> friend Quaternion<T> operator*(const T &r, const Quaternion<T> &q);
+  template<class T> friend Quaternion<T> operator/(const T &r, const Quaternion<T> &q);
+
+  // Allows cout << q
+  template<class T> friend ostream& operator<<(ostream &io, const Quaternion<T> &q);
+};
+
+// Friend functions need to be outside the actual class definition
+template<class T>
+Quaternion<T> operator+(const T &r, const Quaternion<T> &q)
+  { return q+r; }
+
+template<class T>
+Quaternion<T> operator-(const T &r, const Quaternion<T> &q)
+  { return Quaternion<T>(r-q.w, q.x, q.y, q.z); }
+
+template<class T>
+Quaternion<T> operator*(const T &r, const Quaternion<T> &q)
+  { return q*r; }
+
+template<class T>
+Quaternion<T> operator/(const T &r, const Quaternion<T> &q)
+{
+  T n(q.normSquared());
+  return Quaternion(r*q.w/n, -r*q.x/n, -r*q.y/n, -r*q.z/n);
+}
+
+template<class T>
+ostream& operator<<(ostream &io, const Quaternion<T> &q)
+{
+  io << q.w;
+  (q.x < T()) ? (io << " - " << (-q.x) << "i") : (io << " + " << q.x << "i");
+  (q.y < T()) ? (io << " - " << (-q.y) << "j") : (io << " + " << q.y << "j");
+  (q.z < T()) ? (io << " - " << (-q.z) << "k") : (io << " + " << q.z << "k");
+  return io;
+}

Task/Quaternion-type/C++/quaternion-type-2.cpp

@@ -0,0 +1,40 @@
+int main()
+{
+  Quaternion<> q0(1, 2, 3, 4);
+  Quaternion<> q1(2, 3, 4, 5);
+  Quaternion<> q2(3, 4, 5, 6);
+  double r = 7;
+
+  cout << "q0:      " << q0 << endl;
+  cout << "q1:      " << q1 << endl;
+  cout << "q2:      " << q2 << endl;
+  cout << "r:       " << r << endl;
+  cout << endl;
+  cout << "-q0:     " << -q0 << endl;
+  cout << "~q0:     " << ~q0 << endl;
+  cout << endl;
+  cout << "r * q0:  " << r*q0 << endl;
+  cout << "r + q0:  " << r+q0 << endl;
+  cout << "q0 / r:  " << q0/r << endl;
+  cout << "q0 - r:  " << q0-r << endl;
+  cout << endl;
+  cout << "q0 + q1: " << q0+q1 << endl;
+  cout << "q0 - q1: " << q0-q1 << endl;
+  cout << "q0 * q1: " << q0*q1 << endl;
+  cout << "q0 / q1: " << q0/q1 << endl;
+  cout << endl;
+  cout << "q0 * ~q0:     " << q0*~q0 << endl;
+  cout << "q0 + q1*q2:   " << q0+q1*q2 << endl;
+  cout << "(q0 + q1)*q2: " << (q0+q1)*q2 << endl;
+  cout << "q0*q1*q2:     " << q0*q1*q2 << endl;
+  cout << "(q0*q1)*q2:   " << (q0*q1)*q2 << endl;
+  cout << "q0*(q1*q2):   " << q0*(q1*q2) << endl;
+  cout << endl;
+  cout << "||q0||:  " << sqrt(q0.normSquared()) << endl;
+  cout << endl;
+  cout << "q0*q1 - q1*q0: " << (q0*q1 - q1*q0) << endl;
+
+  // Other base types
+  Quaternion<int> q5(2), q6(3);
+  cout << endl << q5*q6 << endl;
+}

Task/Quaternion-type/C-sharp/quaternion-type-1.cs

@@ -0,0 +1,90 @@
+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
+}

Task/Quaternion-type/C-sharp/quaternion-type-2.cs

@@ -0,0 +1,34 @@
+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) ? "==" : "!=");
+    }
+}

Task/Quaternion-type/C/quaternion-type-1.c

@@ -0,0 +1,131 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <math.h>
+
+typedef struct quaternion
+{
+  double q[4];
+} quaternion_t;
+
+
+quaternion_t *quaternion_new(void)
+{
+  return malloc(sizeof(quaternion_t));
+}
+
+quaternion_t *quaternion_new_set(double q1,
+				 double q2,
+				 double q3,
+				 double q4)
+{
+  quaternion_t *q = malloc(sizeof(quaternion_t));
+  if (q != NULL) {
+    q->q[0] = q1; q->q[1] = q2; q->q[2] = q3; q->q[3] = q4;
+  }
+  return q;
+}
+
+
+void quaternion_copy(quaternion_t *r, quaternion_t *q)
+{
+  size_t i;
+
+  if (r == NULL || q == NULL) return;
+  for(i = 0; i < 4; i++) r->q[i] = q->q[i];
+}
+
+
+double quaternion_norm(quaternion_t *q)
+{
+  size_t i;
+  double r = 0.0;
+
+  if (q == NULL) {
+    fprintf(stderr, "NULL quaternion in norm\n");
+    return 0.0;
+  }
+
+  for(i = 0; i < 4; i++) r += q->q[i] * q->q[i];
+  return sqrt(r);
+}
+
+
+void quaternion_neg(quaternion_t *r, quaternion_t *q)
+{
+  size_t i;
+
+  if (q == NULL || r == NULL) return;
+  for(i = 0; i < 4; i++) r->q[i] = -q->q[i];
+}
+
+
+void quaternion_conj(quaternion_t *r, quaternion_t *q)
+{
+  size_t i;
+
+  if (q == NULL || r == NULL) return;
+  r->q[0] = q->q[0];
+  for(i = 1; i < 4; i++) r->q[i] = -q->q[i];
+}
+
+
+void quaternion_add_d(quaternion_t *r, quaternion_t *q, double d)
+{
+  if (q == NULL || r == NULL) return;
+  quaternion_copy(r, q);
+  r->q[0] += d;
+}
+
+
+void quaternion_add(quaternion_t *r, quaternion_t *a, quaternion_t *b)
+{
+  size_t i;
+
+  if (r == NULL || a == NULL || b == NULL) return;
+  for(i = 0; i < 4; i++) r->q[i] = a->q[i] + b->q[i];
+}
+
+
+void quaternion_mul_d(quaternion_t *r, quaternion_t *q, double d)
+{
+  size_t i;
+
+  if (r == NULL || q == NULL) return;
+  for(i = 0; i < 4; i++) r->q[i] = q->q[i] * d;
+}
+
+bool quaternion_equal(quaternion_t *a, quaternion_t *b)
+{
+  size_t i;
+
+  for(i = 0; i < 4; i++) if (a->q[i] != b->q[i]) return false;
+  return true;
+}
+
+
+#define A(N) (a->q[(N)])
+#define B(N) (b->q[(N)])
+#define R(N) (r->q[(N)])
+void quaternion_mul(quaternion_t *r, quaternion_t *a, quaternion_t *b)
+{
+  size_t i;
+  double ri = 0.0;
+
+  if (r == NULL || a == NULL || b == NULL) return;
+  R(0) = A(0)*B(0) - A(1)*B(1) - A(2)*B(2) - A(3)*B(3);
+  R(1) = A(0)*B(1) + A(1)*B(0) + A(2)*B(3) - A(3)*B(2);
+  R(2) = A(0)*B(2) - A(1)*B(3) + A(2)*B(0) + A(3)*B(1);
+  R(3) = A(0)*B(3) + A(1)*B(2) - A(2)*B(1) + A(3)*B(0);
+}
+#undef A
+#undef B
+#undef R
+
+
+void quaternion_print(quaternion_t *q)
+{
+  if (q == NULL) return;
+  printf("(%lf, %lf, %lf, %lf)\n",
+	 q->q[0], q->q[1], q->q[2], q->q[3]);
+}

Task/Quaternion-type/C/quaternion-type-2.c

@@ -0,0 +1,58 @@
+int main()
+{
+  size_t i;
+  double d = 7.0;
+  quaternion_t *q[3];
+  quaternion_t *r  = quaternion_new();
+
+  quaternion_t *qd = quaternion_new_set(7.0, 0.0, 0.0, 0.0);
+  q[0] = quaternion_new_set(1.0, 2.0, 3.0, 4.0);
+  q[1] = quaternion_new_set(2.0, 3.0, 4.0, 5.0);
+  q[2] = quaternion_new_set(3.0, 4.0, 5.0, 6.0);
+
+  printf("r = %lf\n", d);
+
+  for(i = 0; i < 3; i++) {
+    printf("q[%u] = ", i);
+    quaternion_print(q[i]);
+    printf("abs q[%u] = %lf\n", i, quaternion_norm(q[i]));
+  }
+
+  printf("-q[0] = ");
+  quaternion_neg(r, q[0]);
+  quaternion_print(r);
+
+  printf("conj q[0] = ");
+  quaternion_conj(r, q[0]);
+  quaternion_print(r);
+
+  printf("q[1] + q[2] = ");
+  quaternion_add(r, q[1], q[2]);
+  quaternion_print(r);
+
+  printf("q[2] + q[1] = ");
+  quaternion_add(r, q[2], q[1]);
+  quaternion_print(r);
+
+
+  printf("q[0] * r = ");
+  quaternion_mul_d(r, q[0], d);
+  quaternion_print(r);
+
+  printf("q[0] * (r, 0, 0, 0) = ");
+  quaternion_mul(r, q[0], qd);
+  quaternion_print(r);
+
+
+  printf("q[1] * q[2] = ");
+  quaternion_mul(r, q[1], q[2]);
+  quaternion_print(r);
+
+  printf("q[2] * q[1] = ");
+  quaternion_mul(r, q[2], q[1]);
+  quaternion_print(r);
+
+
+  free(q[0]); free(q[1]); free(q[2]); free(r);
+  return EXIT_SUCCESS;
+}

Task/Quaternion-type/CLU/quaternion-type.clu

@@ -0,0 +1,82 @@
+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

Task/Quaternion-type/Common-Lisp/quaternion-type.lisp

@@ -0,0 +1,77 @@
+(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 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))))
+
+(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-b x) (q-b 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-b y)
+           (q-c y)
+           (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-b 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)))

Task/Quaternion-type/Crystal/quaternion-type.crystal

@@ -0,0 +1,89 @@
+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 * rhs.a - b * rhs.b - c * rhs.c - d * rhs.d,
+      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
+
+q0 = Quaternion.new(a: 1, b: 2, c: 3, d: 4)
+q1 = Quaternion.new(2, 3, 4, 5)
+q2 = Quaternion.new(3, 4, 5, 6)
+r  = 7
+
+puts "q0 = #{q0}"
+puts "q1 = #{q1}"
+puts "q2 = #{q2}"
+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)}"

Task/Quaternion-type/D/quaternion-type.d

@@ -0,0 +1,226 @@
+import std.math, std.numeric, std.traits, std.conv, std.complex;
+
+
+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 pure /*nothrow*/ @safe {
+        return vector.text;
+    }
+
+    @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 @safe @nogc
+    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 @safe @nogc
+    if (isNumeric!U) {
+        return re == r && i == 0 && j == 0 && k == 0;
+    }
+
+    /// Unary op.
+    Quat!T opUnary(string op)() const pure nothrow @safe @nogc
+    if (op == "+") {
+        return this;
+    }
+
+    Quat!T opUnary(string op)() const pure nothrow @safe @nogc
+    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;
+
+        static if (op == "+" ) {
+            return C(re + z.re, i + z.i, j + z.j, k + z.k);
+        } else static if (op == "-") {
+            return C(re - z.re, i - z.i, j - z.j, k - z.k);
+        } else static if (op == "*") {
+            return C(re * z.re - i * z.i  - j * z.j  - k * z.k,
+                     re * z.i  + i * z.re + j * z.k  - k * z.j,
+                     re * z.j  - i * z.k  + j * z.re + k * z.i,
+                     re * z.k  + i * z.j  - j * z.i  + k * z.re);
+        } else static if (op == "/") {
+            return this * z.recip;
+        }
+    }
+
+    /// 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 @safe @nogc
+    if (isNumeric!U) {
+        alias typeof(return) C;
+
+        static if (op == "+" ) {
+            return C(re + r, i, j, k);
+        } else static if (op == "-") {
+            return C(re - r, i, j, k);
+        } else static if (op == "*") {
+            return C(re * r, i * r, j * r, k * r);
+        } else static if (op == "/") {
+            return C(re / r, i / r, j / r, k / r);
+        } else static if (op == "^^") {
+            return pow(r);
+        }
+    }
+
+    /// Power function.
+    Quat!(CommonType!(T,U)) pow(U)(U r)
+    const pure nothrow @safe @nogc
+    if (isNumeric!U) {
+        return (abs^^r) * exp(r * iversor * arg);
+    }
+
+    /// Handle binary op if Quaternion on right of op and left is
+    /// 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);
+        return w.opBinary!(op)(this);
+    }
+
+    Quat!(CommonType!(T,U)) opBinaryRight(string op, U)(U r)
+    const pure nothrow @safe @nogc
+    if (isNumeric!U) {
+        alias typeof(return) C;
+
+        static if (op == "+" || op == "*") {
+            return opBinary!op(r);
+        } else static if (op == "-") {
+            return C(r - re , -i, -j, -k);
+        } else static if (op == "/") {
+            auto w = C(re, i, j, k);
+            return w.recip * r;
+        }
+    }
+}
+
+
+HT exp(HT)(HT z) pure nothrow @safe @nogc
+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 @safe @nogc
+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;
+
+    alias QR = Quat!real;
+    enum real r = 7.0;
+
+    immutable QR q  = QR(2, 3, 4, 5),
+                 q1 = QR(2, 3, 4, 5),
+                 q2 = QR(3, 4, 5, 6);
+
+    writeln("1.             q - norm: ", q.abs);
+    writeln("2.         q - negative: ", -q);
+    writeln("3.        q - conjugate: ", q.conj);
+    writeln("4.                r + q: ", r + q);
+    writeln("                  q + r: ", q + r);
+    writeln("5.              q1 + q2: ", q1 + q2);
+    writeln("6.                r * q: ", r * q);
+    writeln("                  q * r: ", q * r);
+    writeln("7.              q1 * q2: ", q1 * q2);
+    writeln("                q2 * q1: ", q2 * q1);
+    writeln("8.  q1 * q2 != q2 * Q1 ? ", q1 * q2 != q2 * q1);
+
+    immutable QR i = QR(0, 1, 0, 0),
+                 j = QR(0, 0, 1, 0),
+                 k = QR(0, 0, 0, 1);
+    writeln("9.1               i * i: ", i * i);
+    writeln("                  J * j: ", j * j);
+    writeln("                  k * k: ", k * k);
+    writeln("              i * j * k: ", i * j * k);
+    writeln("9.2             q1 / q2: ", q1 / q2);
+    writeln("9.3        q1 / q2 * q2: ", q1 / q2 * q2);
+    writeln("           q2 * q1 / q2: ", q2 * q1 / q2);
+    writeln("9.4         exp(pi * i): ", exp(PI * i));
+    writeln("            exp(pi * j): ", exp(PI * j));
+    writeln("            exp(pi * k): ", exp(PI * k));
+    writeln("                 exp(q): ", exp(q));
+    writeln("                 log(q): ", log(q));
+    writeln("            exp(log(q)): ", exp(log(q)));
+    writeln("            log(exp(q)): ", log(exp(q)));
+    immutable s = q.exp.log;
+    writeln("9.5 let s = log(exp(q)): ", s);
+    writeln("                 exp(s): ", exp(s));
+    writeln("                 log(s): ", log(s));
+    writeln("            exp(log(s)): ", exp(log(s)));
+    writeln("            log(exp(s)): ", log(exp(s)));
+}

Task/Quaternion-type/Delphi/quaternion-type-1.delphi

@@ -0,0 +1,129 @@
+unit Quaternions;
+
+interface
+
+type
+
+  TQuaternion = record
+    A, B, C, D: double;
+
+    function  Init          (aA, aB, aC, aD : double): TQuaternion;
+    function  Norm          : double;
+    function  Conjugate     : TQuaternion;
+    function  ToString      : string;
+
+    class operator Negative (Left : TQuaternion): TQuaternion;
+    class operator Positive (Left : TQuaternion): TQuaternion;
+    class operator Add      (Left, Right : TQuaternion): TQuaternion;
+    class operator Add      (Left : TQuaternion; Right : double): TQuaternion; overload;
+    class operator Add      (Left : double; Right : TQuaternion): TQuaternion; overload;
+    class operator Subtract (Left, Right : TQuaternion): TQuaternion;
+    class operator Multiply (Left, Right : TQuaternion): TQuaternion;
+    class operator Multiply (Left : TQuaternion; Right : double): TQuaternion; overload;
+    class operator Multiply (Left : double; Right : TQuaternion): TQuaternion; overload;
+  end;
+
+implementation
+
+uses
+  SysUtils;
+
+{ TQuaternion }
+
+function TQuaternion.Init(aA, aB, aC, aD: double): TQuaternion;
+begin
+  A := aA;
+  B := aB;
+  C := aC;
+  D := aD;
+
+  result := Self;
+end;
+
+function TQuaternion.Norm: double;
+begin
+  result := sqrt(sqr(A) + sqr(B) + sqr(C) + sqr(D));
+end;
+
+function TQuaternion.Conjugate: TQuaternion;
+begin
+  result.B := -B;
+  result.C := -C;
+  result.D := -D;
+end;
+
+class operator TQuaternion.Negative(Left: TQuaternion): TQuaternion;
+begin
+  result.A := -Left.A;
+  result.B := -Left.B;
+  result.C := -Left.C;
+  result.D := -Left.D;
+end;
+
+class operator TQuaternion.Positive(Left: TQuaternion): TQuaternion;
+begin
+  result := Left;
+end;
+
+class operator TQuaternion.Add(Left, Right: TQuaternion): TQuaternion;
+begin
+  result.A := Left.A + Right.A;
+  result.B := Left.B + Right.B;
+  result.C := Left.C + Right.C;
+  result.D := Left.D + Right.D;
+end;
+
+class operator TQuaternion.Add(Left: TQuaternion; Right: double): TQuaternion;
+begin
+  result.A := Left.A + Right;
+  result.B := Left.B;
+  result.C := Left.C;
+  result.D := Left.D;
+end;
+
+class operator TQuaternion.Add(Left: double; Right: TQuaternion): TQuaternion;
+begin
+  result.A := Left + Right.A;
+  result.B := Right.B;
+  result.C := Right.C;
+  result.D := Right.D;
+end;
+
+class operator TQuaternion.Subtract(Left, Right: TQuaternion): TQuaternion;
+begin
+  result.A := Left.A - Right.A;
+  result.B := Left.B - Right.B;
+  result.C := Left.C - Right.C;
+  result.D := Left.D - Right.D;
+end;
+
+class operator TQuaternion.Multiply(Left, Right: TQuaternion): TQuaternion;
+begin
+  result.A := Left.A * Right.A - Left.B * Right.B - Left.C * Right.C - Left.D * Right.D;
+  result.B := Left.A * Right.B + Left.B * Right.A + Left.C * Right.D - Left.D * Right.C;
+  result.C := Left.A * Right.C - Left.B * Right.D + Left.C * Right.A + Left.D * Right.B;
+  result.D := Left.A * Right.D + Left.B * Right.C - Left.C * Right.B + Left.D * Right.A;
+end;
+
+class operator TQuaternion.Multiply(Left: double; Right: TQuaternion): TQuaternion;
+begin
+  result.A := Left * Right.A;
+  result.B := Left * Right.B;
+  result.C := Left * Right.C;
+  result.D := Left * Right.D;
+end;
+
+class operator TQuaternion.Multiply(Left: TQuaternion; Right: double): TQuaternion;
+begin
+  result.A := Left.A * Right;
+  result.B := Left.B * Right;
+  result.C := Left.C * Right;
+  result.D := Left.D * Right;
+end;
+
+function TQuaternion.ToString: string;
+begin
+  result := Format('%f + %fi + %fj + %fk', [A, B, C, D]);
+end;
+
+end.

Task/Quaternion-type/Delphi/quaternion-type-2.delphi

@@ -0,0 +1,32 @@
+program QuaternionTest;
+
+{$APPTYPE CONSOLE}
+
+uses
+  Quaternions in 'Quaternions.pas';
+
+var
+  r : double;
+  q, q1, q2 : TQuaternion;
+begin
+  r := 7;
+  q  := q .Init(1, 2, 3, 4);
+  q1 := q1.Init(2, 3, 4, 5);
+  q2 := q2.Init(3, 4, 5, 6);
+
+  writeln('q  = ', q.ToString);
+  writeln('q1 = ', q1.ToString);
+  writeln('q2 = ', q2.ToString);
+  writeln('r  = ', r);
+  writeln('Norm(q ) = ', q.Norm);
+  writeln('Norm(q1) = ', q1.Norm);
+  writeln('Norm(q2) = ', q2.Norm);
+  writeln('-q = ', (-q).ToString);
+  writeln('Conjugate q = ', q.Conjugate.ToString);
+  writeln('q1 + q2 = ', (q1 + q2).ToString);
+  writeln('q2 + q1 = ', (q2 + q1).ToString);
+  writeln('q * r   = ', (q * r).ToString);
+  writeln('r * q   = ', (r * q).ToString);
+  writeln('q1 * q2 = ', (q1 * q2).ToString);
+  writeln('q2 * q1 = ', (q2 * q1).ToString);
+end.

Task/Quaternion-type/E/quaternion-type-1.e

@@ -0,0 +1,61 @@
+interface Quaternion guards QS {}
+def makeQuaternion(a, b, c, d) {
+    return def quaternion implements QS {
+
+        to __printOn(out) {
+            out.print("(", a, " + ", b, "i + ")
+            out.print(c, "j + ", d, "k)")
+        }
+
+        # Task requirement 1
+        to norm() {
+            return (a**2 + b**2 + c**2 + d**2).sqrt()
+        }
+
+        # Task requirement 2
+        to negate() {
+            return makeQuaternion(-a, -b, -c, -d)
+        }
+
+        # Task requirement 3
+        to conjugate() {
+            return makeQuaternion(a, -b, -c, -d)
+        }
+
+        # Task requirement 4, 5
+        # This implements q + r; r + q is deliberately prohibited by E
+        to add(other :any[Quaternion, int, float64]) {
+            switch (other) {
+              match q :Quaternion {
+                return makeQuaternion(
+                    a+q.a(), b+q.b(), c+q.c(), d+q.d())
+              }
+              match real {
+                return makeQuaternion(a+real, b, c, d)
+              }
+            }
+        }
+
+        # Task requirement 6, 7
+        # This implements q * r; r * q is deliberately prohibited by E
+        to multiply(other :any[Quaternion, int, float64]) {
+            switch (other) {
+                match q :Quaternion {
+                    return makeQuaternion(
+                        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())
+                    }
+                match real {
+                    return makeQuaternion(real*a, real*b, real*c, real*d)
+                }
+            }
+        }
+
+        to a() { return a }
+        to b() { return b }
+        to c() { return c }
+        to d() { return d }
+    }
+}

Task/Quaternion-type/E/quaternion-type-2.e

@@ -0,0 +1,17 @@
+? def q1 := makeQuaternion(2,3,4,5)
+# value: (2 + 3i + 4j + 5k)
+
+? def q2 := makeQuaternion(3,4,5,6)
+# value: (3 + 4i + 5j + 6k)
+
+? q1+q2
+# value: (5 + 7i + 9j + 11k)
+
+? q1*q2
+# value: (-56 + 16i + 24j + 26k)
+
+? q2*q1
+# value: (-56 + 18i + 20j + 28k)
+
+? q1+(-2)
+# value: (0 + 3i + 4j + 5k)

Task/Quaternion-type/ERRE/quaternion-type.erre

@@ -0,0 +1,104 @@
+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

Task/Quaternion-type/Eero/quaternion-type.eero

@@ -0,0 +1,102 @@
+#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

Task/Quaternion-type/Elena/quaternion-type.elena

@@ -0,0 +1,88 @@
+import system'math;
+import extensions;
+import extensions'text;
+
+struct Quaternion
+{
+    rprop real A;
+    rprop real B;
+    rprop real C;
+    rprop real D;
+
+    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("==","!="))
+}

Task/Quaternion-type/Euphoria/quaternion-type.euphoria

@@ -0,0 +1,48 @@
+function norm(sequence q)
+    return sqrt(power(q[1],2)+power(q[2],2)+power(q[3],2)+power(q[4],2))
+end function
+
+function conj(sequence q)
+    q[2..4] = -q[2..4]
+    return q
+end function
+
+function add(object q1, object q2)
+    if atom(q1) != atom(q2) then
+        if atom(q1) then
+            q1 = {q1,0,0,0}
+        else
+            q2 = {q2,0,0,0}
+        end if
+    end if
+    return q1+q2
+end function
+
+function mul(object q1, object q2)
+    if sequence(q1) and sequence(q2) then
+        return { q1[1]*q2[1] - q1[2]*q2[2] - q1[3]*q2[3] - q1[4]*q2[4],
+                 q1[1]*q2[2] + q1[2]*q2[1] + q1[3]*q2[4] - q1[4]*q2[3],
+                 q1[1]*q2[3] - q1[2]*q2[4] + q1[3]*q2[1] + q1[4]*q2[2],
+                 q1[1]*q2[4] + q1[2]*q2[3] - q1[3]*q2[2] + q1[4]*q2[1] }
+    else
+        return q1*q2
+    end if
+end function
+
+function quats(sequence q)
+    return sprintf("%g + %gi + %gj + %gk",q)
+end function
+
+constant
+    q  = {1, 2, 3, 4},
+    q1 = {2, 3, 4, 5},
+    q2 = {5, 6, 7, 8},
+    r  = 7
+
+printf(1, "norm(q) = %g\n", norm(q))
+printf(1, "-q = %s\n", {quats(-q)})
+printf(1, "conj(q) = %s\n", {quats(conj(q))})
+printf(1, "q + r = %s\n", {quats(add(q,r))})
+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))})

Task/Quaternion-type/F-Sharp/quaternion-type.fs

@@ -0,0 +1,63 @@
+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

Task/Quaternion-type/Factor/quaternion-type.factor

@@ -0,0 +1,27 @@
+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
+]

Task/Quaternion-type/Forth/quaternion-type.fth

@@ -0,0 +1,77 @@
+: quaternions  4 * floats ;
+
+: qvariable create 1 quaternions allot ;
+
+: q! ( a b c d q -- )
+  dup 3 floats + f!  dup 2 floats + f!  dup float+ f!  f! ;
+
+: qcopy ( src dest -- ) 1 quaternions move ;
+
+: qnorm  ( q -- f )
+  0e 4 0 do  dup f@ fdup f* f+  float+ loop drop fsqrt ;
+
+: qf* ( q f -- )
+  4 0 do dup f@ fover f* dup f!  float+ loop fdrop drop ;
+
+: qnegate ( q -- )  -1e qf* ;
+
+: qconj ( q -- )
+  float+ 3 0 do dup f@ fnegate dup f!  float+ loop drop ;
+
+: qf+ ( q f -- ) dup f@ f+ f! ;
+
+: q+ ( q1 q2 -- )
+  4 0 do over f@ dup f@ f+ dup f!  float+ swap float+ swap loop 2drop ;
+
+\ access
+: q.a             f@ ;
+: q.b      float+ f@ ;
+: q.c  2 floats + f@ ;
+: q.d  3 floats + f@ ;
+
+: q* ( dest q1 q2 -- )
+  over q.a dup q.d f*  over q.b dup q.c f* f+  over q.c dup q.b f* f-  over q.d dup q.a f* f+
+  over q.a dup q.c f*  over q.b dup q.d f* f-  over q.c dup q.a f* f+  over q.d dup q.b f* f+
+  over q.a dup q.b f*  over q.b dup q.a f* f+  over q.c dup q.d f* f+  over q.d dup q.c f* f-
+  over q.a dup q.a f*  over q.b dup q.b f* f-  over q.c dup q.c f* f-  over q.d dup q.d f* f-
+  2drop  4 0 do dup f!  float+ loop  drop ;
+
+: q= ( q1 q2 -- ? )
+  4 0 do
+    over f@ dup f@ f<> if 2drop false unloop exit then
+    float+ swap float+
+  loop
+  2drop true ;
+
+\ testing
+
+: q. ( q -- )
+  [char] ( emit space
+  4 0 do dup f@ f.  float+ loop drop
+  [char] ) emit space ;
+
+qvariable q   1e 2e 3e 4e q  q!
+qvariable q1  2e 3e 4e 5e q1 q!
+create q2     3e f, 4e f, 5e f, 6e f,	\ by hand
+
+qvariable tmp
+qvariable m1
+qvariable m2
+
+q qnorm f.				\ 5.47722557505166
+q tmp qcopy  tmp qnegate  tmp q.	\ ( -1. -2. -3. -4. )
+q tmp qcopy  tmp qconj    tmp q.	\ ( 1. -2. -3. -4. )
+
+q m1 qcopy  m1 7e qf+   m1 q.		\ ( 8. 2. 3. 4. )
+q m2 qcopy  7e m2 qf+   m2 q.		\ ( 8. 2. 3. 4. )
+m1 m2 q= .				\ -1  (true)
+
+q2 tmp qcopy  q1 tmp q+   tmp q.	\ ( 5. 7. 9. 11. )
+
+q m1 qcopy  m1 7e qf*     m1 q.		\ ( 7. 14. 21. 28. )
+q m2 qcopy  7e m2 qf*     m2 q.		\ ( 7. 14. 21. 28. )
+m1 m2 q= .				\ -1  (true)
+
+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)

Task/Quaternion-type/Fortran/quaternion-type.f

@@ -0,0 +1,161 @@
+module Q_mod
+  implicit none
+
+  type quaternion
+    real :: a, b, c, d
+  end type
+
+  public :: norm, neg, conj
+  public :: operator (+)
+  public :: operator (*)
+
+  private ::  q_plus_q, q_plus_r, r_plus_q, &
+              q_mult_q, q_mult_r, r_mult_q, &
+              norm_q, neg_q, conj_q
+
+  interface norm
+    module procedure norm_q
+  end interface
+
+  interface neg
+    module procedure neg_q
+  end interface
+
+  interface conj
+    module procedure conj_q
+  end interface
+
+  interface operator (+)
+    module procedure q_plus_q, q_plus_r, r_plus_q
+  end interface
+
+  interface operator (*)
+    module procedure q_mult_q, q_mult_r, r_mult_q
+  end interface
+
+contains
+
+function norm_q(x) result(res)
+  real :: res
+  type (quaternion), intent (in) :: x
+
+  res = sqrt(x%a*x%a + x%b*x%b + x%c*x%c + x%d*x%d)
+
+end function norm_q
+
+function neg_q(x) result(res)
+  type (quaternion) :: res
+  type (quaternion), intent (in) :: x
+
+  res%a = -x%a
+  res%b = -x%b
+  res%c = -x%c
+  res%d = -x%d
+
+end function neg_q
+
+function conj_q(x) result(res)
+  type (quaternion) :: res
+  type (quaternion), intent (in) :: x
+
+  res%a = x%a
+  res%b = -x%b
+  res%c = -x%c
+  res%d = -x%d
+
+end function conj_q
+
+function q_plus_q(x, y) result (res)
+  type (quaternion) :: res
+  type (quaternion), intent (in) :: x, y
+
+  res%a = x%a + y%a
+  res%b = x%b + y%b
+  res%c = x%c + y%c
+  res%d = x%d + y%d
+
+end function q_plus_q
+
+function q_plus_r(x, r) result (res)
+  type (quaternion) :: res
+  type (quaternion), intent (in) :: x
+  real, intent(in) :: r
+
+   res = x
+   res%a = x%a + r
+
+end function q_plus_r
+
+function r_plus_q(r, x) result (res)
+  type (quaternion) :: res
+  type (quaternion), intent (in) :: x
+  real, intent(in) :: r
+
+   res = x
+   res%a = x%a + r
+
+end function r_plus_q
+
+function q_mult_q(x, y) result (res)
+  type (quaternion) :: res
+  type (quaternion), intent (in) :: x, y
+
+   res%a = x%a*y%a - x%b*y%b - x%c*y%c - x%d*y%d
+   res%b = x%a*y%b + x%b*y%a + x%c*y%d - x%d*y%c
+   res%c = x%a*y%c - x%b*y%d + x%c*y%a + x%d*y%b
+   res%d = x%a*y%d + x%b*y%c - x%c*y%b + x%d*y%a
+
+end function q_mult_q
+
+function q_mult_r(x, r) result (res)
+  type (quaternion) :: res
+  type (quaternion), intent (in) :: x
+  real, intent(in) ::  r
+
+   res%a = x%a*r
+   res%b = x%b*r
+   res%c = x%c*r
+   res%d = x%d*r
+
+end function q_mult_r
+
+function r_mult_q(r, x) result (res)
+  type (quaternion) :: res
+  type (quaternion), intent (in) :: x
+  real, intent(in) ::  r
+
+   res%a = x%a*r
+   res%b = x%b*r
+   res%c = x%c*r
+   res%d = x%d*r
+
+end function r_mult_q
+end module Q_mod
+
+program Quaternions
+  use Q_mod
+  implicit none
+
+  real :: r = 7.0
+  type(quaternion) :: q, q1, q2
+
+  q  = quaternion(1, 2, 3, 4)
+  q1 = quaternion(2, 3, 4, 5)
+  q2 = quaternion(3, 4, 5, 6)
+
+  write(*, "(a, 4f8.3)") "             q = ", q
+  write(*, "(a, 4f8.3)") "            q1 = ", q1
+  write(*, "(a, 4f8.3)") "            q2 = ", q2
+  write(*, "(a, f8.3)")  "             r = ", r
+  write(*, "(a, f8.3)")  "     Norm of q = ", norm(q)
+  write(*, "(a, 4f8.3)") " Negative of q = ", neg(q)
+  write(*, "(a, 4f8.3)") "Conjugate of q = ", conj(q)
+  write(*, "(a, 4f8.3)") "         q + r = ", q + r
+  write(*, "(a, 4f8.3)") "         r + q = ", r + q
+  write(*, "(a, 4f8.3)") "       q1 + q2 = ", q1 + q2
+  write(*, "(a, 4f8.3)") "         q * r = ", q * r
+  write(*, "(a, 4f8.3)") "         r * q = ", r * q
+  write(*, "(a, 4f8.3)") "       q1 * q2 = ", q1 * q2
+  write(*, "(a, 4f8.3)") "       q2 * q1 = ", q2 * q1
+
+end program

Task/Quaternion-type/FreeBASIC/quaternion-type.basic

@@ -0,0 +1,77 @@
+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

Task/Quaternion-type/GAP/quaternion-type.gap

@@ -0,0 +1,110 @@
+# GAP has built-in support for quaternions
+
+A := QuaternionAlgebra(Rationals);
+# <algebra-with-one of dimension 4 over Rationals>
+
+b := BasisVectors(Basis(A));
+# [ e, i, j, k ]
+
+q := [1, 2, 3, 4]*b;
+# 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;
+# (2)*e+(3)*i+(4)*j+(5)*k
+
+q2 := [3, 4, 5, 6]*b;
+# (3)*e+(4)*i+(5)*j+(6)*k
+
+q1*q2 - q2*q1;
+# (-2)*i+(4)*j+(-2)*k
+
+# Can't add directly to a rational, one must make a quaternion of it
+r := 5/3*b[1];
+# (5/3)*e
+r + q;
+# (8/3)*e+(2)*i+(3)*j+(4)*k
+
+# For multiplication, no problem (we are in an algebra over rationals !)
+r*q;
+# (5/3)*e+(10/3)*i+(5)*j+(20/3)*k
+5/3*q;
+# (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

Task/Quaternion-type/Go/quaternion-type.go

@@ -0,0 +1,79 @@
+package main
+
+import (
+    "fmt"
+    "math"
+)
+
+type qtn struct {
+    r, i, j, k float64
+}
+
+var (
+    q  = &qtn{1, 2, 3, 4}
+    q1 = &qtn{2, 3, 4, 5}
+    q2 = &qtn{3, 4, 5, 6}
+
+    r  float64 = 7
+)
+
+func main() {
+    fmt.Println("Inputs")
+    fmt.Println("q:", q)
+    fmt.Println("q1:", q1)
+    fmt.Println("q2:", q2)
+    fmt.Println("r:", r)
+
+    var qr qtn
+    fmt.Println("\nFunctions")
+    fmt.Println("q.norm():", q.norm())
+    fmt.Println("neg(q):", qr.neg(q))
+    fmt.Println("conj(q):", qr.conj(q))
+    fmt.Println("addF(q, r):", qr.addF(q, r))
+    fmt.Println("addQ(q1, q2):", qr.addQ(q1, q2))
+    fmt.Println("mulF(q, r):", qr.mulF(q, r))
+    fmt.Println("mulQ(q1, q2):", qr.mulQ(q1, q2))
+    fmt.Println("mulQ(q2, q1):", qr.mulQ(q2, q1))
+}
+
+func (q *qtn) String() string {
+    return fmt.Sprintf("(%g, %g, %g, %g)", q.r, q.i, q.j, q.k)
+}
+
+func (q *qtn) norm() float64 {
+    return math.Sqrt(q.r*q.r + q.i*q.i + q.j*q.j + q.k*q.k)
+}
+
+func (z *qtn) neg(q *qtn) *qtn {
+    z.r, z.i, z.j, z.k = -q.r, -q.i, -q.j, -q.k
+    return z
+}
+
+func (z *qtn) conj(q *qtn) *qtn {
+    z.r, z.i, z.j, z.k = q.r, -q.i, -q.j, -q.k
+    return z
+}
+
+func (z *qtn) addF(q *qtn, r float64) *qtn {
+    z.r, z.i, z.j, z.k = q.r+r, q.i, q.j, q.k
+    return z
+}
+
+func (z *qtn) addQ(q1, q2 *qtn) *qtn {
+    z.r, z.i, z.j, z.k = q1.r+q2.r, q1.i+q2.i, q1.j+q2.j, q1.k+q2.k
+    return z
+}
+
+func (z *qtn) mulF(q *qtn, r float64) *qtn {
+    z.r, z.i, z.j, z.k = q.r*r, q.i*r, q.j*r, q.k*r
+    return z
+}
+
+func (z *qtn) mulQ(q1, q2 *qtn) *qtn {
+    z.r, z.i, z.j, z.k =
+        q1.r*q2.r-q1.i*q2.i-q1.j*q2.j-q1.k*q2.k,
+        q1.r*q2.i+q1.i*q2.r+q1.j*q2.k-q1.k*q2.j,
+        q1.r*q2.j-q1.i*q2.k+q1.j*q2.r+q1.k*q2.i,
+        q1.r*q2.k+q1.i*q2.j-q1.j*q2.i+q1.k*q2.r
+    return z
+}

Task/Quaternion-type/Haskell/quaternion-type-1.hs

@@ -0,0 +1,53 @@
+import Control.Monad (join)
+
+data Quaternion a =
+  Q a a a a
+  deriving (Show, Eq)
+
+realQ :: Quaternion a -> a
+realQ (Q r _ _ _) = r
+
+imagQ :: Quaternion a -> [a]
+imagQ (Q _ i j k) = [i, j, k]
+
+quaternionFromScalar :: (Num a) => a -> Quaternion a
+quaternionFromScalar s = Q s 0 0 0
+
+listFromQ :: Quaternion a -> [a]
+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 :: (RealFloat a) => Quaternion a -> a
+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 * p - b * q - c * r - d * s)
+    (a * q + b * p + c * s - d * r)
+    (a * r - b * s + c * p + d * q)
+    (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]"

Task/Quaternion-type/Haskell/quaternion-type-2.hs

@@ -0,0 +1,43 @@
+class Quaternion(a, b, c, d)
+
+  method norm ()
+    return sqrt (a*a + b*b + c*c + d*d)
+  end
+
+  method negative ()
+    return Quaternion(-a, -b, -c, -d)
+  end
+
+  method conjugate ()
+    return Quaternion(a, -b, -c, -d)
+  end
+
+  method add (n)
+    if type(n) == "Quaternion__state"
+      then return Quaternion(a+n.a, b+n.b, c+n.c, d+n.d)
+      else return Quaternion(a+n, b, c, d)
+  end
+
+  method multiply (n)
+    if type(n) == "Quaternion__state"
+      then return Quaternion(a*n.a - b*n.b - c*n.c - d*n.d,
+                             a*n.b + b*n.a + c*n.d - d*n.c,
+                             a*n.c - b*n.d + c*n.a + d*n.b,
+                             a*n.d + b*n.c - c*n.b + d*n.a)
+      else return Quaternion(a*n, b*n, c*n, d*n)
+  end
+
+  method sign (n)
+    return if n >= 0 then "+" else "-"
+  end
+
+  method string ()
+    return ("" || a || sign(b) || abs(b) || "i" || sign(c) || abs(c) || "j" || sign(d) || abs(d) || "k");
+  end
+
+  initially(a, b, c, d)
+    self.a := if /a then 0 else a
+    self.b := if /b then 0 else b
+    self.c := if /c then 0 else c
+    self.d := if /d then 0 else d
+end

Task/Quaternion-type/Haskell/quaternion-type-3.hs

@@ -0,0 +1,16 @@
+procedure main ()
+  q := Quaternion (1,2,3,4)
+  q1 := Quaternion (2,3,4,5)
+  q2 := Quaternion (3,4,5,6)
+  r := 7
+
+  write ("The norm      of " || q.string() || " is " || q.norm ())
+  write ("The negative  of " || q.string() || " is " || q.negative().string ())
+  write ("The conjugate of " || q.string() || " is " || q.conjugate().string ())
+  write ("Sum of " || q.string() || " and " || r || " is " || q.add(r).string ())
+  write ("Sum of " || q.string() || " and " || q1.string() || " is " || q.add(q1).string ())
+  write ("Product of " || q.string() || " and " || r || " is " || q.multiply(r).string ())
+  write ("Product of " || q.string() || " and " || q1.string() || " is " || q.multiply(q1).string ())
+  write ("q1*q2 = " || q1.multiply(q2).string ())
+  write ("q2*q1 = " || q2.multiply(q1).string ())
+end

Task/Quaternion-type/Idris/quaternion-type-1.idris

@@ -0,0 +1,95 @@
+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

Task/Quaternion-type/Idris/quaternion-type-2.idris

@@ -0,0 +1,11 @@
+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

Task/Quaternion-type/J/quaternion-type-1.j

@@ -0,0 +1,11 @@
+   NB. utilities
+   ip=:   +/ .*             NB. inner product
+   T=. (_1^#:0 10 9 12)*0 7 16 23 A.=i.4
+   toQ=:  4&{."1 :[:        NB. real scalars -> quaternion
+
+   NB. task
+   norm=: %:@ip~@toQ        NB. | y
+   neg=:  -&toQ             NB. - y  and  x - y
+   conj=: 1 _1 _1 _1 * toQ  NB. + y
+   add=:  +&toQ             NB. x + y
+   mul=:  (ip T ip ])&toQ   NB. x * y

Task/Quaternion-type/J/quaternion-type-2.j

@@ -0,0 +1,20 @@
+   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

Task/Quaternion-type/J/quaternion-type-3.j

@@ -0,0 +1,21 @@
+   q=: 1 2 3 4
+   q1=: 2 3 4 5
+   q2=: 3 4 5 6
+   r=: 7
+
+   norm q
+5.47723
+   neg q
+_1 _2 _3 _4
+   conj q
+1 _2 _3 _4
+   r add q
+8 2 3 4
+   q1 add q2
+5 7 9 11
+   r mul q
+7 14 21 28
+   q1 mul q2
+_56 16 24 26
+   q2 mul q1
+_56 18 20 28

Task/Quaternion-type/Java/quaternion-type.java

@@ -0,0 +1,103 @@
+public class Quaternion {
+    private final 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 Quaternion(double r) {
+        this(r, 0.0, 0.0, 0.0);
+    }
+
+    public double norm() {
+        return Math.sqrt(a * a + b * b + c * c + d * d);
+    }
+
+    public Quaternion negative() {
+        return new Quaternion(-a, -b, -c, -d);
+    }
+
+    public Quaternion conjugate() {
+        return new Quaternion(a, -b, -c, -d);
+    }
+
+    public Quaternion add(double r) {
+        return new Quaternion(a + r, b, c, d);
+    }
+    public static Quaternion add(Quaternion q, double r) {
+        return q.add(r);
+    }
+    public static Quaternion add(double r, Quaternion q) {
+        return q.add(r);
+    }
+    public Quaternion add(Quaternion q) {
+        return new Quaternion(a + q.a, b + q.b, c + q.c, d + q.d);
+    }
+    public static Quaternion add(Quaternion q1, Quaternion q2) {
+        return q1.add(q2);
+    }
+
+    public Quaternion times(double r) {
+        return new Quaternion(a * r, b * r, c * r, d * r);
+    }
+    public static Quaternion times(Quaternion q, double r) {
+        return q.times(r);
+    }
+    public static Quaternion times(double r, Quaternion q) {
+        return q.times(r);
+    }
+    public Quaternion times(Quaternion q) {
+        return new Quaternion(
+            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
+        );
+    }
+    public static Quaternion times(Quaternion q1, Quaternion q2) {
+        return q1.times(q2);
+    }
+
+    @Override
+    public boolean equals(Object obj) {
+        if (!(obj instanceof Quaternion)) return false;
+        final Quaternion other = (Quaternion) obj;
+        if (Double.doubleToLongBits(this.a) != Double.doubleToLongBits(other.a)) return false;
+        if (Double.doubleToLongBits(this.b) != Double.doubleToLongBits(other.b)) return false;
+        if (Double.doubleToLongBits(this.c) != Double.doubleToLongBits(other.c)) return false;
+        if (Double.doubleToLongBits(this.d) != Double.doubleToLongBits(other.d)) return false;
+        return true;
+    }
+    @Override
+    public String toString() {
+        return String.format("%.2f + %.2fi + %.2fj + %.2fk", a, b, c, d).replaceAll("\\+ -", "- ");
+    }
+
+    public String toQuadruple() {
+        return String.format("(%.2f, %.2f, %.2f, %.2f)", a, b, c, d);
+    }
+
+    public static void main(String[] args) {
+        Quaternion q = new Quaternion(1.0, 2.0, 3.0, 4.0);
+        Quaternion q1 = new Quaternion(2.0, 3.0, 4.0, 5.0);
+        Quaternion q2 = new Quaternion(3.0, 4.0, 5.0, 6.0);
+        double r = 7.0;
+        System.out.format("q       = %s%n", q);
+        System.out.format("q1      = %s%n", q1);
+        System.out.format("q2      = %s%n", q2);
+        System.out.format("r       = %.2f%n%n", r);
+        System.out.format("\u2016q\u2016     = %.2f%n", q.norm());
+        System.out.format("-q      = %s%n", q.negative());
+        System.out.format("q*      = %s%n", q.conjugate());
+        System.out.format("q + r   = %s%n", q.add(r));
+        System.out.format("q1 + q2 = %s%n", q1.add(q2));
+        System.out.format("q \u00d7 r   = %s%n", q.times(r));
+        Quaternion q1q2 = q1.times(q2);
+        Quaternion q2q1 = q2.times(q1);
+        System.out.format("q1 \u00d7 q2 = %s%n", q1q2);
+        System.out.format("q2 \u00d7 q1 = %s%n", q2q1);
+        System.out.format("q1 \u00d7 q2 %s q2 \u00d7 q1%n", (q1q2.equals(q2q1) ? "=" : "\u2260"));
+    }
+}

Task/Quaternion-type/JavaScript/quaternion-type-1.js

@@ -0,0 +1,58 @@
+var Quaternion = (function() {
+    // The Q() function takes an array argument and changes it
+    // prototype so that it becomes a Quaternion instance.  This is
+    // scoped only for prototype member access.
+    function Q(a) {
+	a.__proto__ = proto;
+	return a;
+    }
+
+    // Actual constructor.  This constructor converts its arguments to
+    // an array, then that array to a Quaternion instance, then
+    // returns that instance.  (using "new" with this constructor is
+    // optional)
+    function Quaternion() {
+	return Q(Array.prototype.slice.call(arguments, 0, 4));
+    }
+
+    // Prototype for all Quaternions
+    const proto = {
+	// Inherits from a 4-element Array
+	__proto__ : [0,0,0,0],
+
+	// Properties -- In addition to Array[0..3] access, we
+	// also define matching a, b, c, and d properties
+	get a() this[0],
+	get b() this[1],
+	get c() this[2],
+	get d() this[3],
+
+	// Methods
+	norm : function() Math.sqrt(this.map(function(x) x*x).reduce(function(x,y) x+y)),
+	negate : function() Q(this.map(function(x) -x)),
+	conjugate : function() Q([ this[0] ].concat(this.slice(1).map(function(x) -x))),
+	add : function(x) {
+	    if ("number" === typeof x) {
+		return Q([ this[0] + x ].concat(this.slice(1)));
+	    } else {
+		return Q(this.map(function(v,i) v+x[i]));
+	    }
+	},
+	mul : function(r) {
+	    var q = this;
+	    if ("number" === typeof r) {
+		return Q(q.map(function(e) e*r));
+	    } else {
+		return Q([ q[0] * r[0] - q[1] * r[1] - q[2] * r[2] - q[3] * r[3],
+			   q[0] * r[1] + q[1] * r[0] + q[2] * r[3] - q[3] * r[2],
+			   q[0] * r[2] - q[1] * r[3] + q[2] * r[0] + q[3] * r[1],
+			   q[0] * r[3] + q[1] * r[2] - q[2] * r[1] + q[3] * r[0] ]);
+	    }
+	},
+	equals : function(q) this.every(function(v,i) v === q[i]),
+	toString : function() (this[0] + " + " + this[1] + "i + "+this[2] + "j + " + this[3] + "k").replace(/\+ -/g, '- ')
+    };
+
+    Quaternion.prototype = proto;
+    return Quaternion;
+})();

Task/Quaternion-type/JavaScript/quaternion-type-2.js

@@ -0,0 +1,18 @@
+var q = Quaternion(1,2,3,4);
+var q1 = Quaternion(2,3,4,5);
+var q2 = Quaternion(3,4,5,6);
+var r = 7;
+
+console.log("q = "+q);
+console.log("q1 = "+q1);
+console.log("q2 = "+q2);
+console.log("r = "+r);
+console.log("1. q.norm() = "+q.norm());
+console.log("2. q.negate() = "+q.negate());
+console.log("3. q.conjugate() = "+q.conjugate());
+console.log("4. q.add(r) = "+q.add(r));
+console.log("5. q1.add(q2) = "+q1.add(q2));
+console.log("6. q.mul(r) = "+q.mul(r));
+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)");

Task/Quaternion-type/Jq/quaternion-type-1.jq

@@ -0,0 +1,92 @@
+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

Task/Quaternion-type/Jq/quaternion-type-2.jq

@@ -0,0 +1,17 @@
+# 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

Task/Quaternion-type/Julia/quaternion-type-1.julia

@@ -0,0 +1,40 @@
+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)

Task/Quaternion-type/Julia/quaternion-type-2.julia

@@ -0,0 +1,26 @@
+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)

Task/Quaternion-type/Kotlin/quaternion-type.kotlin

@@ -0,0 +1,57 @@
+// 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}")
+}

Task/Quaternion-type/Liberty-BASIC/quaternion-type.basic

@@ -0,0 +1,111 @@
+ q$ = q$( 1 , 2 , 3 , 4 )
+q1$ = q$( 2 , 3 , 4 , 5 )
+q2$ = q$( 3 , 4 , 5 , 6 )
+
+real = 7
+
+print "q = "  ;  q$
+print "q1 = " ; q1$
+print "q2 = " ; q2$
+
+print "real = " ; real
+
+print "length /norm q  = " ; length( q$ )               '   =norm                        norm of q
+print "negative (-q1)  = " ; negative$( q1$ )           '   =negative                    negated q1
+print "conjugate q     = " ; conjugate$( q$ )           '   conjugate                    conjugate q
+print "real + q        = " ; add1$( q$ , real )         '   real +quaternion             real +q
+print "q + q2          = " ; add2$( q$ , q2$ )          '   sum two quaternions          q +q2
+print "real * q        = " ; multiply1$( q$ , real )    '   real *quaternion             real *q
+print "q1 * q2         = " ; multiply2$( q1$ , q2$ )    '   product of two quaternions   q1 & q2
+print "q2 * q1         = " ; multiply2$( q2$ , q1$ )    '   show q1 *q2 <> q2 *q1
+
+end
+
+function q$( r , i , j , k )
+  q$ = str$( r); " "; str$( i); " "; str$( j); " "; str$( k)
+end function
+
+function length( q$ )
+  r = val( word$( q$ , 1 ) )
+  i = val( word$( q$ , 2 ) )
+  j = val( word$( q$ , 3 ) )
+  k = val( word$( q$ , 4 ) )
+  length =sqr( r^2 +i^2 +j^2 +k^2)
+end function
+
+function multiply1$( q$ , d )
+  r = val( word$( q$ , 1 ) )
+  i = val( word$( q$ , 2 ) )
+  j = val( word$( q$ , 3 ) )
+  k = val( word$( q$ , 4 ) )
+  multiply1$ =q$( r*d, i*d, j*d, k*d)
+end function
+
+function multiply2$( q$ , b$ )
+  ar = val( word$( q$ , 1 ) )   'a1
+  ai = val( word$( q$ , 2 ) )   'b1
+  aj = val( word$( q$ , 3 ) )   'c1
+  ak = val( word$( q$ , 4 ) )   'd1
+
+  br = val( word$( b$ , 1 ) )   'a2
+  bi = val( word$( b$ , 2 ) )   'b2
+  bj = val( word$( b$ , 3 ) )   'c2
+  bk = val( word$( b$ , 4 ) )   'd2
+
+  multiply2$ =q$( _
+  ar *br_
+  +( 0 -ai) *bi_
+  +( 0 -aj) *bj_
+  +( 0 -ak) *bk _
+  ,_
+  ar *bi_
+  +ai *br_
+  +aj *bk_
+  +( 0 -ak) *bj_
+  ,_
+  ar *bj_
+  +( 0 -ai) *bk_
+  +aj *br_
+  +ak *bi_
+  ,_
+  ar *bk_
+  +ai *bj_
+  +( 0 -aj) *bi_
+  +ak *br )
+end function
+
+function negative$( q$ )
+  r = val( word$( q$ , 1 ) )
+  i = val( word$( q$ , 2 ) )
+  j = val( word$( q$ , 3 ) )
+  k = val( word$( q$ , 4 ) )
+  negative$ =q$( 0-r, 0-i, 0-j, 0-k)
+end function
+
+function conjugate$( q$ )
+  r = val( word$( q$ , 1 ) )
+  i = val( word$( q$ , 2 ) )
+  j = val( word$( q$ , 3 ) )
+  k = val( word$( q$ , 4 ) )
+  conjugate$ =q$( r, 0-i, 0-j, 0-k)
+end function
+
+function add1$( q$ , real )
+  r = val( word$( q$ , 1 ) )
+  i = val( word$( q$ , 2 ) )
+  j = val( word$( q$ , 3 ) )
+  k = val( word$( q$ , 4 ) )
+  add1$ =q$( r +real, i, j, k)
+end function
+
+function add2$( q$ , b$ )
+  ar = val( word$( q$ , 1 ) )
+  ai = val( word$( q$ , 2 ) )
+  aj = val( word$( q$ , 3 ) )
+  ak = val( word$( q$ , 4 ) )
+  br = val( word$( b$ , 1 ) )
+  bi = val( word$( b$ , 2 ) )
+  bj = val( word$( b$ , 3 ) )
+  bk = val( word$( b$ , 4 ) )
+  add2$ =q$( ar +br, ai +bi, aj +bj, ak +bk)
+end function

Task/Quaternion-type/Lua/quaternion-type-1.lua

@@ -0,0 +1,63 @@
+Quaternion = {}
+
+function Quaternion.new( a, b, c, d )
+    local q = { a = a or 1, b = b or 0, c = c or 0, d = d or 0 }
+
+    local metatab = {}
+    setmetatable( q, metatab )
+    metatab.__add = Quaternion.add
+    metatab.__sub = Quaternion.sub
+    metatab.__unm = Quaternion.unm
+    metatab.__mul = Quaternion.mul
+
+    return q
+end
+
+function Quaternion.add( p, q )
+    if type( p ) == "number" then
+	return Quaternion.new( p+q.a, q.b, q.c, q.d )
+    elseif type( q ) == "number" then
+	return Quaternion.new( p.a+q, p.b, p.c, p.d )
+    else
+	return Quaternion.new( p.a+q.a, p.b+q.b, p.c+q.c, p.d+q.d )
+    end
+end
+
+function Quaternion.sub( p, q )
+    if type( p ) == "number" then
+	return Quaternion.new( p-q.a, q.b, q.c, q.d )
+    elseif type( q ) == "number" then
+	return Quaternion.new( p.a-q, p.b, p.c, p.d )
+    else
+	return Quaternion.new( p.a-q.a, p.b-q.b, p.c-q.c, p.d-q.d )
+    end
+end
+
+function Quaternion.unm( p )
+    return Quaternion.new( -p.a, -p.b, -p.c, -p.d )
+end
+
+function Quaternion.mul( p, q )
+    if type( p ) == "number" then
+	return Quaternion.new( p*q.a, p*q.b, p*q.c, p*q.d )
+    elseif type( q ) == "number" then
+	return Quaternion.new( p.a*q, p.b*q, p.c*q, p.d*q )
+    else
+	return Quaternion.new( p.a*q.a - p.b*q.b - p.c*q.c - p.d*q.d,
+                               p.a*q.b + p.b*q.a + p.c*q.d - p.d*q.c,
+ 			       p.a*q.c - p.b*q.d + p.c*q.a + p.d*q.b,
+			       p.a*q.d + p.b*q.c - p.c*q.b + p.d*q.a )
+    end
+end
+
+function Quaternion.conj( p )
+    return Quaternion.new( p.a, -p.b, -p.c, -p.d )
+end
+
+function Quaternion.norm( p )
+    return math.sqrt( p.a^2 + p.b^2 + p.c^2 + p.d^2 )
+end
+
+function Quaternion.print( p )
+    print( string.format( "%f + %fi + %fj + %fk\n", p.a, p.b, p.c, p.d ) )
+end

Task/Quaternion-type/Lua/quaternion-type-2.lua

@@ -0,0 +1,13 @@
+q1 = Quaternion.new( 1, 2, 3, 4 )
+q2 = Quaternion.new( 5, 6, 7, 8 )
+r  = 12
+
+print( "norm(q1) = ", Quaternion.norm( q1 ) )
+io.write( "-q1 = " ); Quaternion.print( -q1 )
+io.write( "conj(q1) = " ); Quaternion.print( Quaternion.conj( q1 ) )
+io.write( "r+q1 = " ); Quaternion.print( r+q1 )
+io.write( "q1+r = " ); Quaternion.print( q1+r )
+io.write( "r*q1 = " ); Quaternion.print( r*q1 )
+io.write( "q1*r = " ); Quaternion.print( q1*r )
+io.write( "q1*q2 = " ); Quaternion.print( q1*q2 )
+io.write( "q2*q1 = " ); Quaternion.print( q2*q1 )

Task/Quaternion-type/M2000-Interpreter/quaternion-type.m2000

@@ -0,0 +1,99 @@
+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

Task/Quaternion-type/Maple/quaternion-type.maple

@@ -0,0 +1,146 @@
+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;

Task/Quaternion-type/Mathematica/quaternion-type.math

@@ -0,0 +1,30 @@
+<<Quaternions`
+q=Quaternion[1,2,3,4]
+q1=Quaternion[2,3,4,5]
+q2=Quaternion[3,4,5,6]
+r=7
+->Quaternion[1,2,3,4]
+->Quaternion[2,3,4,5]
+->Quaternion[3,4,5,6]
+->7
+
+Abs[q]
+->√30
+-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]
+q*r
+->Quaternion[7,14,21,28]
+r*q
+->Quaternion[7,14,21,28]
+q1**q2
+->Quaternion[-56,16,24,26]
+q2**q1
+->Quaternion[-56,18,20,28]

Task/Quaternion-type/Mercury/quaternion-type-1.mercury

@@ -0,0 +1,38 @@
+:- 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 ).

Task/Quaternion-type/Mercury/quaternion-type-2.mercury

@@ -0,0 +1,76 @@
+:- 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.

Task/Quaternion-type/Nim/quaternion-type.nim

@@ -0,0 +1,72 @@
+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

Task/Quaternion-type/OCaml/quaternion-type-1.ocaml

@@ -0,0 +1,64 @@
+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";

Task/Quaternion-type/OCaml/quaternion-type-2.ocaml

@@ -0,0 +1,11 @@
+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>

Task/Quaternion-type/Octave/quaternion-type-1.octave

@@ -0,0 +1 @@
+pkg install -forge quaternion

Task/Quaternion-type/Octave/quaternion-type-2.octave

@@ -0,0 +1,24 @@
+> 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

Task/Quaternion-type/Oforth/quaternion-type-1.fth

@@ -0,0 +1,24 @@
+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 * + ) ;

Task/Quaternion-type/Oforth/quaternion-type-2.fth

@@ -0,0 +1,20 @@
+: 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 ] ;

Task/Quaternion-type/Ol/quaternion-type.ol

@@ -0,0 +1,241 @@
+;;
+;; 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)

Task/Quaternion-type/OoRexx/quaternion-type.rexx

@@ -0,0 +1,150 @@
+q = .quaternion~new(1, 2, 3, 4)
+q1 = .quaternion~new(2, 3, 4, 5)
+q2 = .quaternion~new(3, 4, 5, 6)
+r = 7
+
+say "q            =" q
+say "q1           =" q1
+say "q2           =" q2
+say "r            =" r
+say "norm(q)      =" q~norm
+say "-q           =" (-q)
+say "q*           =" q~conjugate
+say "q + r        =" q + r
+say "q1 + q2      =" q1 + q2
+say "q * r        =" q * r
+q1q2 = q1 * q2
+q2q1 = q2 * q1
+say "q1 * q2      =" q1q2
+say "q2 * q1      =" q2q1
+say "q1 == q1     =" (q1 == q1)
+say "q1q2 == q2q1 =" (q1q2 == q2q1)
+
+
+::class quaternion
+::method init
+  expose r i j k
+  use strict arg r, i = 0, j = 0, k = 0
+
+-- quaternion instances are immutable, so these are
+-- read only attributes
+::attribute r GET
+::attribute i GET
+::attribute j GET
+::attribute k GET
+
+::method norm
+  expose r i j k
+  return rxcalcsqrt(r * r + i * i + j * j + k * k)
+
+::method invert
+  expose r i j k
+  norm = self~norm
+  return self~class~new(r / norm, i / norm, j / norm, k / norm)
+
+::method negative
+  expose r i j k
+  return self~class~new(-r, -i, -j, -k)
+
+::method conjugate
+  expose r i j k
+  return self~class~new(r, -i, -j, -k)
+
+::method add
+  expose r i j k
+  use strict arg other
+  if other~isa(.quaternion) then
+     return self~class~new(r + other~r, i + other~i, j + other~j, k + other~k)
+  else return self~class~new(r + other, i, j, k)
+
+::method subtract
+  expose r i j k
+  use strict arg other
+  if other~isa(.quaternion) then
+     return self~class~new(r - other~r, i - other~i, j - other~j, k - other~k)
+  else return self~class~new(r - other, i, j, k)
+
+::method times
+  expose r i j k
+  use strict arg other
+  if other~isa(.quaternion) then
+     return self~class~new(r * other~r - i * other~i - j * other~j - k * other~k, -
+                           r * other~i + i * other~r + j * other~k - k * other~j, -
+                           r * other~j - i * other~k + j * other~r + k * other~i, -
+                           r * other~k + i * other~j - j * other~i + k * other~r)
+  else return self~class~new(r * other, i * other, j * other, k * other)
+
+::method divide
+  use strict arg other
+  -- this is easier if everything is a quaternion
+  if \other~isA(.quaternion) then other = .quaternion~new(other)
+  -- division is multiplication with the inversion
+  return self * other~invert
+
+::method "=="
+  expose r i j k
+  use strict arg other
+
+  if \other~isa(.quaternion) then return .false
+  -- Note:  these are numeric comparisons, so we're using the "="
+  -- method so those are handled correctly
+  return r = other~r & i = other~i & j = other~j & k = other~k
+
+::method "\=="
+  use strict arg other
+  return \self~"\=="(other)
+
+::method "="
+  -- this is equivalent of "=="
+  forward message("==")
+
+::method "\="
+  -- this is equivalent of "\=="
+  forward message("\==")
+
+::method "<>"
+  -- this is equivalent of "\=="
+  forward message("\==")
+
+::method "><"
+  -- this is equivalent of "\=="
+  forward message("\==")
+
+-- some operator overrides -- these only work if the left-hand-side of the
+-- subexpression is a quaternion
+::method "*"
+  forward message("TIMES")
+
+::method "/"
+  forward message("DIVIDE")
+
+::method "-"
+  -- need to check if this is a prefix minus or a subtract
+  if arg() == 0 then
+      forward message("NEGATIVE")
+  else
+      forward message("SUBTRACT")
+
+::method "+"
+  -- need to check if this is a prefix plus or an addition
+  if arg() == 0 then
+      return self  -- we can return this copy since it is immutable
+  else
+      forward message("ADD")
+
+::method string
+  expose r i j k
+  return r self~formatnumber(i)"i" self~formatnumber(j)"j" self~formatnumber(k)"k"
+
+::method formatnumber private
+  use arg value
+  if value > 0 then return "+" value
+  else return "-" value~abs
+
+-- override hashcode for collection class hash uses
+::method hashCode
+  expose r i j k
+  return r~hashcode~bitxor(i~hashcode)~bitxor(j~hashcode)~bitxor(k~hashcode)
+
+
+::requires rxmath LIBRARY

Task/Quaternion-type/PARI-GP/quaternion-type-1.parigp

@@ -0,0 +1,35 @@
+q.norm={
+	if(type(q) != "t_VEC" || #q != 4, error("incorrect type"));
+	sqrt(q[1]^2+q[2]^2+q[3]^2+q[4]^2)
+};
+q.conj={
+	if(type(q) != "t_VEC" || #q != 4, error("incorrect type"));
+	-[-q[1],q[2],q[3],q[4]]
+};
+q.add={
+	if(type(q) != "t_VEC" || #q != 4, error("incorrect type"));
+	x->if(type(x) == "t_INT" || type(x) == t_REAL,
+		[q[1]+x,q[2],q[3],q[4]]
+	,
+		if(type(x) == "t_VEC" && #x == 4,
+			q+x
+		,
+			error("incorrect type")
+		)
+	)
+};
+q.mult={
+	if(type(q) != "t_VEC" || #q != 4, error("incorrect type"));
+	x->if(type(x) == "t_INT" || type(x) == t_REAL,
+		x*q
+	,
+		if(type(x) == "t_VEC" && #x == 4,
+			[q[1]*x[1] - q[2]*x[2] - q[3]*x[3] - q[4]*x[4],
+			q[1]*x[2] + q[2]*x[1] + q[3]*x[4] - q[4]*x[3],
+			q[1]*x[3] - q[2]*x[4] + q[3]*x[1] + q[4]*x[2],
+			q[1]*x[4] + q[2]*x[3] - q[3]*x[2] + q[4]*x[1]]
+		,
+			error("incorrect type")
+		)
+	)
+};

Task/Quaternion-type/PARI-GP/quaternion-type-2.parigp

@@ -0,0 +1,10 @@
+r=7;q=[1,2,3,4];q1=[2,3,4,5];q2=[3,4,5,6];
+q.norm
+-q
+q.conj
+q.add(r)
+q1.add(q2)
+q1.add(q2)	\\ or q1+q2
+q.mult(r)	\\ or r*q or q*r
+q1.mult(q2)
+q1.mult(q2) != q2.mult(q1)

Task/Quaternion-type/PL-I/quaternion-type.pli

@@ -0,0 +1,146 @@
+*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;

Task/Quaternion-type/Perl/quaternion-type.pl

@@ -0,0 +1,70 @@
+package Quaternion;
+use List::Util 'reduce';
+use List::MoreUtils 'pairwise';
+
+sub make {
+        my $cls = shift;
+        if (@_ == 1)    { return bless [ @_, 0, 0, 0 ] }
+        elsif (@_ == 4) { return bless [ @_ ] }
+        else            { die "Bad number of components: @_" }
+}
+
+sub _abs { sqrt reduce { $a + $b * $b } @{ +shift } }
+sub _neg { bless [ map(-$_, @{+shift}) ] }
+sub _str { "(@{+shift})" }
+
+sub _add {
+        my ($x, $y) = @_;
+        $y = [ $y, 0, 0, 0 ] unless ref $y;
+        bless [ pairwise { $a + $b } @$x, @$y ]
+}
+
+sub _sub {
+        my ($x, $y, $swap) = @_;
+        $y = [ $y, 0, 0, 0 ] unless ref $y;
+        my @x = pairwise { $a - $b } @$x, @$y;
+        if ($swap) { $_ = -$_ for @x }
+        bless \@x;
+}
+
+sub _mul {
+        my ($x, $y) = @_;
+        if (!ref $y) { return bless [ map($_ * $y, @$x) ] }
+        my ($a1, $b1, $c1, $d1) = @$x;
+        my ($a2, $b2, $c2, $d2) = @$y;
+        bless [ $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]
+}
+
+sub conjugate {
+        my @a = map { -$_ } @{$_[0]};
+        $a[0] = $_[0][0];
+        bless \@a
+}
+
+use overload (
+        '""'    => \&_str,
+        '+'     => \&_add,
+        '-'     => \&_sub,
+        '*'     => \&_mul,
+        'neg'   => \&_neg,
+        'abs'   => \&_abs,
+);
+
+package main;
+
+my $a = Quaternion->make(1, 2, 3, 4);
+my $b = Quaternion->make(1, 1, 1, 1);
+
+print "a = $a\n";
+print "b = $b\n";
+print "|a| = ", abs($a), "\n";
+print "-a = ", -$a, "\n";
+print "a + 1 = ", $a + 1, "\n";
+print "a + b = ", $a + $b, "\n";
+print "a - b = ", $a - $b, "\n";
+print "a conjugate is ", $a->conjugate, "\n";
+print "a * b = ", $a * $b, "\n";
+print "b * a = ", $b * $a, "\n";

Task/Quaternion-type/Phix/quaternion-type.phix

@@ -0,0 +1,74 @@
+(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>
+<!--

Task/Quaternion-type/Picat/quaternion-type.picat

@@ -0,0 +1,50 @@
+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.

Task/Quaternion-type/PicoLisp/quaternion-type-1.l

@@ -0,0 +1,33 @@
+(scl 6)
+
+(def 'quatCopy copy)
+
+(de quatNorm (Q)
+   (sqrt (sum * Q Q)) )
+
+(de quatNeg (Q)
+   (mapcar - Q) )
+
+(de quatConj (Q)
+   (cons (car Q) (mapcar - (cdr Q))) )
+
+(de quatAddR (Q R)
+   (cons (+ R (car Q)) (cdr Q)) )
+
+(de quatAdd (Q1 Q2)
+   (mapcar + Q1 Q2) )
+
+(de quatMulR (Q R)
+   (mapcar */ (mapcar * Q (circ R)) (1.0 .)) )
+
+(de quatMul (Q1 Q2)
+   (mapcar
+      '((Ops I)
+         (sum '((Op R I) (Op (*/ R (get Q2 I) 1.0))) Ops Q1 I) )
+      '((+ - - -) (+ + + -) (+ - + +) (+ + - +))
+      '((1 2 3 4) (2 1 4 3) (3 4 1 2) (4 3 2 1)) ) )
+
+(de quatFmt (Q)
+   (mapcar '((R S) (pack (format R *Scl) S))
+      Q
+      '(" + " "i + " "j + " "k") ) )

Task/Quaternion-type/PicoLisp/quaternion-type-2.l

@@ -0,0 +1,22 @@
+(setq
+   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 )
+
+(prinl "R  = " (format R *Scl))
+(prinl "Q  = " (quatFmt Q))
+(prinl "Q1 = " (quatFmt Q1))
+(prinl "Q2 = " (quatFmt Q2))
+(prinl)
+(prinl "norm(Q)  = " (format (quatNorm Q) *Scl))
+(prinl "norm(Q1) = " (format (quatNorm Q1) *Scl))
+(prinl "norm(Q2) = " (format (quatNorm Q2) *Scl))
+(prinl "neg(Q)   = " (quatFmt (quatNeg Q)))
+(prinl "conj(Q)  = " (quatFmt (quatConj Q)))
+(prinl "Q + R    = " (quatFmt (quatAddR Q R)))
+(prinl "Q1 + Q2  = " (quatFmt (quatAdd Q1 Q2)))
+(prinl "Q * R    = " (quatFmt (quatMulR Q R)))
+(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"))

Task/Quaternion-type/PowerShell/quaternion-type-1.psh

@@ -0,0 +1,58 @@
+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)))"

Task/Quaternion-type/PowerShell/quaternion-type-2.psh

@@ -0,0 +1,22 @@
+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)))"

Task/Quaternion-type/Prolog/quaternion-type-1.pro

@@ -0,0 +1,22 @@
+% 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.

Task/Quaternion-type/Prolog/quaternion-type-2.pro

@@ -0,0 +1,24 @@
+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.

Task/Quaternion-type/PureBasic/quaternion-type-1.basic

@@ -0,0 +1,85 @@
+Structure Quaternion
+  a.f
+  b.f
+  c.f
+  d.f
+EndStructure
+
+Procedure.f QNorm(*x.Quaternion)
+  ProcedureReturn Sqr(Pow(*x\a, 2) + Pow(*x\b, 2) + Pow(*x\c, 2) + Pow(*x\d, 2))
+EndProcedure
+
+;If supplied, the result is returned in the quaternion structure *res,
+;otherwise a new quaternion is created.  A pointer to the result is returned.
+Procedure QNeg(*x.Quaternion, *res.Quaternion = 0)
+  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
+  If *res
+    *res\a = -*x\a
+    *res\b = -*x\b
+    *res\c = -*x\c
+    *res\d = -*x\d
+  EndIf
+  ProcedureReturn *res
+EndProcedure
+
+Procedure QConj(*x.Quaternion, *res.Quaternion = 0)
+  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
+  If *res
+    *res\a =  *x\a
+    *res\b = -*x\b
+    *res\c = -*x\c
+    *res\d = -*x\d
+  EndIf
+  ProcedureReturn *res
+EndProcedure
+
+Procedure QAddReal(r.f, *x.Quaternion, *res.Quaternion = 0)
+  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
+  If *res
+    *res\a = *x\a + r
+    *res\b = *x\b
+    *res\c = *x\c
+    *res\d = *x\d
+  EndIf
+  ProcedureReturn *res
+EndProcedure
+
+Procedure QAddQuaternion(*x.Quaternion, *y.Quaternion, *res.Quaternion = 0)
+  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
+  If *res
+    *res\a = *x\a + *y\a
+    *res\b = *x\b + *y\b
+    *res\c = *x\c + *y\c
+    *res\d = *x\d + *y\d
+  EndIf
+  ProcedureReturn *res
+EndProcedure
+
+Procedure QMulReal_and_Quaternion(r.f, *x.Quaternion, *res.Quaternion = 0)
+  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
+  If *res
+    *res\a = *x\a * r
+    *res\b = *x\b * r
+    *res\c = *x\c * r
+    *res\d = *x\d * r
+  EndIf
+  ProcedureReturn *res
+EndProcedure
+
+Procedure QMulQuaternion(*x.Quaternion, *y.Quaternion, *res.Quaternion = 0)
+  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
+  If *res
+     *res\a = *x\a * *y\a - *x\b * *y\b - *x\c * *y\c - *x\d * *y\d
+     *res\b = *x\a * *y\b + *x\b * *y\a + *x\c * *y\d - *x\d * *y\c
+     *res\c = *x\a * *y\c - *x\b * *y\d + *x\c * *y\a + *x\d * *y\b
+     *res\d = *x\a * *y\d + *x\b * *y\c - *x\c * *y\b + *x\d * *y\a
+  EndIf
+  ProcedureReturn *res
+EndProcedure
+
+Procedure Q_areEqual(*x.Quaternion, *y.Quaternion)
+  If (*x\a <> *y\a) Or (*x\b <> *y\b) Or (*x\c <> *y\c) Or (*x\d <> *y\d)
+    ProcedureReturn 0 ;false
+  EndIf
+  ProcedureReturn 1 ;true
+EndProcedure

Task/Quaternion-type/PureBasic/quaternion-type-2.basic

@@ -0,0 +1,29 @@
+Procedure.s ShowQ(*x.Quaternion, NN = 0)
+  ProcedureReturn "{" + StrF(*x\a, NN) + "," + StrF(*x\b, NN) + "," + StrF(*x\c, NN) + "," + StrF(*x\d, NN) + "}"
+EndProcedure
+
+If OpenConsole()
+  Define.Quaternion Q0, Q1, Q2, res, res2
+  Define.f          r = 7
+
+  Q0\a = 1: Q0\b = 2: Q0\c = 3: Q0\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
+
+  PrintN("Q0 = " + ShowQ(Q0, 0))
+  PrintN("Q1 = " + ShowQ(Q1, 0))
+  PrintN("Q2 = " + ShowQ(Q2, 0))
+
+  PrintN("Normal of Q0 = " + StrF(QNorm(Q0)))
+  PrintN("Neg(Q0)  = " + ShowQ(QNeg(Q0, res)))
+  PrintN("Conj(Q0) = " + ShowQ(QConj(Q0, res)))
+  PrintN("r + Q0   = " + ShowQ(QAddReal(r, Q0, res)))
+  PrintN("Q0 + Q1  = " + ShowQ(QAddQuaternion(Q0, Q1, res)))
+  PrintN("Q1 + Q2  = " + ShowQ(QAddQuaternion(Q1, Q2, res)))
+  PrintN("Q1 * Q2  = " + ShowQ(QMulQuaternion(Q1, Q2, res)))
+  PrintN("Q2 * Q1  = " + ShowQ(QMulQuaternion(Q2, Q1, res2)))
+  Print( "Q1 * Q2"): If Q_areEqual(res, res2): Print(" = "): Else: Print(" <> "): EndIf: Print( "Q2 * Q1")
+
+  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
+  CloseConsole()
+EndIf

Task/Quaternion-type/Python/quaternion-type-1.py

@@ -0,0 +1,82 @@
+from collections import namedtuple
+import math
+
+class Q(namedtuple('Quaternion', 'real, i, j, k')):
+    'Quaternion type: Q(real=0.0, i=0.0, j=0.0, k=0.0)'
+
+    __slots__ = ()
+
+    def __new__(_cls, real=0.0, i=0.0, j=0.0, k=0.0):
+        'Defaults all parts of quaternion to zero'
+        return super().__new__(_cls, float(real), float(i), float(j), float(k))
+
+    def conjugate(self):
+        return Q(self.real, -self.i, -self.j, -self.k)
+
+    def _norm2(self):
+        return sum( x*x for x in self)
+
+    def norm(self):
+        return math.sqrt(self._norm2())
+
+    def reciprocal(self):
+        n2 = self._norm2()
+        return Q(*(x / n2 for x in self.conjugate()))
+
+    def __str__(self):
+        'Shorter form of Quaternion as string'
+        return 'Q(%g, %g, %g, %g)' % self
+
+    def __neg__(self):
+        return Q(-self.real, -self.i, -self.j, -self.k)
+
+    def __add__(self, other):
+        if type(other) == Q:
+            return Q( *(s+o for s,o in zip(self, other)) )
+        try:
+            f = float(other)
+        except:
+            return NotImplemented
+        return Q(self.real + f, self.i, self.j, self.k)
+
+    def __radd__(self, other):
+        return Q.__add__(self, other)
+
+    def __mul__(self, other):
+        if type(other) == Q:
+            a1,b1,c1,d1 = self
+            a2,b2,c2,d2 = other
+            return Q(
+                 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 )
+        try:
+            f = float(other)
+        except:
+            return NotImplemented
+        return Q(self.real * f, self.i * f, self.j * f, self.k * f)
+
+    def __rmul__(self, other):
+        return Q.__mul__(self, other)
+
+    def __truediv__(self, other):
+        if type(other) == Q:
+            return self.__mul__(other.reciprocal())
+        try:
+            f = float(other)
+        except:
+            return NotImplemented
+        return Q(self.real / f, self.i / f, self.j / f, self.k / f)
+
+    def __rtruediv__(self, other):
+        return other * self.reciprocal()
+
+    __div__, __rdiv__ = __truediv__, __rtruediv__
+
+Quaternion = Q
+
+q  = Q(1, 2, 3, 4)
+q1 = Q(2, 3, 4, 5)
+q2 = Q(3, 4, 5, 6)
+r  = 7

Task/Quaternion-type/Python/quaternion-type-2.py

@@ -0,0 +1,56 @@
+>>> q
+Quaternion(real=1.0, i=2.0, j=3.0, k=4.0)
+>>> q1
+Quaternion(real=2.0, i=3.0, j=4.0, k=5.0)
+>>> q2
+Quaternion(real=3.0, i=4.0, j=5.0, k=6.0)
+>>> r
+7
+>>> q.norm()
+5.477225575051661
+>>> q1.norm()
+7.3484692283495345
+>>> q2.norm()
+9.273618495495704
+>>> -q
+Quaternion(real=-1.0, i=-2.0, j=-3.0, k=-4.0)
+>>> q.conjugate()
+Quaternion(real=1.0, i=-2.0, j=-3.0, k=-4.0)
+>>> r + q
+Quaternion(real=8.0, i=2.0, j=3.0, k=4.0)
+>>> q + r
+Quaternion(real=8.0, i=2.0, j=3.0, k=4.0)
+>>> q1 + q2
+Quaternion(real=5.0, i=7.0, j=9.0, k=11.0)
+>>> q2 + q1
+Quaternion(real=5.0, i=7.0, j=9.0, k=11.0)
+>>> q * r
+Quaternion(real=7.0, i=14.0, j=21.0, k=28.0)
+>>> r * q
+Quaternion(real=7.0, i=14.0, j=21.0, k=28.0)
+>>> q1 * q2
+Quaternion(real=-56.0, i=16.0, j=24.0, k=26.0)
+>>> q2 * q1
+Quaternion(real=-56.0, i=18.0, j=20.0, k=28.0)
+>>> assert q1 * q2 != q2 * q1
+>>>
+>>> i, j, k = Q(0,1,0,0), Q(0,0,1,0), Q(0,0,0,1)
+>>> i*i
+Quaternion(real=-1.0, i=0.0, j=0.0, k=0.0)
+>>> j*j
+Quaternion(real=-1.0, i=0.0, j=0.0, k=0.0)
+>>> k*k
+Quaternion(real=-1.0, i=0.0, j=0.0, k=0.0)
+>>> i*j*k
+Quaternion(real=-1.0, i=0.0, j=0.0, k=0.0)
+>>> q1 / q2
+Quaternion(real=0.7906976744186047, i=0.023255813953488358, j=-2.7755575615628914e-17, k=0.046511627906976744)
+>>> q1 / q2 * q2
+Quaternion(real=2.0000000000000004, i=3.0000000000000004, j=4.000000000000001, k=5.000000000000001)
+>>> q2 * q1 / q2
+Quaternion(real=2.0, i=3.465116279069768, j=3.906976744186047, k=4.767441860465116)
+>>> q1.reciprocal() * q1
+Quaternion(real=0.9999999999999999, i=0.0, j=0.0, k=0.0)
+>>> q1 * q1.reciprocal()
+Quaternion(real=0.9999999999999999, i=0.0, j=0.0, k=0.0)
+>>>

Task/Quaternion-type/R/quaternion-type.r

@@ -0,0 +1,33 @@
+library(quaternions)
+
+q <- Q(1, 2, 3, 4)
+q1 <- Q(2, 3, 4, 5)
+q2 <- Q(3, 4, 5, 6)
+r <- 7.0
+
+display <- function(x){
+  e <- deparse(substitute(x))
+  res <- if(class(x) == "Q") paste(x$r, "+", x$i, "i+", x$j, "j+", x$k, "k", sep = "") else x
+  cat(noquote(paste(c(e, " = ", res, "\n"), collapse="")))
+  invisible(res)
+}
+
+display(norm(q))
+display(-q)
+display(Conj(q))
+display(r + q)
+display(q1 + q2)
+display(r*q)
+display(q*r)
+if(display(q1*q2) == display(q2*q1)) cat("q1*q2 == q2*q1\n") else cat("q1*q2 != q2*q1\n")
+
+## norm(q) = 5.47722557505166
+## -q = -1+-2i+-3j+-4k
+## Conj(q) = 1+-2i+-3j+-4k
+## r + q = 8+2i+3j+4k
+## q1 + q2 = 5+7i+9j+11k
+## r * q = 7+14i+21j+28k
+## q * r = 7+14i+21j+28k
+## q1 * q2 = -56+16i+24j+26k
+## q2 * q1 = -56+18i+20j+28k
+## q1*q2 != q2*q1

Task/Quaternion-type/REXX/quaternion-type.rexx

@@ -0,0 +1,41 @@
+/*REXX program performs some operations on  quaternion type numbers and displays results*/
+                       q = 1 2 3 4    ;                     q1 = 2 3 4 5
+                       r = 7          ;                     q2 = 3 4 5 6
+call qShow  q                         ,     'q'
+call qShow  q1                        ,     'q1'
+call qShow  q2                        ,     'q2'
+call qShow  r                         ,     'r'
+call qShow  qNorm(q)                  ,     'norm q'                  ,        "task 1:"
+call qShow  qNeg(q)                   ,     'negative q'              ,        "task 2:"
+call qShow  qConj(q)                  ,     'conjugate q'             ,        "task 3:"
+call qShow  qAdd( r, q  )             ,     'addition r+q'            ,        "task 4:"
+call qShow  qAdd(q1, q2 )             ,     'addition q1+q2'          ,        "task 5:"
+call qShow  qMul( q, r  )             ,     'multiplication q*r'      ,        "task 6:"
+call qShow  qMul(q1, q2 )             ,     'multiplication q1*q2'    ,        "task 7:"
+call qShow  qMul(q2, q1 )             ,     'multiplication q2*q1'    ,        "task 8:"
+exit                                             /*stick a fork in it,  we're all done. */
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+qConj: procedure; parse arg x;    call qXY;    return    x.1    (-x.2)    (-x.3)    (-x.4)
+qNeg:  procedure; parse arg x;    call qXY;    return   -x.1    (-x.2)    (-x.3)    (-x.4)
+qNorm: procedure; parse arg x;    call qXY;    return sqrt(x.1**2 +x.2**2 +x.3**2 +x.4**2)
+qAdd:  procedure; parse arg x,y;  call qXY 2;  return x.1+y.1  x.2+y.2  x.3+y.3  x.4+y.4
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+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 ,
+              x.1*y.3 -x.2*y.4 +x.3*y.1 +x.4*y.2     x.1*y.4 +x.2*y.3 -x.3*y.2 +x.4*y.1
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+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 x=0  then return 0;   d= digits();   i=;   m.=9;  h=d+6
+       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*/
+       numeric digits d;           return (g/1)i                 /*make complex if  X<0 */

Task/Quaternion-type/Racket/quaternion-type.rkt

@@ -0,0 +1,75 @@
+#lang 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 (multiply 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))
+                            (+ (* 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)))

Task/Quaternion-type/Raku/quaternion-type.raku

@@ -0,0 +1,54 @@
+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";

Task/Quaternion-type/Red/quaternion-type.red

@@ -0,0 +1,59 @@
+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]

Task/Quaternion-type/Ruby/quaternion-type.rb

@@ -0,0 +1,77 @@
+class Quaternion
+  def initialize(*parts)
+    raise ArgumentError, "wrong number of arguments (#{parts.size} for 4)" unless parts.size == 4
+    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#{@parts.to_s}"                    end
+  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;          Math.sqrt(to_a.reduce(0){|sum,e| sum + e**2}) end # In Rails: Math.sqrt(to_a.sum { e**2 })
+
+  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
+
+  def +(other)
+    case other
+    when Numeric
+      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".
+      a, b, c, d = *complex_parts, *other.complex_parts
+      x, y = a*c - d.conj*b, a*d + b*c.conj
+      Quaternion.new(x.real, x.imag, y.real, y.imag)
+    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)
+    case other
+    when Numeric then [Scalar.new(other), self]
+    else raise TypeError, "#{other.class} can't be coerced into #{self.class}"
+    end
+  end
+
+  class Scalar
+    def initialize(val); @val = val;                            end
+    def +(other);        other + @val;                          end
+    def *(other);        other * @val;                          end
+    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)
+  q2 = Quaternion.new(3,4,5,6)
+  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

Task/Quaternion-type/Rust/quaternion-type.rust

@@ -0,0 +1,173 @@
+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());
+}

Task/Quaternion-type/Scala/quaternion-type-1.scala

@@ -0,0 +1,31 @@
+case class Quaternion(re: Double = 0.0, i: Double = 0.0, j: Double = 0.0, k: Double = 0.0) {
+  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 = Quaternion(-re, -i, -j, -k)
+  def conjugate = Quaternion(re, -i, -j, -k)
+  def reciprocal = Quaternion(re/norm2, -i/norm2, -j/norm2, -k/norm2)
+
+  def +(q: Quaternion) = Quaternion(re+q.re, i+q.i, j+q.j, k+q.k)
+  def -(q: Quaternion) = Quaternion(re-q.re, i-q.i, j-q.j, k-q.k)
+  def *(q: Quaternion) = 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,
+	 re*q.j - i*q.k + j*q.re + k*q.i,
+	 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)
+}

Task/Quaternion-type/Scala/quaternion-type-2.scala

@@ -0,0 +1,35 @@
+val q0=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;
+	
+println("q0 = "+ q0)
+println("q1 = "+ q1)
+println("q2 = "+ q2)
+println("r  = "+ r)
+println()
+	
+println("q0.re            = "+ q0.re)
+println("q0.im            = "+ q0.im)
+println("q0.norm          = "+ q0.norm)
+println("q0.negative      = "+ q0.negative)
+println("-q0              = "+ -q0)
+println("q0.conjugate     = "+ q0.conjugate)
+println("~q0              = "+ ~q0)
+println("q1+q2            = "+ (q1+q2))
+println("q2+q1            = "+ (q2+q1))
+println("q1+r             = "+ (q1+r))
+println("r+q1             = "+ (r+q1))
+println("q1-q2            = "+ (q1-q2))
+println("q2-q1            = "+ (q2-q1))
+println("q1-r             = "+ (q1-r))
+println("r-q1             = "+ (r-q1))
+println("q1*q2            = "+ q1*q2)
+println("q2*q1            = "+ q2*q1)
+println("q1*r             = "+ q1*r)
+println("r*q1             = "+ r*q1)
+println("(q1*q2)!=(q2*q1) = "+ ((q1*q2)!=(q2*q1)))
+println("q1/q2            = "+ q1/q2)
+println("q2/q1            = "+ q2/q1)
+println("q1/r             = "+ q1/r)
+println("r/q1             = "+ r/q1)

Task/Quaternion-type/Seed7/quaternion-type.seed7

@@ -0,0 +1,177 @@
+$ 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;

Task/Quaternion-type/Sidef/quaternion-type.sidef

@@ -0,0 +1,39 @@
+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"