Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
101
Task/Quaternion-type/ALGOL-W/quaternion-type.alg
Normal file
101
Task/Quaternion-type/ALGOL-W/quaternion-type.alg
Normal file
|
|
@ -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.
|
||||
77
Task/Quaternion-type/Common-Lisp/quaternion-type.lisp
Normal file
77
Task/Quaternion-type/Common-Lisp/quaternion-type.lisp
Normal file
|
|
@ -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)))
|
||||
38
Task/Quaternion-type/Mercury/quaternion-type-1.mercury
Normal file
38
Task/Quaternion-type/Mercury/quaternion-type-1.mercury
Normal file
|
|
@ -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 ).
|
||||
76
Task/Quaternion-type/Mercury/quaternion-type-2.mercury
Normal file
76
Task/Quaternion-type/Mercury/quaternion-type-2.mercury
Normal file
|
|
@ -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.
|
||||
|
|
@ -1,49 +1,64 @@
|
|||
type quaternion = float * float * float * float
|
||||
type quaternion = {a: float; b: float; c: float; d: float}
|
||||
|
||||
let q a b c d = (a, b, c, d)
|
||||
let norm q = sqrt (q.a**2.0 +.
|
||||
q.b**2.0 +.
|
||||
q.c**2.0 +.
|
||||
q.d**2.0 )
|
||||
|
||||
let to_real (r, _, _, _) = r
|
||||
let imag (_, i, j, k) = (i, j, k)
|
||||
let floatneg r = ~-. r (* readability *)
|
||||
|
||||
let quaternion_of_scalar s = (s, 0.0, 0.0, 0.0)
|
||||
let negative q =
|
||||
{a = floatneg q.a;
|
||||
b = floatneg q.b;
|
||||
c = floatneg q.c;
|
||||
d = floatneg q.d }
|
||||
|
||||
let to_list (a, b, c, d) = [a; b; c; d]
|
||||
let of_list = function [a; b; c; d] -> (a, b, c, d)
|
||||
| _ -> invalid_arg "of_list"
|
||||
let conjugate q =
|
||||
{a = q.a;
|
||||
b = floatneg q.b;
|
||||
c = floatneg q.c;
|
||||
d = floatneg q.d }
|
||||
|
||||
let ( + ) = ( +. )
|
||||
let ( - ) = ( -. )
|
||||
let ( * ) = ( *. )
|
||||
let ( / ) = ( /. )
|
||||
let addrq r q = {q with a = q.a +. r}
|
||||
|
||||
let addr (a, b, c, d) r = (a+r, b, c, d)
|
||||
let mulr (a, b, c, d) r = (a*r, b*r, c*r, d*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 add (a, b, c, d) (p, q, r, s) = (a+p, b+q, c+r, d+s)
|
||||
let multrq r q =
|
||||
{a = q.a *. r;
|
||||
b = q.b *. r;
|
||||
c = q.c *. r;
|
||||
d = q.d *. r }
|
||||
|
||||
let sub (a, b, c, d) (p, q, r, s) = (a-p, b-q, c-r, d-s)
|
||||
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 mul (a, b, c, d) (p, q, r, s) =
|
||||
( 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 )
|
||||
let qmake a b c d = {a;b;c;d} (* readability omitting a= b=... *)
|
||||
|
||||
let norm2 (a, b, c, d) =
|
||||
( a * a +
|
||||
b * b +
|
||||
c * c +
|
||||
d * d )
|
||||
let qstring q =
|
||||
Printf.sprintf "(%g, %g, %g, %g)" q.a q.b q.c q.d ;;
|
||||
|
||||
let norm q = sqrt(norm2 q)
|
||||
(* 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 conj (a, b, c, d) = (a, -. b, -. c, -. d)
|
||||
let neg (a, b, c, d) = (-. a, -. b, -. c, -. d)
|
||||
|
||||
let unit ((a, b, c, d) as q) =
|
||||
let n = norm q in
|
||||
(a/n, b/n, c/n, d/n)
|
||||
|
||||
let reciprocal ((a, b, c, d) as q) =
|
||||
let n2 = norm2 q in
|
||||
(a/n2, b/n2, c/n2, d/n2)
|
||||
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";
|
||||
|
|
|
|||
|
|
@ -1,18 +1,11 @@
|
|||
type quaternion = float * float * float * float
|
||||
|
||||
val q : float -> float -> float -> float -> quaternion
|
||||
val to_real : quaternion -> float
|
||||
val imag : quaternion -> float * float * float
|
||||
val quaternion_of_scalar : float -> quaternion
|
||||
val to_list : quaternion -> float list
|
||||
val of_list : float list -> quaternion
|
||||
val addr : quaternion -> float -> quaternion
|
||||
val mulr : quaternion -> float -> quaternion
|
||||
val add : quaternion -> quaternion -> quaternion
|
||||
val sub : quaternion -> quaternion -> quaternion
|
||||
val mul : quaternion -> quaternion -> quaternion
|
||||
val norm : quaternion -> float
|
||||
val conj : quaternion -> quaternion
|
||||
val neg : quaternion -> quaternion
|
||||
val unit : quaternion -> quaternion
|
||||
val reciprocal : quaternion -> quaternion
|
||||
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>
|
||||
|
|
|
|||
|
|
@ -1,48 +1,45 @@
|
|||
/*REXX program to perform simple operations of quaternion type numbers.*/
|
||||
q = 1 2 3 4 ; q1 = 2 3 4 5
|
||||
r = 7 ; q2 = 3 4 5 6
|
||||
call quatShow q , 'q'
|
||||
call quatShow q1 , 'q1'
|
||||
call quatShow q2 , 'q2'
|
||||
call quatShow r , 'r'
|
||||
call quatShow quatNorm(q) , 'norm q' , "task 1:"
|
||||
call quatShow quatNeg(q) , 'negative q' , "task 2:"
|
||||
call quatShow quatConj(q) , 'conjugate q' , "task 3:"
|
||||
call quatShow quatAdd( r, q ) , 'addition r+q' , "task 4:"
|
||||
call quatShow quatAdd(q1, q2 ) , 'addition q1+q2' , "task 5:"
|
||||
call quatShow quatMul( q, r ) , 'multiplication q*r' , "task 6:"
|
||||
call quatShow quatMul(q1, q2 ) , 'multiplication q1*q2' , "task 7:"
|
||||
call quatShow quatMul(q2, q1 ) , 'multiplication q2*q1' , "task 8:"
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────QUATADD─────────────────────────────*/
|
||||
quatAdd: procedure; parse arg x,y; call quatXY 2
|
||||
return x.1+y.1 x.2+y.2 x.3+y.3 x.4+y.4
|
||||
/*──────────────────────────────────QUATCONJ────────────────────────────*/
|
||||
quatConj: procedure; parse arg x; call quatXY
|
||||
return x.1 (-x.2) (-x.3) (-x.4)
|
||||
/*──────────────────────────────────QUATMUL─────────────────────────────*/
|
||||
quatMul: procedure; parse arg x,y; call quatXY 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
|
||||
/*──────────────────────────────────QUATNEG─────────────────────────────*/
|
||||
quatNeg: procedure; parse arg x; call quatXY
|
||||
return -x.1 (-x.2) (-x.3) (-x.4)
|
||||
/*──────────────────────────────────QUATNORM────────────────────────────*/
|
||||
quatNorm: procedure; parse arg x; call quatXY
|
||||
return sqrt(x.1**2 + x.2**2 + x.3**2 + x.4**2)
|
||||
/*──────────────────────────────────QUATSHOW────────────────────────────*/
|
||||
quatShow: procedure; parse arg x; call quatXY; quat=
|
||||
do m=1 for 4; _=x.m; if _==0 then iterate; if _ >=0 then _='+'_
|
||||
if m\==1 then _=_||substr('~ijk',m,1) ; quat=strip(quat || _,,'+')
|
||||
end /*m*/
|
||||
say left(arg(3),9) right(arg(2),20) ' ──► ' quat
|
||||
return quat
|
||||
/*──────────────────────────────────QUATXY──────────────────────────────*/
|
||||
quatXY: 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 subroutine─────────────────────*/
|
||||
sqrt: procedure;parse arg x;if x=0 then return 0;d=digits();numeric digits 11
|
||||
m.=11;numeric form;p=d+d%4+2;parse value format(x,2,1,,0) 'E0' with g 'E' _ .
|
||||
g=g*.5'E'_%2; do j=0 while p>9; m.j=p; p=p%2+1; end; do k=j+5 to 0 by -1
|
||||
if m.k>11 then numeric digits m.k;g=.5*(g+x/g);end;numeric digits d;return g/1
|
||||
/*REXX pgm performs some operations on quaternion type numbers and shows 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)
|
||||
/*──────────────────────────────────────────────────────────────────────────────*/
|
||||
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
|
||||
/*──────────────────────────────────────────────────────────────────────────────*/
|
||||
qNorm: procedure; parse arg x; call qXY; return sqrt(x.1**2+x.2**2+x.3**2+x.4**2)
|
||||
/*──────────────────────────────────────────────────────────────────────────────*/
|
||||
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
|
||||
numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
|
||||
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. */
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue