Quaternion type: Difference between revisions
Content added Content deleted
(Added solution for Action!) |
Not a robot (talk | contribs) (Add CLU) |
||
Line 1,681: | Line 1,681: | ||
6 + 0i + 0j + 0k |
6 + 0i + 0j + 0k |
||
</pre> |
</pre> |
||
=={{header|CLU}}== |
|||
<lang clu>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</lang> |
|||
{{out}} |
|||
<pre> q0 = 1.000 + 2.000i + 3.000j + 4.000k |
|||
q1 = 2.000 + 3.000i + 4.000j + 5.000k |
|||
q2 = 3.000 + 4.000i + 5.000j + 6.000k |
|||
r = 7.000 |
|||
norm(q0) = 5.477 |
|||
-q0 = -1.000 + -2.000i + -3.000j + -4.000k |
|||
conj(q0) = 1.000 + -2.000i + -3.000j + 4.000k |
|||
q0 + r = 8.000 + 9.000i + 10.000j + 11.000k |
|||
q1 + q2 = 5.000 + 7.000i + 9.000j + 11.000k |
|||
q0 * r = 7.000 + 14.000i + 21.000j + 28.000k |
|||
q1 * q2 = -56.000 + 16.000i + 24.000j + 26.000k |
|||
q2 * q1 = -56.000 + 18.000i + 20.000j + 28.000k |
|||
q1 * q2 ~= q2 * q1</pre> |
|||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |