aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

82
Task/Quaternion-type/CLU/quaternion-type.clu Normal file
View file

@ -0,0 +1,82 @@
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