Quaternion type: Difference between revisions
Added Easylang
m (BASIC256 and BBC BASIC moved to the BASIC section.) |
(Added Easylang) |
||
| (14 intermediate revisions by 7 users not shown) | |||
Line 839:
q2q1:(-56.0, 18.0, 20.0, 28.0)
</pre>
=={{header|Arturo}}==
<syntaxhighlight lang="arturo">qnorm: $ => [sqrt fold & [x y] -> x + y*y]
qneg: $ => [map & => neg]
qconj: $[q] [@[q\0] ++ qneg drop q]
qaddr: function [q r][
[a b c d]: q
@[a+r b c d]
]
qadd: $ => [map couple & & => sum]
qmulr: $[q r] [map q'x -> x*r]
qmul: function [q1 q2][
[a1 b1 c1 d1]: q1
[a2 b2 c2 d2]: q2
@[
(((a1*a2) - b1*b2) - c1*c2) - d1*d2,
(((a1*b2) + b1*a2) + c1*d2) - d1*c2,
(((a1*c2) - b1*d2) + c1*a2) + d1*b2,
(((a1*d2) + b1*c2) - c1*b2) + d1*a2
]
]
; --- test quaternions ---
q: [1 2 3 4]
q1: [2 3 4 5]
q2: [3 4 5 6]
r: 7
print ['qnorm q '= qnorm q]
print ['qneg q '= qneg q]
print ['qconj q '= qconj q]
print ['qaddr q r '= qaddr q r]
print ['qmulr q r '= qmulr q r]
print ['qadd q1 q2 '= qadd q1 q2]
print ['qmul q1 q2 '= qmul q1 q2]
print ['qmul q2 q1 '= qmul q2 q1]</syntaxhighlight>
{{out}}
<pre>qnorm [1 2 3 4] = 5.477225575051661
qneg [1 2 3 4] = [-1 -2 -3 -4]
qconj [1 2 3 4] = [1 -2 -3 -4]
qaddr [1 2 3 4] 7 = [8 2 3 4]
qmulr [1 2 3 4] 7 = [7 14 21 28]
qadd [2 3 4 5] [3 4 5 6] = [5 7 9 11]
qmul [2 3 4 5] [3 4 5 6] = [-56 16 24 26]
qmul [3 4 5 6] [2 3 4 5] = [-56 18 20 28]</pre>
=={{header|ATS}}==
{{libheader|ats2-xprelude}}
<syntaxhighlight lang="ATS">
//--------------------------------------------------------------------
#include "share/atspre_staload.hats"
//--------------------------------------------------------------------
(* Here is one way to get a sqrt function without going beyond the ATS
prelude. The prelude (at the time of this writing) contains some
templates for which implementations were never added. Here I add an
implementation.
The ats2-xprelude package at
https://sourceforge.net/p/chemoelectric/ats2-xprelude contains a
much more extensive and natural interface to the C math library. *)
%{^
#include <math.h>
%}
implement (* "Generic" square root. *)
gsqrt_val<double> x =
(* Call "sqrt" from the C math library. *)
$extfcall (double, "sqrt", x)
//--------------------------------------------------------------------
abst@ype quaternion (tk : tkind) =
(* The following determines the SIZE of a quaternion, but not its
actual representation: *)
@(g0float tk, g0float tk, g0float tk, g0float tk)
extern fn {tk : tkind} quaternion_make :
(g0float tk, g0float tk, g0float tk, g0float tk) -<> quaternion tk
extern fn {tk : tkind} fprint_quaternion :
(FILEref, quaternion tk) -> void
extern fn {tk : tkind} print_quaternion :
quaternion tk -> void
extern fn {tk : tkind} quaternion_norm_squared :
quaternion tk -<> g0float tk
extern fn {tk : tkind} quaternion_norm :
quaternion tk -< !exn > g0float tk
extern fn {tk : tkind} quaternion_neg :
quaternion tk -<> quaternion tk
extern fn {tk : tkind} quaternion_conj :
quaternion tk -<> quaternion tk
extern fn {tk : tkind} add_quaternion_g0float :
(quaternion tk, g0float tk) -<> quaternion tk
extern fn {tk : tkind} add_g0float_quaternion :
(g0float tk, quaternion tk) -<> quaternion tk
extern fn {tk : tkind} add_quaternion_quaternion :
(quaternion tk, quaternion tk) -<> quaternion tk
extern fn {tk : tkind} mul_quaternion_g0float :
(quaternion tk, g0float tk) -<> quaternion tk
extern fn {tk : tkind} mul_g0float_quaternion :
(g0float tk, quaternion tk) -<> quaternion tk
extern fn {tk : tkind} mul_quaternion_quaternion :
(quaternion tk, quaternion tk) -<> quaternion tk
extern fn {tk : tkind} quaternion_eq :
(quaternion tk, quaternion tk) -<> bool
overload fprint with fprint_quaternion
overload print with print_quaternion
overload norm_squared with quaternion_norm_squared
overload norm with quaternion_norm
overload ~ with quaternion_neg
overload conj with quaternion_conj
overload + with add_quaternion_g0float
overload + with add_g0float_quaternion
overload + with add_quaternion_quaternion
overload * with mul_quaternion_g0float
overload * with mul_g0float_quaternion
overload * with mul_quaternion_quaternion
overload = with quaternion_eq
//--------------------------------------------------------------------
local
(* Now we decide the REPRESENTATION of a quaternion. A quaternion is
represented as an unboxed 4-tuple of "real" numbers of any one
particular typekind. *)
typedef _quaternion (tk : tkind) =
@(g0float tk, g0float tk, g0float tk, g0float tk)
assume quaternion tk = _quaternion tk
in (* local *)
implement {tk}
quaternion_make (a, b, c, d) =
@(a, b, c, d)
implement {tk}
fprint_quaternion (outf, q) =
let
typedef t = g0float tk
val @(a, b, c, d) = q
in
fprint_val<t> (outf, a);
if g0i2f 0 <= b then fprint_val<string> (outf, "+");
fprint_val<t> (outf, b);
fprint_val<string> (outf, "i");
if g0i2f 0 <= c then fprint_val<string> (outf, "+");
fprint_val<t> (outf, c);
fprint_val<string> (outf, "j");
if g0i2f 0 <= d then fprint_val<string> (outf, "+");
fprint_val<t> (outf, d);
fprint_val<string> (outf, "k");
end
implement {tk}
print_quaternion q =
fprint_quaternion (stdout_ref, q)
implement {tk}
quaternion_norm_squared q =
let
val @(a, b, c, d) = q
in
(a * a) + (b * b) + (c * c) + (d * d)
end
implement {tk}
quaternion_norm q =
gsqrt_val<g0float tk> (quaternion_norm_squared q)
implement {tk}
quaternion_neg q =
let
val @(a, b, c, d) = q
in
@(~a, ~b, ~c, ~d)
end
implement {tk}
quaternion_conj q =
let
val @(a, b, c, d) = q
in
@(a, ~b, ~c, ~d)
end
implement {tk}
add_quaternion_g0float (q, r) =
let
val @(a, b, c, d) = q
in
@(a + r, b, c, d)
end
implement {tk}
add_g0float_quaternion (r, q) =
let
val @(a, b, c, d) = q
in
@(r + a, b, c, d)
end
implement {tk}
add_quaternion_quaternion (q1, q2) =
let
val @(a1, b1, c1, d1) = q1
and @(a2, b2, c2, d2) = q2
in
@(a1 + a2, b1 + b2, c1 + c2, d1 + d2)
end
implement {tk}
mul_quaternion_g0float (q, r) =
let
val @(a, b, c, d) = q
in
@(a * r, b * r, c * r, d * r)
end
implement {tk}
mul_g0float_quaternion (r, q) =
let
val @(a, b, c, d) = q
in
@(r * a, r * b, r * c, r * d)
end
implement {tk}
mul_quaternion_quaternion (q1, q2) =
let
val @(a1, b1, c1, d1) = q1
and @(a2, b2, c2, d2) = q2
in
@((a1 * a2) - (b1 * b2) - (c1 * c2) - (d1 * d2),
(a1 * b2) + (b1 * a2) + (c1 * d2) - (d1 * c2),
(a1 * c2) - (b1 * d2) + (c1 * a2) + (d1 * b2),
(a1 * d2) + (b1 * c2) - (c1 * b2) + (d1 * a2))
end
implement {tk}
quaternion_eq (q1, q2) =
let
val @(a1, b1, c1, d1) = q1
and @(a2, b2, c2, d2) = q2
in
(a1 = a2) * (b1 = b2) * (c1 = c2) * (d1 = d2)
end
end (* local *)
//--------------------------------------------------------------------
val q = quaternion_make (1.0, 2.0, 3.0, 4.0)
and q1 = quaternion_make (2.0, 3.0, 4.0, 5.0)
and q2 = quaternion_make (3.0, 4.0, 5.0, 6.0)
and r = 7.0
implement
main0 () =
let
(* Let us print double precision numbers in a format more readable
than is the prelude's default. *)
implement
fprint_val<double> (outf, x) =
let
typedef f = $extype"FILE *"
val _ = $extfcall (int, "fprintf", $UNSAFE.cast{f} outf,
"%g", x)
in
end
in
println! ("q = ", q);
println! ("q1 = ", q1);
println! ("q2 = ", q2);
println! ();
println! ("||q|| = ", norm q);
println! ("||q1|| = ", norm q1);
println! ("||q2|| = ", norm q2);
println! ();
println! ("-q = ", ~q);
println! ("-q1 = ", ~q1);
println! ("-q2 = ", ~q2);
println! ();
println! ("conj q = ", conj q);
println! ("conj q1 = ", conj q1);
println! ("conj q2 = ", conj q2);
println! ();
println! ("q + r = ", q + r);
println! ("r + q = ", r + q);
println! ("q1 + q2 = ", q1 + q2);
println! ();
println! ("q * r = ", q * r);
println! ("r * q = ", r * q);
println! ("q1 * q2 = ", q1 * q2);
println! ("q2 * q1 = ", q2 * q1);
println! ("((q1 * q2) = (q2 * q1)) is ", (q1 * q2) = (q2 * q1))
end
//--------------------------------------------------------------------
</syntaxhighlight>
{{out}}
<pre>$ patscc -std=gnu2x -O2 quaternions_task.dats -lm && ./a.out
q = 1+2i+3j+4k
q1 = 2+3i+4j+5k
q2 = 3+4i+5j+6k
||q|| = 5.477226
||q1|| = 7.348469
||q2|| = 9.273618
-q = -1-2i-3j-4k
-q1 = -2-3i-4j-5k
-q2 = -3-4i-5j-6k
conj q = 1-2i-3j-4k
conj q1 = 2-3i-4j-5k
conj q2 = 3-4i-5j-6k
q + r = 8+2i+3j+4k
r + q = 8+2i+3j+4k
q1 + q2 = 5+7i+9j+11k
q * r = 7+14i+21j+28k
r * q = 7+14i+21j+28k
q1 * q2 = -56+16i+24j+26k
q2 * q1 = -56+18i+20j+28k
((q1 * q2) = (q2 * q1)) is false</pre>
=={{header|AutoHotkey}}==
Line 2,260 ⟶ 2,614:
exp(log(s)): [2, 0.33427, 0.445694, 0.557117]
log(exp(s)): [2, 0.33427, 0.445694, 0.557117]</pre>
=={{header|Dart}}==
{{trans|Kotlin}}
<syntaxhighlight lang="Dart">
import 'dart:math' as math;
class Quaternion {
final double a, b, c, d;
Quaternion(this.a, this.b, this.c, this.d);
Quaternion operator +(Object other) {
if (other is Quaternion) {
return Quaternion(a + other.a, b + other.b, c + other.c, d + other.d);
} else if (other is double) {
return Quaternion(a + other, b, c, d);
}
throw ArgumentError('Invalid type for addition: ${other.runtimeType}');
}
Quaternion operator *(Object other) {
if (other is Quaternion) {
return Quaternion(
a * other.a - b * other.b - c * other.c - d * other.d,
a * other.b + b * other.a + c * other.d - d * other.c,
a * other.c - b * other.d + c * other.a + d * other.b,
a * other.d + b * other.c - c * other.b + d * other.a,
);
} else if (other is double) {
return Quaternion(a * other, b * other, c * other, d * other);
}
throw ArgumentError('Invalid type for multiplication: ${other.runtimeType}');
}
Quaternion operator -() => Quaternion(-a, -b, -c, -d);
Quaternion conj() => Quaternion(a, -b, -c, -d);
double norm() => math.sqrt(a * a + b * b + c * c + d * d);
@override
String toString() => '($a, $b, $c, $d)';
}
void main() {
var q = Quaternion(1.0, 2.0, 3.0, 4.0);
var q1 = Quaternion(2.0, 3.0, 4.0, 5.0);
var q2 = Quaternion(3.0, 4.0, 5.0, 6.0);
var r = 7.0;
print("q = $q");
print("q1 = $q1");
print("q2 = $q2");
print("r = $r\n");
print("norm(q) = ${q.norm().toStringAsFixed(6)}");
print("-q = ${-q}");
print("conj(q) = ${q.conj()}\n");
print("r + q = ${q + r}");
print("q + r = ${q + r}");
print("q1 + q2 = ${q1 + q2}\n");
print("r * q = ${q * r}");
print("q * r = ${q * r}");
var q3 = q1 * q2;
var q4 = q2 * q1;
print("q1 * q2 = $q3");
print("q2 * q1 = $q4\n");
print("q1 * q2 != q2 * q1 = ${q3 != q4}");
}
</syntaxhighlight>
{{out}}
<pre>
q = (1.0, 2.0, 3.0, 4.0)
q1 = (2.0, 3.0, 4.0, 5.0)
q2 = (3.0, 4.0, 5.0, 6.0)
r = 7.0
norm(q) = 5.477226
-q = (-1.0, -2.0, -3.0, -4.0)
conj(q) = (1.0, -2.0, -3.0, -4.0)
r + q = (8.0, 2.0, 3.0, 4.0)
q + r = (8.0, 2.0, 3.0, 4.0)
q1 + q2 = (5.0, 7.0, 9.0, 11.0)
r * q = (7.0, 14.0, 21.0, 28.0)
q * r = (7.0, 14.0, 21.0, 28.0)
q1 * q2 = (-56.0, 16.0, 24.0, 26.0)
q2 * q1 = (-56.0, 18.0, 20.0, 28.0)
q1 * q2 != q2 * q1 = true
</pre>
=={{header|Delphi}}==
Line 2,529 ⟶ 2,976:
? q1+(-2)
# value: (0 + 3i + 4j + 5k)</syntaxhighlight>
=={{header|EasyLang}}==
<syntaxhighlight>
func qnorm q[] .
for i to 4
s += q[i] * q[i]
.
return sqrt s
.
func[] qneg q[] .
for i to 4
q[i] = -q[i]
.
return q[]
.
func[] qconj q[] .
for i = 2 to 4
q[i] = -q[i]
.
return q[]
.
func[] qaddreal q[] r .
q[1] += r
return q[]
.
func[] qadd q[] q2[] .
for i to 4
q[i] += q2[i]
.
return q[]
.
func[] qmulreal q[] r .
for i to 4
q[i] *= r
.
return q[]
.
func[] qmul q1[] q2[] .
res[] &= q1[1] * q2[1] - q1[2] * q2[2] - q1[3] * q2[3] - q1[4] * q2[4]
res[] &= q1[1] * q2[2] + q1[2] * q2[1] + q1[3] * q2[4] - q1[4] * q2[3]
res[] &= q1[1] * q2[3] - q1[2] * q2[4] + q1[3] * q2[1] + q1[4] * q2[2]
res[] &= q1[1] * q2[4] + q1[2] * q2[3] - q1[3] * q2[2] + q1[4] * q2[1]
return res[]
.
q[] = [ 1 2 3 4 ]
q1[] = [ 2 3 4 5 ]
q2[] = [ 3 4 5 6 ]
r = 7
#
print "q = " & q[]
print "q1 = " & q1[]
print "q2 = " & q2[]
print "r = " & r
print "norm(q) = " & qnorm q[]
print "neg(q) = " & qneg q[]
print "conjugate(q) = " & qconj q[]
print "q+r = " & qaddreal q[] r
print "q1+q2 = " & qadd q1[] q2[]
print "qr = " & qmulreal q[] r
print "q1q2 = " & qmul q1[] q2[]
print "q2q1 = " & qmul q2[] q1[]
if q1[] <> q2[]
print "q1 != q2"
.
</syntaxhighlight>
{{out}}
<pre>
q = [ 1 2 3 4 ]
q1 = [ 2 3 4 5 ]
q2 = [ 3 4 5 6 ]
r = 7
norm(q) = 5.48
neg(q) = [ -1 -2 -3 -4 ]
conjugate(q) = [ 1 -2 -3 -4 ]
q+r = [ 8 2 3 4 ]
q1+q2 = [ 5 7 9 11 ]
qr = [ 7 14 21 28 ]
q1q2 = [ -56 16 24 26 ]
q2q1 = [ -56 18 20 28 ]
q1 != q2
</pre>
=={{header|Eero}}==
Line 2,653 ⟶ 3,182:
=={{header|Elena}}==
{{trans|C#}}
ELENA
<syntaxhighlight lang="elena">import system'math;
import extensions;
Line 2,660 ⟶ 3,189:
struct Quaternion
{
constructor new(a, b, c, d)
Line 4,744 ⟶ 5,273:
Print q1q2==q2q1 ' false
\\ multiplication and equality in one expression
Print
Print
}
CheckIt
Line 4,763 ⟶ 5,292:
True
False
True</pre>
Line 5,448 ⟶ 5,977:
q1q2 and q2q1 are different quaternions
</pre>
=={{header|Ol}}==
See also [[#Scheme|the entry for Scheme]].
<syntaxhighlight lang="scheme">
;;
;; This program is written to run without modification both in Otus
;; Lisp and in any of many Scheme dialects. I assume the presence of
;; "case-lambda", but not of "let-values". The program has worked
;; (without modification) in Otus Lisp 2.4, Guile >= 2.0 (but not in
;; Guile version 1.8), CHICKEN Scheme 5.3.0, Chez Scheme 9.5.8, Gauche
;; Scheme 0.9.12, Ypsilon 0.9.6-update3.
;;
;; Here a quaternion is represented as a linked list of four real
;; numbers. Such a representation probably has the greatest
;; portability between Scheme dialects. However, this representation
;; can be replaced, simply by redefining the procedures "quaternion?",
;; "quaternion-components", "quaternion->list", and "quaternion".
;;
(define (quaternion? q) ; Can q be used as a quaternion?
(and (pair? q)
(let ((a (car q))
(q (cdr q)))
(and (real? a) (pair? q)
(let ((b (car q))
(q (cdr q)))
(and (real? b) (pair? q)
(let ((c (car q))
(q (cdr q)))
(and (real? c) (pair? q)
(let ((d (car q))
(q (cdr q)))
(and (real? d) (null? q)))))))))))
(define (quaternion-components q) ; Extract the basis components.
(let ((a (car q))
(q (cdr q)))
(let ((b (car q))
(q (cdr q)))
(let ((c (car q))
(q (cdr q)))
(let ((d (car q)))
(values a b c d))))))
(define (quaternion->list q) ; Get a list of the basis components.
q)
(define quaternion ; Make a quaternion.
(case-lambda
((a b c d)
;; Make the quaternion from basis components.
(list a b c d))
((q)
;; Make the quaternion from a scalar or from another quaternion.
;; WARNING: in the latter case, the quaternion is NOT
;; copied. This is not a problem, if you avoid things like
;; "set-car!" and "set-cdr!".
(if (real? q)
(list q 0 0 0)
q))))
(define (quaternion-norm q) ; The euclidean norm of a quaternion.
(let ((q (quaternion q)))
(call-with-values (lambda () (quaternion-components q))
(lambda (a b c d)
(sqrt (+ (* a a) (* b b) (* c c) (* d d)))))))
(define (quaternion-conjugate q) ; Conjugate a quaternion.
(let ((q (quaternion q)))
(call-with-values (lambda () (quaternion-components q))
(lambda (a b c d)
(quaternion a (- b) (- c) (- d))))))
(define quaternion+ ; Add quaternions.
(let ((quaternion-add
(lambda (q1 q2)
(let ((q1 (quaternion q1))
(q2 (quaternion q2)))
(call-with-values
(lambda () (quaternion-components q1))
(lambda (a1 b1 c1 d1)
(call-with-values
(lambda () (quaternion-components q2))
(lambda (a2 b2 c2 d2)
(quaternion (+ a1 a2) (+ b1 b2)
(+ c1 c2) (+ d1 d2))))))))))
(case-lambda
(() (quaternion 0))
((q . q*)
(let loop ((accum q)
(q* q*))
(if (pair? q*)
(loop (quaternion-add accum (car q*)) (cdr q*))
accum))))))
(define quaternion- ; Negate or subtract quaternions.
(let ((quaternion-sub
(lambda (q1 q2)
(let ((q1 (quaternion q1))
(q2 (quaternion q2)))
(call-with-values
(lambda () (quaternion-components q1))
(lambda (a1 b1 c1 d1)
(call-with-values
(lambda () (quaternion-components q2))
(lambda (a2 b2 c2 d2)
(quaternion (- a1 a2) (- b1 b2)
(- c1 c2) (- d1 d2))))))))))
(case-lambda
((q)
(let ((q (quaternion q)))
(call-with-values (lambda () (quaternion-components q))
(lambda (a b c d)
(quaternion (- a) (- b) (- c) (- d))))))
((q . q*)
(let loop ((accum q)
(q* q*))
(if (pair? q*)
(loop (quaternion-sub accum (car q*)) (cdr q*))
accum))))))
(define quaternion* ; Multiply quaternions.
(let ((quaternion-mul
(lambda (q1 q2)
(let ((q1 (quaternion q1))
(q2 (quaternion q2)))
(call-with-values
(lambda () (quaternion-components q1))
(lambda (a1 b1 c1 d1)
(call-with-values
(lambda () (quaternion-components q2))
(lambda (a2 b2 c2 d2)
(quaternion (- (* a1 a2) (* b1 b2)
(* c1 c2) (* d1 d2))
(- (+ (* a1 b2) (* b1 a2) (* c1 d2))
(* d1 c2))
(- (+ (* a1 c2) (* c1 a2) (* d1 b2))
(* b1 d2))
(- (+ (* a1 d2) (* b1 c2) (* d1 a2))
(* c1 b2)))))))))))
(case-lambda
(() (quaternion 1))
((q . q*)
(let loop ((accum q)
(q* q*))
(if (pair? q*)
(loop (quaternion-mul accum (car q*)) (cdr q*))
accum))))))
(define quaternion=? ; Are the quaternions equal?
(let ((=? (lambda (q1 q2)
(let ((q1 (quaternion q1))
(q2 (quaternion q2)))
(call-with-values
(lambda () (quaternion-components q1))
(lambda (a1 b1 c1 d1)
(call-with-values
(lambda () (quaternion-components q2))
(lambda (a2 b2 c2 d2)
(and (= a1 a2) (= b1 b2)
(= c1 c2) (= d1 d2))))))))))
(lambda (q . q*)
(let loop ((q* q*))
(if (pair? q*)
(and (=? q (car q*))
(loop (cdr q*)))
#t)))))
(define q (quaternion 1 2 3 4))
(define q1 (quaternion 2 3 4 5))
(define q2 (quaternion 3 4 5 6))
(define r 7)
(display "q = ") (display (quaternion->list q)) (newline)
(display "q1 = ") (display (quaternion->list q1)) (newline)
(display "q2 = ") (display (quaternion->list q2)) (newline)
(display "r = ") (display r) (newline)
(newline)
(display "(quaternion? q) = ") (display (quaternion? q)) (newline)
(display "(quaternion? q1) = ") (display (quaternion? q1)) (newline)
(display "(quaternion? q2) = ") (display (quaternion? q2)) (newline)
(display "(quaternion? r) = ") (display (quaternion? r)) (newline)
(newline)
(display "(quaternion-norm q) = ")
(display (quaternion-norm q)) (newline)
(display "(quaternion-norm q1) = ")
(display (quaternion-norm q1)) (newline)
(display "(quaternion-norm q2) = ")
(display (quaternion-norm q2)) (newline)
(newline)
(display "(quaternion- q) = ")
(display (quaternion->list (quaternion- q))) (newline)
(display "(quaternion- q1 q2) = ")
(display (quaternion->list (quaternion- q1 q2))) (newline)
(display "(quaternion- q q1 q2) = ")
(display (quaternion->list (quaternion- q q1 q2))) (newline)
(newline)
(display "(quaternion-conjugate q) = ")
(display (quaternion->list (quaternion-conjugate q))) (newline)
(newline)
(display "(quaternion+) = ")
(display (quaternion->list (quaternion+))) (newline)
(display "(quaternion+ q) = ")
(display (quaternion->list (quaternion+ q))) (newline)
(display "(quaternion+ r q) = ")
(display (quaternion->list (quaternion+ r q))) (newline)
(display "(quaternion+ q r) = ")
(display (quaternion->list (quaternion+ q r))) (newline)
(display "(quaternion+ q1 q2) = ")
(display (quaternion->list (quaternion+ q1 q2))) (newline)
(display "(quaternion+ q q1 q2) = ")
(display (quaternion->list (quaternion+ q q1 q2))) (newline)
(newline)
(display "(quaternion*) = ")
(display (quaternion->list (quaternion*))) (newline)
(display "(quaternion* q) = ")
(display (quaternion->list (quaternion* q))) (newline)
(display "(quaternion* r q) = ")
(display (quaternion->list (quaternion* r q))) (newline)
(display "(quaternion* q r) = ")
(display (quaternion->list (quaternion* q r))) (newline)
(display "(quaternion* q1 q2) = ")
(display (quaternion->list (quaternion* q1 q2))) (newline)
(display "(quaternion* q q1 q2) = ")
(display (quaternion->list (quaternion* q q1 q2))) (newline)
(newline)
(display "(quaternion=? q) = ")
(display (quaternion=? q)) (newline)
(display "(quaternion=? q q) = ")
(display (quaternion=? q q)) (newline)
(display "(quaternion=? q1 q2) = ")
(display (quaternion=? q1 q2)) (newline)
(display "(quaternion=? q q q) = ")
(display (quaternion=? q q q)) (newline)
(display "(quaternion=? q1 q1 q2) = ")
(display (quaternion=? q1 q1 q2)) (newline)
(newline)
(display "(quaternion* q1 q2) = ")
(display (quaternion->list (quaternion* q1 q2))) (newline)
(display "(quaternion* q2 q1) = ")
(display (quaternion->list (quaternion* q2 q1))) (newline)
(display "(quaternion=? (quaternion* q1 q2)") (newline)
(display " (quaternion* q2 q1)) = ")
(display (quaternion=? (quaternion* q1 q2)
(quaternion* q2 q1))) (newline)
</syntaxhighlight>
{{out}}
<pre>$ ol quaternions_task.scm
q = (1 2 3 4)
q1 = (2 3 4 5)
q2 = (3 4 5 6)
r = 7
(quaternion? q) = #true
(quaternion? q1) = #true
(quaternion? q2) = #true
(quaternion? r) = #false
(quaternion-norm q) = 116161/21208
(quaternion-norm q1) = 898285873/122241224
(quaternion-norm q2) = 6216793393/670374072
(quaternion- q) = (-1 -2 -3 -4)
(quaternion- q1 q2) = (-1 -1 -1 -1)
(quaternion- q q1 q2) = (-4 -5 -6 -7)
(quaternion-conjugate q) = (1 -2 -3 -4)
(quaternion+) = (0 0 0 0)
(quaternion+ q) = (1 2 3 4)
(quaternion+ r q) = (8 2 3 4)
(quaternion+ q r) = (8 2 3 4)
(quaternion+ q1 q2) = (5 7 9 11)
(quaternion+ q q1 q2) = (6 9 12 15)
(quaternion*) = (1 0 0 0)
(quaternion* q) = (1 2 3 4)
(quaternion* r q) = (7 14 21 28)
(quaternion* q r) = (7 14 21 28)
(quaternion* q1 q2) = (-56 16 24 26)
(quaternion* q q1 q2) = (-264 -114 -132 -198)
(quaternion=? q) = #true
(quaternion=? q q) = #true
(quaternion=? q1 q2) = #false
(quaternion=? q q q) = #true
(quaternion=? q1 q1 q2) = #false
(quaternion* q1 q2) = (-56 16 24 26)
(quaternion* q2 q1) = (-56 18 20 28)
(quaternion=? (quaternion* q1 q2)
(quaternion* q2 q1)) = #false</pre>
=={{header|ooRexx}}==
Line 6,978 ⟶ 7,802:
|
≪ 0 1 4 '''FOR''' q OVER q GET SQ + '''NEXT''' √ SWAP DROP
≫ '
≪ NEG 1 DUP2 GET NEG PUT ≫ '
≪
DUP TYPE 3 == ≪ SWAP ≫ IFT
OVER 1 GET + 1 SWAP PUT
≫ '
≪
Line 6,994 ⟶ 7,818:
'a1*d2 + b1*c2 − c1*b2 + d1*a2' EVAL
{ 4 } →ARRY
≫ ≫ '
|
switch arguments if quaternion is at stack level 1
replace a by a+r
put the 2 quaternions in local variables
do the math in stack
Line 7,016 ⟶ 7,840:
|}
[1 2 3 4] <span style="color:blue">QNORM</span>
[1 2 3 4] NEG
[1 2 3 4]
[1 2 3 4] 7 <span style="color:blue">QRADD</span>
[
[1 2 3 4] 7
[2 3 4 5] [3 4 5 6]
[3 4 5 6] [2 3 4 5] <span style="color:blue">QMULT</span>
{{out}}
Line 7,052 ⟶ 7,873:
d a * b c CONJ * + C→R
{ 4 } →ARRY
≫ ≫ '
|
convert the 2 quaternions into 2 pairs of complex numbers
and store them locally
Line 7,063 ⟶ 7,884:
|}
Output is the same.
===Using the matrix form===
This efficient implementation is based on an article of [https://edspi31415.blogspot.com/2015/06/hp-prime-and-hp-50g-quaternions.html?fbclid=IwAR1KTjHt4xVt2FoMqL-82MJ1SS3SBg8jNoF-8uNcqg2Y5bLD2oiyxVfO88Y Eddie's Math and Calculator Blog].
« ARRY→ DROP → a b c d
« a b R→C c d R→C
c NEG d R→C
3 PICK CONJ
{ 2 2 } →ARRY
» » '<span style="color:blue">→QTM</span>' STO <span style="color:grey">''@ ( [ a b c d ] → [[ a+bi c+di ][ -c+di a-bi ]] )''</span>
« DUP 1 GET RE LASTARG IM
ROT 2 GET RE LASTARG IM
{ 4 } →ARRY
» '<span style="color:blue">QTM→</span>' STO <span style="color:grey">''@ ( [[ a+bi c+di ][ -c+di a-bi ]] → [ a b c d ] )''</span>
« <span style="color:blue">→QTM</span> SWAP <span style="color:blue">QTM→</span> SWAP * <span style="color:blue">QTM→</span>
» '<span style="color:blue">QMULT</span>' STO <span style="color:grey">''@ ( q1 q2 → q1*q2 ) ''</span>
« <span style="color:blue">→QTM</span> DET √ ABS
» '<span style="color:blue">QNORM</span>' STO <span style="color:grey">''@ ( q → qnorm(q) ) ''</span>
« DUP INV SWAP <span style="color:blue">QNORM</span> SQ *
» '<span style="color:blue">QCONJ</span>' STO <span style="color:grey">''@ ( q → conj(q) ) ''</span>
Quaternions' matrix form allows to quickly develop additional operations:
« DUP <span style="color:blue">QNORM</span> /
» '<span style="color:blue">QSIGN</span>' STO <span style="color:grey">''@ ( q → q/norm(q) ) ''</span>
« <span style="color:blue">→QTM</span> INV <span style="color:blue">QTM→</span>
» '<span style="color:blue">QINV</span>' STO <span style="color:grey">''@ ( q → q^(-1) ) ''</span>
« <span style="color:blue">QINV QMULT</span>
» '<span style="color:blue">QDIV</span>' STO <span style="color:grey">''@ ( q1 q2 → q1/q2 )''</span>
=={{header|Ruby}}==
Line 7,469 ⟶ 8,324:
q1/r = Q(0.29, 0.43i, 0.57j, 0.71k)
r/q1 = Q(0.26, -0.39i, -0.52j, -0.65k)</pre>
=={{header|Scheme}}==
For the source code, see [[#Ol|the entry for Otus Lisp]]. However, with most Scheme implementations the output will look different:
{{out}}
<pre>$ ypsilon quaternions_task.scm
q = (1 2 3 4)
q1 = (2 3 4 5)
q2 = (3 4 5 6)
r = 7
(quaternion? q) = #t
(quaternion? q1) = #t
(quaternion? q2) = #t
(quaternion? r) = #f
(quaternion-norm q) = 5.477225575051661
(quaternion-norm q1) = 7.3484692283495345
(quaternion-norm q2) = 9.273618495495704
(quaternion- q) = (-1 -2 -3 -4)
(quaternion- q1 q2) = (-1 -1 -1 -1)
(quaternion- q q1 q2) = (-4 -5 -6 -7)
(quaternion-conjugate q) = (1 -2 -3 -4)
(quaternion+) = (0 0 0 0)
(quaternion+ q) = (1 2 3 4)
(quaternion+ r q) = (8 2 3 4)
(quaternion+ q r) = (8 2 3 4)
(quaternion+ q1 q2) = (5 7 9 11)
(quaternion+ q q1 q2) = (6 9 12 15)
(quaternion*) = (1 0 0 0)
(quaternion* q) = (1 2 3 4)
(quaternion* r q) = (7 14 21 28)
(quaternion* q r) = (7 14 21 28)
(quaternion* q1 q2) = (-56 16 24 26)
(quaternion* q q1 q2) = (-264 -114 -132 -198)
(quaternion=? q) = #t
(quaternion=? q q) = #t
(quaternion=? q1 q2) = #f
(quaternion=? q q q) = #t
(quaternion=? q1 q1 q2) = #f
(quaternion* q1 q2) = (-56 16 24 26)
(quaternion* q2 q1) = (-56 18 20 28)
(quaternion=? (quaternion* q1 q2)
(quaternion* q2 q1)) = #f</pre>
=={{header|Seed7}}==
Line 8,251 ⟶ 9,156:
=={{header|Wren}}==
<syntaxhighlight lang="
construct new(a, b, c, d ) {
_a = a
| |||