Anonymous user
Quaternion type: Difference between revisions
Added solution for Action!
(Added solution for Action!) |
|||
Line 53:
* [http://www.maths.tcd.ie/pub/HistMath/People/Hamilton/QLetter/QLetter.pdf On Quaternions]; or on a new System of Imaginaries in Algebra. By Sir William Rowan Hamilton LL.D, P.R.I.A., F.R.A.S., Hon. M. R. Soc. Ed. and Dub., Hon. or Corr. M. of the Royal or Imperial Academies of St. Petersburgh, Berlin, Turin and Paris, Member of the American Academy of Arts and Sciences, and of other Scientific Societies at Home and Abroad, Andrews' Prof. of Astronomy in the University of Dublin, and Royal Astronomer of Ireland.
<br><br>
=={{header|Action!}}==
{{libheader|Action! Tool Kit}}
{{libheader|Action! Real Math}}
<lang Action!>INCLUDE "H6:REALMATH.ACT"
DEFINE A_="+0"
DEFINE B_="+6"
DEFINE C_="+12"
DEFINE D_="+18"
TYPE Quaternion=[CARD a1,a2,a3,b1,b2,b3,c1,c2,c3,d1,d2,d3]
REAL neg
PROC Init()
ValR("-1",neg)
RETURN
BYTE FUNC Positive(REAL POINTER x)
BYTE ARRAY tmp
tmp=x
IF (tmp(0)&$80)=$00 THEN
RETURN (1)
FI
RETURN (0)
PROC PrintQuat(Quaternion POINTER q)
PrintR(q A_)
IF Positive(q B_) THEN Put('+) FI
PrintR(q B_) Put('i)
IF Positive(q C_) THEN Put('+) FI
PrintR(q C_) Put('j)
IF Positive(q D_) THEN Put('+) FI
PrintR(q D_) Put('k)
RETURN
PROC PrintQuatE(Quaternion POINTER q)
PrintQuat(q) PutE()
RETURN
PROC QuatIntInit(Quaternion POINTER q INT ia,ib,ic,id)
IntToReal(ia,q A_)
IntToReal(ib,q B_)
IntToReal(ic,q C_)
IntToReal(id,q D_)
RETURN
PROC Sqr(REAL POINTER a,b)
RealMult(a,a,b)
RETURN
PROC QuatNorm(Quaternion POINTER q REAL POINTER res)
REAL r1,r2,r3
Sqr(q A_,r1) ;r1=q.a^2
Sqr(q B_,r2) ;r2=q.b^2
RealAdd(r1,r2,r3) ;r3=q.a^2+q.b^2
Sqr(q C_,r1) ;r1=q.c^2
RealAdd(r3,r1,r2) ;r2=q.a^2+q.b^2+q.c^2
Sqr(q D_,r1) ;r1=q.d^2
RealAdd(r2,r1,r3) ;r3=q.a^2+q.b^2+q.c^2+q.d^2
Sqrt(r3,res) ;res=sqrt(q.a^2+q.b^2+q.c^2+q.d^2)
RETURN
PROC QuatNegative(Quaternion POINTER q,res)
RealMult(q A_,neg,res A_) ;res.a=-q.a
RealMult(q B_,neg,res B_) ;res.b=-q.b
RealMult(q C_,neg,res C_) ;res.c=-q.c
RealMult(q D_,neg,res D_) ;res.d=-q.d
RETURN
PROC QuatConjugate(Quaternion POINTER q,res)
RealAssign(q A_,res A_) ;res.a=q.a
RealMult(q B_,neg,res B_) ;res.b=-q.b
RealMult(q C_,neg,res C_) ;res.c=-q.c
RealMult(q D_,neg,res D_) ;res.d=-q.d
RETURN
PROC QuatAddReal(Quaternion POINTER q REAL POINTER r
Quaternion POINTER res)
RealAdd(q A_,r,res A_) ;res.a=q.a+r
RealAssign(q B_,res B_) ;res.b=q.b
RealAssign(q C_,res C_) ;res.c=q.c
RealAssign(q D_,res D_) ;res.d=q.d
RETURN
PROC QuatAdd(Quaternion POINTER q1,q2,res)
RealAdd(q1 A_,q2 A_,res A_) ;res.a=q1.a+q2.a
RealAdd(q1 B_,q2 B_,res B_) ;res.b=q1.b+q2.b
RealAdd(q1 C_,q2 C_,res C_) ;res.c=q1.c+q2.c
RealAdd(q1 D_,q2 D_,res D_) ;res.d=q1.d+q2.d
RETURN
PROC QuatMultReal(Quaternion POINTER q REAL POINTER r
Quaternion POINTER res)
RealMult(q A_,r,res A_) ;res.a=q.a*r
RealMult(q B_,r,res B_) ;res.b=q.b*r
RealMult(q C_,r,res C_) ;res.c=q.c*r
RealMult(q D_,r,res D_) ;res.d=q.d*r
RETURN
PROC QuatMult(Quaternion POINTER q1,q2,res)
REAL r1,r2
RealMult(q1 A_,q2 A_,r1) ;r1=q1.a*q2.a
RealMult(q1 B_,q2 B_,r2) ;r2=q1.b*q2.b
RealSub(r1,r2,r3) ;r3=q1.a*q2.a-q1.b*q2.b
RealMult(q1 C_,q2 C_,r1) ;r1=q1.c*q2.c
RealSub(r3,r1,r2) ;r2=q1.a*q2.a-q1.b*q2.b-q1.c*q2.c
RealMult(q1 D_,q2 D_,r1) ;r1=q1.d*q2.d
RealSub(r2,r1,res A_) ;res.a=q1.a*q2.a-q1.b*q2.b-q1.c*q2.c-q1.d*q2.d
RealMult(q1 A_,q2 B_,r1) ;r1=q1.a*q2.b
RealMult(q1 B_,q2 A_,r2) ;r2=q1.b*q2.a
RealAdd(r1,r2,r3) ;r3=q1.a*q2.b+q1.b*q2.a
RealMult(q1 C_,q2 D_,r1) ;r1=q1.c*q2.d
RealAdd(r3,r1,r2) ;r2=q1.a*q2.b+q1.b*q2.a+q1.c*q2.d
RealMult(q1 D_,q2 C_,r1) ;r1=q1.d*q2.c
RealSub(r2,r1,res B_) ;res.b=q1.a*q2.b+q1.b*q2.a+q1.c*q2.d-q1.d*q2.c
RealMult(q1 A_,q2 C_,r1) ;r1=q1.a*q2.c
RealMult(q1 B_,q2 D_,r2) ;r2=q1.b*q2.d
RealSub(r1,r2,r3) ;r3=q1.a*q2.c-q1.b*q2.d
RealMult(q1 C_,q2 A_,r1) ;r1=q1.c*q2.a
RealAdd(r3,r1,r2) ;r2=q1.a*q2.c-q1.b*q2.d+q1.c*q2.a
RealMult(q1 D_,q2 B_,r1) ;r1=q1.d*q2.b
RealAdd(r2,r1,res C_) ;res.c=q1.a*q2.c-q1.b*q2.d+q1.c*q2.a+q1.d*q2.b
RealMult(q1 A_,q2 D_,r1) ;r1=q1.a*q2.d
RealMult(q1 B_,q2 C_,r2) ;r2=q1.b*q2.c
RealAdd(r1,r2,r3) ;r3=q1.a*q2.d+q1.b*q2.c
RealMult(q1 C_,q2 B_,r1) ;r1=q1.c*q2.b
RealSub(r3,r1,r2) ;r2=q1.a*q2.d+q1.b*q2.c-q1.c*q2.b
RealMult(q1 D_,q2 A_,r1) ;r1=q1.d*q2.a
RealAdd(r2,r1,res D_) ;res.d=q1.a*q2.d+q1.b*q2.c-q1.c*q2.b+q1.d*q2.a
RETURN
PROC Main()
Quaternion q,q1,q2,q3
REAL r,r2
Put(125) PutE() ;clear the screen
MathInit()
Init()
QuatIntInit(q,1,2,3,4)
QuatIntInit(q1,2,3,4,5)
QuatIntInit(q2,3,4,5,6)
IntToReal(7,r)
Print(" q = ") PrintQuatE(q)
Print("q1 = ") PrintQuatE(q1)
Print("q2 = ") PrintQuatE(q2)
Print(" r = ") PrintRE(r) PutE()
QuatNorm(q,r2) Print(" Norm(q) = ") PrintRE(r2)
QuatNorm(q1,r2) Print("Norm(q1) = ") PrintRE(r2)
QuatNorm(q2,r2) Print("Norm(q2) = ") PrintRE(r2)
QuatNegative(q,q3) Print(" -q = ") PrintQuatE(q3)
QuatConjugate(q,q3) Print(" Conj(q) = ") PrintQuatE(q3)
QuatAddReal(q,r,q3) Print(" q+r = ") PrintQuatE(q3)
QuatAdd(q1,q2,q3) Print(" q1+q2 = ") PrintQuatE(q3)
QuatAdd(q2,q1,q3) Print(" q2+q1 = ") PrintQuatE(q3)
QuatMultReal(q,r,q3) Print(" q*r = ") PrintQuatE(q3)
QuatMult(q1,q2,q3) Print(" q1*q2 = ") PrintQuatE(q3)
QuatMult(q2,q1,q3) Print(" q2*q1 = ") PrintQuatE(q3)
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Quaternion_type.png Screenshot from Atari 8-bit computer]
<pre>
q = 1+2i+3j+4k
q1 = 2+3i+4j+5k
q2 = 3+4i+5j+6k
r = 7
Norm(q) = 5.47722543
Norm(q1) = 7.34846906
Norm(q2) = 9.27361833
-q = -1-2i-3j-4k
Conj(q) = 1-2i-3j-4k
q+r = 8+2i+3j+4k
q1+q2 = 5+7i+9j+11k
q2+q1 = 5+7i+9j+11k
q*r = 7+14i+21j+28k
q1*q2 = -56+16i+24j+26k
q2*q1 = -56+18i+20j+28k
</pre>
=={{header|Ada}}==
| |||