Quaternion type: Difference between revisions

← Older editNewer edit →
Content deleted Content added
Line 164: Line 164:
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''}}
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''}}
<lang algol68>MODE QUAT = STRUCT(REAL re, i, j, k);
<lang algol68>MODE QUAT = STRUCT(REAL re, i, j, k);
⚫
MODE QUATERNION = QUAT;
MODE SUBQ = UNION(QUAT, #COMPL,# REAL#, INT, [4]REAL, [4]INT # );
MODE SUBQUAT = UNION(QUAT, #COMPL, # REAL#, INT, [4]REAL, [4]INT # );


MODE CLASSQUAT = STRUCT(
MODE CLASSQUAT = STRUCT(
PROC (REF QUAT #new#, REAL #re#, REAL #i#, REAL #j#, REAL #k#)REF QUAT new,
PROC (REF QUAT #new#, REAL #re#, REAL #i#, REAL #j#, REAL #k#)REF QUAT new,
PROC (REF QUAT #self#)QUAT conjugate,
PROC (REF QUAT #self#)QUAT conjugate,
Line 174: Line 175:
PROC (REF QUAT #self#)STRING repr,
PROC (REF QUAT #self#)STRING repr,
PROC (REF QUAT #self#)QUAT neg,
PROC (REF QUAT #self#)QUAT neg,
PROC (REF QUAT #self#, SUBQ #other#)QUAT add,
PROC (REF QUAT #self#, SUBQUAT #other#)QUAT add,
PROC (REF QUAT #self#, SUBQ #other#)QUAT radd,
PROC (REF QUAT #self#, SUBQUAT #other#)QUAT radd,
PROC (REF QUAT #self#, SUBQ #other#)QUAT sub,
PROC (REF QUAT #self#, SUBQUAT #other#)QUAT sub,
PROC (REF QUAT #self#, SUBQ #other#)QUAT mul,
PROC (REF QUAT #self#, SUBQUAT #other#)QUAT mul,
PROC (REF QUAT #self#, SUBQ #other#)QUAT rmul,
PROC (REF QUAT #self#, SUBQUAT #other#)QUAT rmul,
PROC (REF QUAT #self#, SUBQ #other#)QUAT div,
PROC (REF QUAT #self#, SUBQUAT #other#)QUAT div,
PROC (REF QUAT #self#, SUBQ #other#)QUAT rdiv,
PROC (REF QUAT #self#, SUBQUAT #other#)QUAT rdiv,
PROC (REF QUAT #self#)QUAT exp
PROC (REF QUAT #self#)QUAT exp
);
);
Line 208: Line 209:
# PROC repr =#(REF QUAT self)STRING: (
# PROC repr =#(REF QUAT self)STRING: (
# 'Shorter form of Quaternion as string' #
# 'Shorter form of Quaternion as string' #
FILE f; STRING s; associate(f,s);
FILE f; STRING s; associate(f, s);
putf(f, (squat fmt, re OF self>=0, re OF self,
putf(f, (squat fmt, re OF self>=0, re OF self,
i OF self>=0, i OF self, j OF self>=0, j OF self, k OF self>=0, k OF self));
i OF self>=0, i OF self, j OF self>=0, j OF self, k OF self>=0, k OF self));
Line 218: Line 219:
(-re OF self, -i OF self, -j OF self, -k OF self),
(-re OF self, -i OF self, -j OF self, -k OF self),


# PROC add =#(REF QUAT self, SUBQ other)QUAT:
# PROC add =#(REF QUAT self, SUBQUAT other)QUAT:
CASE other IN
CASE other IN
(QUAT other): (re OF self + re OF other, i OF self + i OF other, j OF self + j OF other, k OF self + k OF other),
(QUAT other): (re OF self + re OF other, i OF self + i OF other, j OF self + j OF other, k OF self + k OF other),
Line 224: Line 225:
ESAC,
ESAC,


# PROC radd =#(REF QUAT self, SUBQ other)QUAT:
# PROC radd =#(REF QUAT self, SUBQUAT other)QUAT:
(add OF class quat)(self, other),
(add OF class quat)(self, other),


# PROC sub =#(REF QUAT self, SUBQ other)QUAT:
# PROC sub =#(REF QUAT self, SUBQUAT other)QUAT:
CASE other IN
CASE other IN
(QUAT other): (re OF self - re OF other, i OF self - i OF other, j OF self - j OF other, k OF self - k OF other),
(QUAT other): (re OF self - re OF other, i OF self - i OF other, j OF self - j OF other, k OF self - k OF other),
Line 233: Line 234:
ESAC,
ESAC,


# PROC mul =#(REF QUAT self, SUBQ other)QUAT:
# PROC mul =#(REF QUAT self, SUBQUAT other)QUAT:
CASE other IN
CASE other IN
(QUAT other):(
(QUAT other):(
Line 244: Line 245:
ESAC,
ESAC,


# PROC rmul =#(REF QUAT self, SUBQ other)QUAT:
# PROC rmul =#(REF QUAT self, SUBQUAT other)QUAT:
CASE other IN
CASE other IN
(QUAT other): (mul OF class quat)(LOC QUAT := other, self),
(QUAT other): (mul OF class quat)(LOC QUAT := other, self),
Line 250: Line 251:
ESAC,
ESAC,


# PROC div =#(REF QUAT self, SUBQ other)QUAT:
# PROC div =#(REF QUAT self, SUBQUAT other)QUAT:
CASE other IN
CASE other IN
(QUAT other): (mul OF class quat)(self, (reciprocal OF class quat)(LOC QUAT := other)),
(QUAT other): (mul OF class quat)(self, (reciprocal OF class quat)(LOC QUAT := other)),
Line 256: Line 257:
ESAC,
ESAC,


# PROC rdiv =#(REF QUAT self, SUBQ other)QUAT:
# PROC rdiv =#(REF QUAT self, SUBQUAT other)QUAT:
CASE other IN
CASE other IN
(QUAT other): (div OF class quat)(LOC QUAT := other, self),
(QUAT other): (div OF class quat)(LOC QUAT := other, self),
(REAL other): (div OF class quat)(LOC QUAT := (other,0,0,0), self)
(REAL other): (div OF class quat)(LOC QUAT := (other, 0, 0, 0), self)
ESAC,
ESAC,


Line 272: Line 273:
);
);


FORMAT real fmt = $g(-0,4)$;
FORMAT real fmt = $g(-0, 4)$;
⚫
FORMAT signed fmt = $b("+", "")f(real fmt)$;

FORMAT quat fmt = $f(real fmt)"+"f(real fmt)"i+"f(real fmt)"j+"f(real fmt)"k"$;
FORMAT quat fmt = $f(real fmt)"+"f(real fmt)"i+"f(real fmt)"j+"f(real fmt)"k"$;
⚫
FORMAT squat fmt = $f(signed fmt)f(signed fmt)"i"f(signed fmt)"j"f(signed fmt)"k"$;


⚫
PRIO INIT = 1;
⚫
FORMAT s fmt = $b("+","")f(real fmt)$;
⚫
OP INIT = (REF QUAT new)REF QUAT: new := (0, 0, 0, 0);
⚫
FORMAT squat fmt = $f(s fmt)f(s fmt)"i"f(s fmt)"j"f(s fmt)"k"$;
OP INIT = (REF QUAT new, []REAL rijk)REF QUAT:
(new OF class quat)(LOC QUAT := new, rijk[1], rijk[2], rijk[3], rijk[4]);


OP + = (QUAT q)QUAT: q,
PRIO INITQ = 1;
OP INITQ = (REF QUAT new q, []REAL rijk)REF QUAT:
- = (QUAT q)QUAT: (neg OF class quat)(LOC QUAT := q),
(new OF class quat)(LOC QUAT := new q, rijk[1], rijk[2], rijk[3], rijk[4]);
CONJ = (QUAT q)QUAT: (conjugate OF class quat)(LOC QUAT := q),
⚫
ABS = (QUAT q)REAL: (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 + = (QUAT q)QUAT: q;
OP +:= = (REF QUAT a, QUAT b)QUAT: a:=( add OF class quat)(a, b),
OP - = (QUAT q)QUAT: (neg OF class quat)(LOC QUAT := q);
+:= = (REF QUAT a, REAL b)QUAT: a:=( add OF class quat)(a, b),
OP CONJ = (QUAT q)QUAT: (conjugate OF class quat)(LOC QUAT := q);
+=: = (QUAT a, REF QUAT b)QUAT: b:=(radd OF class quat)(b, a),
OP ABS = (QUAT q)REAL: (norm OF class quat)(LOC QUAT := q);
+=: = (REAL a, REF QUAT b)QUAT: b:=(radd OF class quat)(b, a);
⚫
# missing: Worthy PLUSAB, PLUSTO for SHORT/LONG INT REAL & COMPL #
⚫
OP REPR = (QUAT q)STRING: (repr OF class quat)(LOC QUAT := q);


PROC quat exp = (QUAT q)QUAT: (exp OF class quat)(LOC QUAT := q);
OP -:= = (REF QUAT a, QUAT b)QUAT: a:=( sub OF class quat)(a, b),
⚫
-:= = (REF QUAT a, REAL b)QUAT: a:=( sub OF class quat)(a, b);
⚫
CO todo: quat arc{sin,cos,tan}h, log, exp, ln etc END CO
⚫
# missing: Worthy MINUSAB for SHORT/LONG INT REAL & COMPL #


⚫
PRIO *=: = 1, /=: = 1;
⚫
# OP +:= = (REF QUAT a, QUAT b)QUAT: (add OF class quat)(a,b); #
OP +:= = (REF QUAT a, QUAT b)QUAT: a:=(add OF class quat)(a,b);
OP *:= = (REF QUAT a, QUAT b)QUAT: a:=( mul OF class quat)(a, b),
OP +:= = (REF QUAT a, REAL b)QUAT: a:=(add OF class quat)(a,b);
*:= = (REF QUAT a, REAL b)QUAT: a:=( mul OF class quat)(a, b),
OP +=: = (QUAT a, REF QUAT b)QUAT: b:=(radd OF class quat)(b,a);
*=: = (QUAT a, REF QUAT b)QUAT: b:=(rmul OF class quat)(b, a),
⚫
*=: = (REAL a, REF QUAT b)QUAT: b:=(rmul OF class quat)(b, a);
⚫
CO todo: PLUSAB PLUSTO and SHORT/LONG INT REAL & Compl CO
⚫
# missing: Worthy TIMESAB, TIMESTO for SHORT/LONG INT REAL & COMPL #


OP -:= = (REF QUAT a, QUAT b)QUAT: a:=(sub OF class quat)(a,b);
OP /:= = (REF QUAT a, QUAT b)QUAT: a:=( div OF class quat)(a, b),
OP -:= = (REF QUAT a, REAL b)QUAT: a:=(sub OF class quat)(a,b);
/:= = (REF QUAT a, REAL b)QUAT: a:=( div OF class quat)(a, b),
⚫
/=: = (QUAT a, REF QUAT b)QUAT: b:=(rdiv OF class quat)(b, a),
⚫
CO todo: MINUSAB and SHORT/LONG INT REAL & Compl CO
⚫
/=: = (REAL a, REF QUAT b)QUAT: b:=(rdiv OF class quat)(b, a);
⚫
# missing: Worthy OVERAB, OVERTO for SHORT/LONG INT REAL & COMPL #


OP *:= = (REF QUAT a, QUAT b)QUAT: a:=(mul OF class quat)(a,b);
OP + = (QUAT a, b)QUAT: ( add OF class quat)(LOC QUAT := a, b),
OP *:= = (REF QUAT a, REAL b)QUAT: a:=(mul OF class quat)(a,b);
+ = (QUAT a, REAL b)QUAT: ( add OF class quat)(LOC QUAT := a, b),
⚫
+ = (REAL a, QUAT b)QUAT: (radd OF class quat)(LOC QUAT := b, a);
⚫
PRIO *=: = 1;
⚫
OP *=: = (QUAT a, REF QUAT b)QUAT: b:=(rmul OF class quat)(b,a);
⚫
CO todo: TIMESAB TIMESTO and SHORT/LONG INT REAL & Compl CO


OP /:= = (REF QUAT a, QUAT b)QUAT: a:=(div OF class quat)(a,b);
OP - = (QUAT a, b)QUAT: ( sub OF class quat)(LOC QUAT := a, b),
OP /:= = (REF QUAT a, REAL b)QUAT: a:=(div OF class quat)(a,b);
- = (QUAT a, REAL b)QUAT: ( sub OF class quat)(LOC QUAT := a, b),
- = (REAL a, QUAT b)QUAT:-( sub OF class quat)(LOC QUAT := b, a);
⚫
CO todo: OVERAB and SHORT/LONG INT REAL & Compl CO


OP + = (QUAT a, b)QUAT: (add OF class quat)(LOC QUAT := a,b);
OP * = (QUAT a, b)QUAT: ( mul OF class quat)(LOC QUAT := a, b),
OP + = (QUAT a, REAL b)QUAT: (add OF class quat)(LOC QUAT := a,b);
* = (QUAT a, REAL b)QUAT: ( mul OF class quat)(LOC QUAT := a, b),
OP + = (REAL a, QUAT b)QUAT: (radd OF class quat)(LOC QUAT := b,a);
* = (REAL a, QUAT b)QUAT: (rmul OF class quat)(LOC QUAT := b, a);


OP - = (QUAT a, b)QUAT: (sub OF class quat)(LOC QUAT := a,b);
OP / = (QUAT a, b)QUAT: ( div OF class quat)(LOC QUAT := a, b),
OP - = (QUAT a, REAL b)QUAT: (sub OF class quat)(LOC QUAT := a,b);
/ = (QUAT a, REAL b)QUAT: ( div OF class quat)(LOC QUAT := a, b),
OP - = (REAL a, QUAT b)QUAT:-(sub OF class quat)(LOC QUAT := b,a);
/ = (REAL a, QUAT b)QUAT: ( div OF class quat)(LOC QUAT := b, 1/a);


OP * = (QUAT a, b)QUAT: (mul OF class quat)(LOC QUAT := a,b);
PROC quat exp = (QUAT q)QUAT: (exp OF class quat)(LOC QUAT := q);
⚫
# missing: quat arc{sin, cos, tan}h, log, exp, ln etc END #
⚫
OP * = (QUAT a, REAL b)QUAT: (mul OF class quat)(LOC QUAT := a,b);
⚫
OP * = (REAL 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);
⚫
OP / = (QUAT a, REAL b)QUAT: (div OF class quat)(LOC QUAT := a,b);
⚫
OP / = (REAL a, QUAT b)QUAT: (div OF class quat)(LOC QUAT := b, 1/a);

CO - OPerators to do:
⚫
Diadic: I, J, K,
PLUSAB, MINUSAB, TIMESAB, DIVAB, PLUSTO, TIMESTO,
+:=, -:=, *:=, /:=, +=:, *=: etc
END CO

⚫
MODE QUATERNION = QUAT;


test:(
test:(
⚫
REAL r = 7;
QUAT q = (1, 2, 3, 4),
QUAT q = (1, 2, 3, 4),
q1 = (2, 3, 4, 5),
q1 = (2, 3, 4, 5),
q2 = (3, 4, 5, 6),
q2 = (3, 4, 5, 6);
⚫
REAL r = 7;


printf((
printf((
⚫
$"r = " f(real fmt)l$, r,
$"q = " f(quat fmt)l$, q,
$"q = " f(quat fmt)l$, q,
$"q1 = " f(quat fmt)l$, q1,
$"q1 = " f(quat fmt)l$, q1,
$"q2 = " f(quat fmt)l$, q2,
$"q2 = " f(quat fmt)l$, q2,
⚫
$"r = " f(real fmt)l$, r,
$"ABS q = " f(real fmt)", "$, ABS q,
$"ABS q = " f(real fmt)", "$, ABS q,
$"ABS q1 = " f(real fmt)", "$, ABS q1,
$"ABS q1 = " f(real fmt)", "$, ABS q1,
Line 365: Line 363:
END CO
END CO


QUAT i=(0,1,0,0),
QUAT i=(0, 1, 0, 0),
j=(0,0,1,0),
j=(0, 0, 1, 0),
k=(0,0,0,1);
k=(0, 0, 0, 1);


printf((
printf((
Line 383: Line 381:
$"quat exp(pi * i) = " f(quat fmt)l$, quat exp(pi * k)
$"quat exp(pi * i) = " f(quat fmt)l$, quat exp(pi * k)
));
));
print((REPR(-q1*q2),",",REPR(-q2*q1),new line))
print((REPR(-q1*q2), ", ", REPR(-q2*q1), new line))
)</lang>
)</lang>
Output:
Output:
<pre>
<pre>
⚫
r = 7.0000
q = 1.0000+2.0000i+3.0000j+4.0000k
q = 1.0000+2.0000i+3.0000j+4.0000k
q1 = 2.0000+3.0000i+4.0000j+5.0000k
q1 = 2.0000+3.0000i+4.0000j+5.0000k
q2 = 3.0000+4.0000i+5.0000j+6.0000k
q2 = 3.0000+4.0000i+5.0000j+6.0000k
⚫
r = 7.0000
ABS q = 5.4772, ABS q1 = 7.3485, ABS q2 = 9.2736
ABS q = 5.4772, ABS q1 = 7.3485, ABS q2 = 9.2736
-q = -1.0000+-2.0000i+-3.0000j+-4.0000k
-q = -1.0000+-2.0000i+-3.0000j+-4.0000k
Line 414: Line 412:
quat exp(pi * j) = -1.0000+.0000i+.0000j+.0000k
quat exp(pi * j) = -1.0000+.0000i+.0000j+.0000k
quat exp(pi * i) = -1.0000+.0000i+.0000j+.0000k
quat exp(pi * i) = -1.0000+.0000i+.0000j+.0000k
+56.0000-16.0000i-24.0000j-26.0000k,+56.0000-18.0000i-20.0000j-28.0000k
+56.0000-16.0000i-24.0000j-26.0000k, +56.0000-18.0000i-20.0000j-28.0000k
</pre>
</pre>


Retrieved from "https://rosettacode.org/wiki/Quaternion_type"